The unified diff between revisions [f9bf0ab9..] and [23b40306..] is displayed below. It can also be downloaded as a raw diff.
#
#
# delete "NEWS"
#
# delete "database.ml"
#
# delete "extlib-1.3"
#
# delete "extlib-1.3/IO.ml"
#
# delete "extlib-1.3/IO.mli"
#
# delete "extlib-1.3/unzip.ml"
#
# delete "extlib-1.3/unzip.mli"
#
# delete "mlsqlite"
#
# delete "mlsqlite/ocaml-sqlite3.c"
#
# delete "mlsqlite/sqlite3.ml"
#
# delete "mlsqlite/sqlite3.mli"
#
# delete "ocamlnet-0.97.1"
#
# delete "ocamlnet-0.97.1/LICENSE"
#
# delete "ocamlnet-0.97.1/base64.ml"
#
# delete "ocamlnet-0.97.1/base64.mli"
#
# add_file "git.ml"
# content [9b05e45086efa259a14cf38a91d2c43b0d43f80d]
#
# patch "INSTALL"
# from [69045e80305c3f573fb46cc5d70d402a880fd8b4]
# to [0516678ac85bbdcb57aebbab6ab75572c6d7367b]
#
# patch "Makefile"
# from [d406a10c5a4add07e2a63a3926e1f8ec5134c2df]
# to [8d9be147e120edee1e1f374afa26429f8cf3a40f]
#
# patch "README"
# from [40ba304e86f84a94b1db283e0e3dbcee94f42ac5]
# to [3ca28a1d9943ff351b83d35abe9007fce030ed25]
#
# patch "config.make.in"
# from [2ce163755bfad2267000b306499b53e0ff5140a9]
# to [9055f2a871e788843ca1c706ded5412d0ca90bd1]
#
# patch "configure.ac"
# from [491d04e192e312e6100f0c893e24da956c316e76]
# to [8891206c39faf3d7cba8e4967f00aa06120b193c]
#
# patch "database.mli"
# from [587a34962c95fe2a1837b5df23e38a1c8acc3cbd]
# to [0f26f7c44b6aad6c24d2ac7809d6ac8868bcbbaa]
#
# patch "main.ml"
# from [d28cf22acf96dbbc12206b6e4b3965bd39299617]
# to [171b8de171d32ae021b3ed083a57f12dbbf5ce35]
#
# patch "subprocess.ml"
# from [e047bb5bcd5ea674256397d3f8ea0b5c2ce3f919]
# to [108e578184541d73e6e98b98624c5bdaf4de0134]
#
# patch "subprocess.mli"
# from [b509614ed2a16c4c0f88a299484cc5bb3a9adeae]
# to [62bcdc81b9d9f88301f0e7b4cf99219da81ffba0]
#
# patch "ui.ml"
# from [4d9b841fe24e698ecb885df064dd91e80a3c4320]
# to [1f4fb2a2e62a329da2e0f41bbaff2551a46c22aa]
#
# patch "unidiff.ml"
# from [adba6e0ccf2cd60de8b72a8a1126398839104791]
# to [5b365e84428d582c26bc14e5ae1c4c3f7d62abea]
#
# patch "view.ml"
# from [c9832d10fa8c7df2b6169cf5a6535b48bff583ad]
# to [590a55ffdf7771966025cd399911f5761dd53658]
#
# patch "view.mli"
# from [8cf21ebc1a553dbec23d160331a7eced392f7210]
# to [20aca504f554aa261079f762d6238447a0ee98e6]
#
# patch "viz_style.ml"
# from [0765e6a24c5c364c7e44b4e50b9b2620b60668d6]
# to [41467004749f0b4db18d853b48b12a5499733060]
#
============================================================
--- git.ml 9b05e45086efa259a14cf38a91d2c43b0d43f80d
+++ git.ml 9b05e45086efa259a14cf38a91d2c43b0d43f80d
@@ -0,0 +1,357 @@
+open Viz_misc
+open Viz_types
+
+type id = string
+
+type commit = {
+ tree : id ;
+ parents : id list ;
+ author : string ;
+ committer : string ;
+ log : string ;
+ }
+
+type changeset = (string * Revision_types.change list) list
+
+type t = {
+ base : string ;
+ git_kind : [`LINUS|`PASKY] ;
+ head : id ;
+ get_commit : (string -> commit) ;
+ get_changeset : (string -> changeset) ;
+ tags : (string * string) list ;
+ branches : (string * string) list ;
+ }
+
+let id_of_file ?dir f =
+ with_file_in
+ input_line
+ (match dir with None -> f | Some d -> Filename.concat d f)
+
+let list_map_noexn f l =
+ List.rev
+ (List.fold_left
+ (fun acc v -> try f v :: acc with _ -> acc)
+ [] l)
+
+let fetch_dir_of_ids git_dir subdir =
+ try
+ let dir = Filename.concat git_dir subdir in
+ list_map_noexn
+ (fun n -> (id_of_file ~dir n, n))
+ (Array.to_list (Sys.readdir dir))
+ with _ -> []
+
+let fetch_tags git_dir =
+ fetch_dir_of_ids git_dir "refs/tags"
+
+let fetch_history base id =
+ log "exec" "### exec: Running git-rev-tree %s'" id ;
+ match Gspawn.sync
+ ~working_directory:base
+ ~flags:[`SEARCH_PATH]
+ ["git-rev-tree"; id] with
+ | Gspawn.EXITSTATUS 0, stdout, _ ->
+ stdout
+ | _, _, stderr ->
+ Viz_types.errorf "git-rev-tree invocation failed: '%s'" stderr
+
+
+let scan_history data =
+ let get_id s =
+ match string_split ~max_elem:2 ':' s with
+ | id :: _ -> id
+ | _ -> raise Not_found in
+
+ let rec proc ag i =
+ if i >= String.length data
+ then ag
+ else begin
+ let j = String.index_from data i '\n' in
+ let l = String.sub data i (j - i) in
+ let ag =
+ match string_split ' ' l with
+ | _ :: node :: parents ->
+ let id = get_id node in
+ let parents = List.map get_id parents in
+ let node = { id = id ;
+ kind = if List.length parents > 1 then MERGE else REGULAR ;
+ family = List.map (fun i -> i, PARENT) parents } in
+ let edges =
+ List.fold_left
+ (fun e p -> EdgeMap.add (p, id) SAME_BRANCH e)
+ ag.ancestry parents in
+ { ag with
+ nodes = NodeMap.add id node ag.nodes ;
+ ancestry = edges }
+ | _ -> ag in
+ proc ag (j+1)
+ end in
+
+ proc Viz_types.empty_agraph 0
+
+let fetch_commit_object base id =
+ log "exec" "### exec: Running 'git-cat-file commit %s'" id ;
+ match Gspawn.sync
+ ~working_directory:base
+ ~flags:[`SEARCH_PATH]
+ ["git-cat-file"; "commit"; id] with
+ | Gspawn.EXITSTATUS 0, stdout, _ -> stdout
+ | _, _, stderr ->
+ Viz_types.errorf "git-cat-file invocation failed: '%s'" stderr
+
+let scan_commit_object co =
+ let tree = ref "" in
+ let parents = ref [] in
+ let author = ref "" in
+ let committer = ref "" in
+ let log = ref "" in
+ begin
+ let lines = string_split ~collapse:false '\n' co in
+ let p = ref 0 in
+ try List.iter (function
+ | "" -> raise Exit
+ | l ->
+ p := !p + String.length l + 1 ;
+ match string_split ~max_elem:2 ' ' l with
+ | ["tree"; id] -> tree := id
+ | ["parent"; id] -> parents := id :: !parents
+ | ["author"; v] -> author := v
+ | ["committer"; v] -> committer := v
+ | _ -> ()) lines
+ with Exit ->
+ log := string_slice ~s:(!p + 1) co
+ end ;
+ { tree = !tree ;
+ parents = List.rev !parents ;
+ author = !author ;
+ committer = !committer ;
+ log = !log }
+
+let get_commit_object base id =
+ scan_commit_object (fetch_commit_object base id)
+
+
+
+
+let fetch_changeset base old_id new_id =
+ log "exec" "### exec: Running 'git-diff-tree -r %s %s'" old_id new_id ;
+ let tmp_file = Filename.temp_file "git-viz_" ".diff-tree" in
+ match
+ Gspawn.sync
+ ~working_directory:base
+ ~flags:[]
+ ["/bin/sh"; "-c";
+ Printf.sprintf "git-diff-tree -r '%s' '%s' > %s" old_id new_id (Filename.quote tmp_file) ]
+ with
+ | Gspawn.EXITSTATUS 0, _, _ ->
+ let stdout = with_file_in input_channel tmp_file in
+ Sys.remove tmp_file ;
+ stdout
+ | _, _, stderr ->
+ Sys.remove tmp_file ;
+ Viz_types.errorf "git-diff-tree invocation failed:\n'%s'" stderr
+
+let scan_change_linus l =
+ let b = Scanf.Scanning.from_string l in
+ match l.[0] with
+ | '+' | '-' ->
+ Scanf.bscanf b
+ "%c%_o %40[0-9a-f] %n"
+ (fun c id s ->
+ if c = '+'
+ then Revision_types.ADD_FILE (string_slice ~s:(s-1) l)
+ else Revision_types.DELETE_FILE (string_slice ~s:(s-1) l))
+ | '*' ->
+ Scanf.bscanf b
+ "*%_o->%_o %40[0-9a-f]->%40[0-9a-f] %n"
+ (fun id1 id2 s -> Revision_types.PATCH (string_slice ~s:(s-1) l, id1, id2))
+ | _ ->
+ failwith ("Could not parse changeset1 "^l)
+
+let scan_change_pasky l =
+ let a = Array.of_list (string_split '\t' l) in
+ let b = Array.of_list (string_split ' ' a.(0)) in
+ (* 0: file
+ 2: symlink
+ 4: dir
+ *)
+ match b.(4).[0] with
+ | 'N' ->
+ begin
+ match b.(1).[1] with
+ | '4' -> Revision_types.ADD_FILE a.(1)
+ | '2' -> Revision_types.ADD_FILE a.(1)
+ | '0' -> Revision_types.ADD_FILE a.(1)
+ | _ -> failwith ("Adding unknown mode "^b.(1))
+ end
+ | 'M' -> Revision_types.PATCH (a.(1), b.(2), b.(3))
+ | 'D' ->
+ begin
+ match b.(0).[2] with
+ | '4' -> Revision_types.DELETE_DIR a.(1)
+ | '2' -> Revision_types.DELETE_FILE a.(1)
+ | '0' -> Revision_types.DELETE_FILE a.(1)
+ | _ -> failwith ("Removing unknown mode "^b.(0))
+ end
+ | _ ->
+ failwith ("Could not parse changeset2 l: "^l^"\nb.(4): "^b.(4))
+
+let scan_change_pasky_orig l =
+ let a = Array.of_list (string_split '\t' l) in
+ match l.[0] with
+ | '+' | '-' ->
+ begin
+ match l.[0], a.(1) with
+ | '+', _ -> Revision_types.ADD_FILE a.(3)
+ | '-', "blob" -> Revision_types.DELETE_FILE a.(3)
+ | '-', "tree" -> Revision_types.DELETE_DIR a.(3)
+ | _ -> failwith ""
+ end
+ | '*' ->
+ Revision_types.PATCH (a.(3), string_slice ~e:40 a.(2), string_slice ~s:(-40) a.(2))
+ | _ ->
+ failwith ("Could not parse changeset2 "^l)
+
+let get_changes k base id1 id2 =
+ let (sep, scan_fun) =
+ match k with
+ | `LINUS -> '\000', scan_change_linus
+ | `PASKY -> '\n', scan_change_pasky in
+ List.fold_left
+ (fun acc l -> scan_fun l :: acc)
+ []
+ (string_split sep (fetch_changeset base id1 id2))
+
+let get_changeset k base get_commit id =
+ let c = get_commit id in
+ List.map
+ (fun id_old ->
+ let c_old = get_commit id_old in
+ id_old, get_changes k base c_old.tree c.tree)
+ c.parents
+
+
+let kind = `DIRECTORY
+
+let open_db db_name =
+ let dl = Filename.concat db_name ".dircache" in
+ let ds = Filename.concat db_name ".git" in
+ try
+ let d, kind =
+ if Sys.file_exists ds then ds, `PASKY else
+ if Sys.file_exists dl then dl, `LINUS else failwith "unknown" in
+ let head = id_of_file ~dir:d "HEAD" in
+ let get_commit = Viz_misc.make_cache (get_commit_object db_name) in
+ let get_changeset = Viz_misc.make_cache (get_changeset kind db_name get_commit) in
+ { base = db_name ;
+ git_kind = kind ;
+ head = head ;
+ get_commit = get_commit ;
+ get_changeset = get_changeset ;
+ tags = fetch_tags d ;
+ branches = fetch_dir_of_ids d "refs/heads"
+ }
+ with Failure _ | Sys_error _ ->
+ Viz_types.errorf "Not a git db: %s" db_name
+
+let close_db _ = ()
+
+let get_filename d = d.base
+
+let fetch_branches d =
+ List.sort compare
+ (List.map snd d.branches)
+
+let fetch_ancestry_graph d q =
+ let head =
+ match q with
+ | BRANCH b ->
+ begin
+ try list_rassoc b d.branches
+ with Not_found -> d.head
+ end
+ | _ -> d.head in
+ scan_history (fetch_history d.base head)
+
+let fetch_revision d id =
+ { revision_id = id ;
+ manifest_id = (d.get_commit id).tree ;
+ revision_set = d.get_changeset id ;
+ certs = []
+ }
+
+let fetch_certs_and_revision d id =
+ let fake_cert = { c_id = id ;
+ c_name = "" ; c_value = "" ;
+ c_signer_id = "" ; c_signature = SIG_OK } in
+ let c = d.get_commit id in
+ let cert_list =
+ try
+ let tag = List.assoc id d.tags in
+ [ { fake_cert with c_name = "tag" ; c_value = tag } ]
+ with Not_found -> [] in
+ { (fetch_revision d id) with certs =
+ { fake_cert with c_name = "author" ; c_value = c.author } ::
+ { fake_cert with c_name = "committer" ; c_value = c.committer } ::
+ { fake_cert with c_name = "changelog" ; c_value = c.log } :: cert_list
+ }
+
+(* for autocolor by keyid *)
+let fetch_cert_signer d id n = []
+
+(* for autocolor *)
+let fetch_cert_value d id = function
+ | "author" -> [
+ let a = (d.get_commit id).author in
+ try Scanf.sscanf a "%s@>" (fun id -> id) with _ -> a
+ ]
+ | "tag" -> begin
+ try [ List.assoc id d.tags ]
+ with Not_found -> []
+ end
+ | _ -> []
+
+(* find by tag *)
+let get_matching_tags d p =
+ List.filter
+ (fun (_, t) -> p t)
+ d.tags
+
+(* find by date *)
+let get_matching_dates d s = []
+
+(* autocolor by keyid *)
+let get_key_rowid d k = 0
+
+(* diff *)
+let run_monotone_diff d exe (parent, child) status cb =
+ match d.git_kind with
+ | `LINUS ->
+ ignore (Glib.Idle.add (fun () ->
+ cb (`SUB_PROC_ERROR "Diffs are not suported with git yet") ;
+ false))
+ | `PASKY ->
+ let cmd = [ "git-diff-tree"; "-r"; "-p"; parent; child ] in
+ log "exec" "### exec: Running '%s'" (String.concat " " cmd) ;
+ let error fmt =
+ Printf.kprintf (fun s -> cb (`SUB_PROC_ERROR s)) fmt in
+ try
+ status#push "Running git-diff-tree ..." ;
+ ignore (
+ Subprocess.spawn_out
+ ~working_directory:d.base
+ ~encoding:`LOCALE ~cmd
+ ~reap_callback:status#pop
+ (fun ~exceptions ~stdout ~stderr status ->
+ if status <> 0 then
+ if stderr = ""
+ then
+ error "git-diff-tree exited with status %d:\n%s" status
+ (String.concat "\n" (List.map Printexc.to_string exceptions))
+ else
+ error "git-diff-tree error:\n%s" stderr
+ else
+ cb (`DIFF stdout)))
+ with Gspawn.Error (_, msg) ->
+ Viz_types.errorf "Could not execute monotone:\n%s" msg
============================================================
--- INSTALL 69045e80305c3f573fb46cc5d70d402a880fd8b4
+++ INSTALL 0516678ac85bbdcb57aebbab6ab75572c6d7367b
@@ -1,12 +1,13 @@
-Compiling monotone-viz from sources
+Compiling git-viz from sources
===================================
* OCaml
-Monotone-viz is written in Objective caml, so you'll need the ocaml
+Git-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:
+from other vendors (e.g. Linux distributions). If you install a
+package, make sure you have camlp4, the caml preprocessor. OCaml is
+also easy to compile from source, something like this should work:
$ ./configure -prefix /opt/caml
$ make world.opt
@@ -29,28 +30,15 @@ from source, make sure it is built with
$ make install
-* Sqlite
-If monotone was built with the --without-bundled-sqlite configure
-option, it uses a shared sqlite library and you simply need to run:
+* Git-viz
+Compiling git-viz should now be as simple as :
- $ ./configure --with-shared-sqlite
-
-Otherwise, the sqlite library is statically linked with the monotone
-binary and you'll need the compiled monotone sources. In the
-monotone-viz directory, create a link named monotone and run configure:
-
- $ ln -s /path/to/monotone-tree monotone
$ ./configure
-
-
-* Monotone-viz
-Compiling monotone-viz should now be as simple as:
-
$ make
* Installing & cleaning
-There is no `install' target for the Makefile: monotone-viz is a
+There is no `install' target for the Makefile: git-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 wish:
============================================================
--- Makefile d406a10c5a4add07e2a63a3926e1f8ec5134c2df
+++ Makefile 8d9be147e120edee1e1f374afa26429f8cf3a40f
@@ -4,15 +4,14 @@ EXTLIB := extlib-1.3
OCAMLNET := ocamlnet-0.97.1
EXTLIB := extlib-1.3
-VPATH = mlsqlite $(OCAMLNET) $(EXTLIB) glib crypto
+VPATH = glib crypto
-MLINCDIRS = -I $(OCAMLNET) -I mlsqlite -I $(EXTLIB) -I $(LABLGTK_DIR) -I glib -I crypto
+MLINCDIRS = -I $(LABLGTK_DIR) -I glib -I crypto
GTK_CFLAGS := $(shell pkg-config gtk+-2.0 --cflags)
GNOMECANVAS_CFLAGS := $(shell pkg-config libgnomecanvas-2.0 --cflags)
-SRC = base64.ml base64.mli sqlite3.ml sqlite3.mli IO.mli IO.ml unzip.ml unzip.mli \
- gspawn.ml gspawn.mli giochannel.ml giochannel.mli \
+SRC = gspawn.ml gspawn.mli giochannel.ml giochannel.mli \
crypto.ml crypto.mli \
viz_misc.ml viz_misc.mli viz_types.ml viz_types.mli \
q.ml q.mli heap.ml heap.mli \
@@ -25,8 +24,7 @@ SRC = base64.ml base64.mli sqlite3.ml sq
icon.ml unidiff.ml unidiff.mli \
view.ml view.mli ui.ml main.ml
-C_OBJ = mlsqlite/ocaml-sqlite3.o \
- glib/ocaml-gspawn.o glib/ocaml-giochannel.o \
+C_OBJ = glib/ocaml-gspawn.o glib/ocaml-giochannel.o \
crypto/ocaml-openssl.o \
gnomecanvas_hack.o
@@ -42,44 +40,35 @@ DISTSRC = Makefile configure.ac config.m
dot_types.mli dot_lexer.mll dot_parser.mly \
subprocess.ml subprocess.mli icon.ml status.ml ui.ml \
revision_types.mli revision_lexer.mll revision_parser.mly \
- components.ml database.ml database.mli agraph.ml agraph.mli \
+ components.ml git.ml database.mli agraph.ml agraph.mli \
unidiff.ml unidiff.mli gnomecanvas_hack.c view.ml view.mli main.ml \
- mlsqlite/sqlite3.ml mlsqlite/sqlite3.mli mlsqlite/ocaml-sqlite3.c \
- ocamlnet-0.97.1/base64.ml ocamlnet-0.97.1/base64.mli ocamlnet-0.97.1/LICENSE \
- extlib-1.3/IO.ml extlib-1.3/IO.mli extlib-1.3/unzip.ml extlib-1.3/unzip.mli \
glib/gspawn.ml glib/gspawn.mli glib/giochannel.ml glib/giochannel.mli \
glib/ocaml-gspawn.c glib/ocaml-giochannel.c \
glib/gspawn_tags.var glib/giochannel_tags.var \
crypto/ocaml-openssl.c crypto/crypto.ml crypto/crypto.mli
-ifdef SQLITE_LIBS
LIB3RDPARTY_OBJ = $(C_OBJ)
-SQLITE_LINK = -ccopt "$(SQLITE_LIBS)"
-else
-LIB3RDPARTY_OBJ = $(MONOTONE_DIR)/sqlite/lib3rdparty_a-*.o $(C_OBJ)
-endif
ifeq ($(OCAMLBEST), opt)
-monotone-viz : $(OBJX) lib3rdparty.a
- $(OCAMLOPT) -o $@ -I . -I $(LABLGTK_DIR) $(MLLIBS) $^ $(CRYPTO_LIB) $(SQLITE_LINK)
-monotone-viz : MLLIBS = str.cmxa lablgtk.cmxa gtkInit.cmx lablgnomecanvas.cmxa
+git-viz: $(OBJX) lib3rdparty.a
+ $(OCAMLOPT) -o $@ -I . -I $(LABLGTK_DIR) $(MLLIBS) $^ $(CRYPTO_LIB)
+git-viz : MLLIBS = str.cmxa lablgtk.cmxa gtkInit.cmx lablgnomecanvas.cmxa
else
-monotone-viz : $(OBJ) lib3rdparty.a
- $(OCAMLC) -custom -o $@ -I . -I $(LABLGTK_DIR) $(MLLIBS) $^ $(CRYPTO_LIB) $(SQLITE_LINK)
-monotone-viz : MLLIBS = str.cma lablgtk.cma gtkInit.cmo lablgnomecanvas.cma
+git-viz:
+ ln -sf git.ml database.ml
+ $(OCAMLC) -custom -o $@ -I . -I $(LABLGTK_DIR) $(MLLIBS) $^ $(CRYPTO_LIB)
+git-viz : MLLIBS = str.cma lablgtk.cma gtkInit.cmo lablgnomecanvas.cma
endif
+database.ml :
+ ln -s git.ml $@
+
lib3rdparty.a : $(C_OBJ)
ar crs lib3rdparty.a $(LIB3RDPARTY_OBJ)
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)"
-ifdef SQLITE_LIBS
-mlsqlite/ocaml-sqlite3.o : CINCDIRS = -ccopt "$(SQLITE_CFLAGS)"
-else
-mlsqlite/ocaml-sqlite3.o : CINCDIRS = -I $(MONOTONE_DIR)/sqlite
-endif
crypto/ocaml-openssl.o : CINCDIRS = -ccopt "$(CRYPTO_CFLAGS)"
gnomecanvas_hack.o : CINCDIRS = -ccopt "$(GNOMECANVAS_CFLAGS)"
@@ -110,9 +99,6 @@ 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
- cd mlsqlite && rm -f *.a *.so *.o *.cm*
- cd $(OCAMLNET) && rm -f *.o *.cm*
- cd $(EXTLIB) && rm -f *.o *.cm*
cd glib && rm -f *.o *.cm*
cd crypto && rm -f *.o *.cm*
============================================================
--- README 40ba304e86f84a94b1db283e0e3dbcee94f42ac5
+++ README 3ca28a1d9943ff351b83d35abe9007fce030ed25
@@ -1,9 +1,8 @@
-Monotone-viz
-============
+Git-viz
+=======
-This is a small GNOME application to visualize monotone ancestry
-graphs.
+This is a small GNOME application to visualize git ancestry graphs.
REQUIREMENTS
@@ -13,7 +12,6 @@
- GTK+ 2.4, libgnomecanvas
To compile from sources, you'll also need:
-- a compiled monotone source tree
- ocaml compiler (>= 3.07)
- LablGTK 2.4.0 or a more recent snapshot
- libcrypto, from the openssl toolkit
@@ -25,26 +23,20 @@
- if you've pulled this from the monotone repository,
run `aclocal -I . && autoconf' to generate configure
- run ./configure, with the following options if needed :
- --with-monotone-dir
--with-lablgtk-dir
- make
-- install the binary monotone-viz somewhere
+- install the binary git-viz somewhere
see INSTALL for an in-depth description of this procedure.
RUNNING
=======
-usage: monotone-viz [options] [db [branch]]
+usage: git-viz [options] [git-controlled directory]
options:
-noaa don't use an anti-aliased canvas
-If db and branch are not specified on the command line and
-monotone-viz is run from a monotone-controlled directory, it will
-automatically use the database and branch specified in the MT/options
-file.
-
STYLE FILE
==========
Appearance can be controlled via a style file, named
============================================================
--- config.make.in 2ce163755bfad2267000b306499b53e0ff5140a9
+++ config.make.in 9055f2a871e788843ca1c706ded5412d0ca90bd1
@@ -11,8 +11,6 @@ CRYPTO_LIB := /usr/lib/libcrypto.a
MONOTONE_DIR := @MONOTONE_DIR@
LABLGTK_DIR := @LABLGTK_DIR@
CRYPTO_LIB := /usr/lib/libcrypto.a
-SQLITE_CFLAGS := @SQLITE_CFLAGS@
-SQLITE_LIBS := @SQLITE_LIBS@
CPPFLAGS := @CPPFLAGS@
NAME := @PACKAGE_NAME@
============================================================
--- configure.ac 491d04e192e312e6100f0c893e24da956c316e76
+++ configure.ac 8891206c39faf3d7cba8e4967f00aa06120b193c
@@ -1,4 +1,4 @@
-AC_INIT(monotone-viz, 0.10)
+AC_INIT(git-viz, 0.1)
AC_PROG_OCAML
AC_PROG_OCAML_TOOLS
@@ -42,37 +42,6 @@ fi
OCAMLBEST=byte
fi
-
-# Check the sqlite3 sources
-AC_ARG_WITH([monotone-dir],
- AS_HELP_STRING([--with-monotone-dir=],
- [specify location of monotone build tree]),
- MONOTONE_DIR=$withval,
- MONOTONE_DIR=monotone)
-AC_ARG_WITH([shared-sqlite],
- AS_HELP_STRING([--with-shared-sqlite=],
- [use a system-wide shared sqlite library]),
- SHARED_SQLITE=$withval,
- SHARED_SQLITE=no)
-AC_MSG_CHECKING(sqlite)
-if test "$SHARED_SQLITE" = "yes" ; then
- PKG_CHECK_MODULES(SQLITE, sqlite >= 3.0,,AC_MSG_ERROR([
-Couldn't use the shared sqlite package.]))
-elif test -d "$MONOTONE_DIR" -a -r "$MONOTONE_DIR/sqlite/lib3rdparty_a-main.o" ; then
- AC_MSG_RESULT(found in $MONOTONE_DIR/sqlite)
-else
- AC_MSG_ERROR([
-
-Could not find compiled sqlite sources. Monotone-viz needs a compiled
-monotone tree for the sqlite library. Create a link named `monotone'
-or specify the location to configure using the `--with-monotone-dir='
-option.])
-fi
-if test "${MONOTONE_DIR:0:1}" != "/" ; then
- MONOTONE_DIR=$(pwd)/$MONOTONE_DIR
-fi
-AC_SUBST(MONOTONE_DIR)
-
# Keep CPPFLAGS around, can be useful if caml headers are in a
# non-standard location.
AC_SUBST(CPPFLAGS)
============================================================
--- database.mli 587a34962c95fe2a1837b5df23e38a1c8acc3cbd
+++ database.mli 0f26f7c44b6aad6c24d2ac7809d6ac8868bcbbaa
@@ -2,6 +2,8 @@ type t
type t
+val kind : [`DIRECTORY | `FILE]
+
(** Any of these function can raise Viz_types.Error *)
val open_db : string -> t
============================================================
--- main.ml d28cf22acf96dbbc12206b6e4b3965bd39299617
+++ main.ml 171b8de171d32ae021b3ed083a57f12dbbf5ce35
@@ -1,79 +1,19 @@ open Viz_misc
open Viz_misc
-type mt_options =
- | MTopt_none
- | MTopt_db of string
- | MTopt_full of string * string
-
-let unquote s =
- if s.[0] = '"'
- then
- let len = String.length s in
- Revision_lexer.string
- (Buffer.create len)
- (Lexing.from_string (String.sub s 1 (len - 1)))
- else s
-
-let find_MT_dir () =
- let rec up = function
- | "/" -> raise Not_found
- | p ->
- let d = Filename.dirname p in
- let m = Filename.concat d "MT" in
- if Sys.file_exists m
- then m
- else up d in
- if Sys.file_exists "MT"
- then "MT"
- else up (Sys.getcwd ())
-
-let parse_MT_options () =
- match
- try with_file_in input_lines (Filename.concat (find_MT_dir ()) "options")
- with Not_found | Sys_error _ -> [] with
- | [] -> MTopt_none
- | lines ->
- let options =
- try
- List.fold_right
- (fun s acc ->
- match string_split ~max_elem:2 ' ' s with
- | [a; b] -> (a, unquote b) :: acc
- | _ -> acc)
- lines []
- with Failure _ -> [] in
- match may_assoc "database" options with
- | None -> MTopt_none
- | Some db_raw ->
- try
- let db = Glib.Convert.filename_from_utf8 db_raw in
- match may_assoc "branch" options with
- | Some branch when Glib.Utf8.validate branch ->
- MTopt_full (db, branch)
- | _ ->
- MTopt_db db
- with Glib.Convert.Error _ ->
- MTopt_none
-
let parse_options args =
match args with
+ | db :: _ -> Some db
| [] ->
- parse_MT_options ()
- | db :: [] | db :: "" :: _ ->
- MTopt_db db
- | db :: branch_raw :: _ ->
- try
- let branch = Glib.Convert.locale_to_utf8 branch_raw in
- MTopt_full (db, branch)
- with Glib.Convert.Error _ ->
- MTopt_db db
+ if Sys.file_exists ".dircache" || Sys.file_exists ".git"
+ then Some "."
+ else None
let parse_cli () =
let anons = ref Q.empty in
let aa = ref true in
let cli_args = [ "-noaa", Arg.Clear aa, "don't use an anti-aliased canvas" ] in
let usg_msg =
- Printf.sprintf "usage: %s [options] [db [branch]]"
+ Printf.sprintf "usage: %s [options] [git-controlled directory]"
(Filename.basename Sys.executable_name) in
Arg.parse cli_args (fun a -> anons := Q.push !anons a) usg_msg ;
(!aa, parse_options (Q.to_list !anons))
@@ -87,7 +27,7 @@ let main =
let main =
let w = GWindow.window
- ~title:"Monotone-viz"
+ ~title:"git-viz"
~icon:(Lazy.force Icon.monotone) () in
ignore (w#connect#destroy GMain.quit) ;
@@ -105,11 +45,9 @@ let main =
begin
try
match mt_options with
- | MTopt_none -> ()
- | MTopt_db fname ->
+ | None -> ()
+ | Some fname ->
View.open_db v fname None
- | MTopt_full (fname, branch) ->
- View.open_db v fname (Some branch)
with Viz_types.Error msg ->
View.error_notice ~parent:w msg
end ;
============================================================
--- subprocess.ml e047bb5bcd5ea674256397d3f8ea0b5c2ce3f919
+++ subprocess.ml 108e578184541d73e6e98b98624c5bdaf4de0134
@@ -131,7 +131,7 @@ type t = {
mutable status : int ;
}
-let spawn encoding input_opt cmd reap_callback done_callback =
+let spawn ?working_directory encoding input_opt cmd reap_callback done_callback =
let has_input = input_opt <> None in
let spawn_flags =
[ `PIPE_STDOUT ; `PIPE_STDERR ;
@@ -139,7 +139,8 @@ let spawn encoding input_opt cmd reap_ca
let child_info =
Gspawn.async_with_pipes
- (if has_input then `PIPE_STDIN :: spawn_flags else spawn_flags)
+ ?working_directory
+ ~flags:(if has_input then `PIPE_STDIN :: spawn_flags else spawn_flags)
cmd in
let state = { watches = [] ; aborted = false ; status = -1 } in
@@ -205,11 +206,11 @@ type callback =
int -> unit
(* spawn a process and grab its stdout and stderr *)
-let spawn_out ~encoding ~cmd ~reap_callback done_callback =
+let spawn_out ?working_directory ~encoding ~cmd ~reap_callback done_callback =
spawn encoding None cmd reap_callback done_callback
(* spawn a process, feed it a string and grab its stdout and stderr *)
-let spawn_inout ~encoding ~cmd ~input ~reap_callback done_callback =
+let spawn_inout ?working_directory ~encoding ~cmd ~input ~reap_callback done_callback =
spawn encoding (Some input) cmd reap_callback done_callback
let abort sub_data =
============================================================
--- subprocess.mli b509614ed2a16c4c0f88a299484cc5bb3a9adeae
+++ subprocess.mli 62bcdc81b9d9f88301f0e7b4cf99219da81ffba0
@@ -9,12 +9,14 @@ val spawn_out :
int -> unit
val spawn_out :
+ ?working_directory:string ->
encoding:encoding ->
cmd:string list ->
reap_callback:(unit -> unit) ->
callback -> t
val spawn_inout :
+ ?working_directory:string ->
encoding:encoding ->
cmd:string list ->
input:string ->
============================================================
--- ui.ml 4d9b841fe24e698ecb885df064dd91e80a3c4320
+++ ui.ml 1f4fb2a2e62a329da2e0f41bbaff2551a46c22aa
@@ -330,7 +330,8 @@ let make w ~aa ~prefs =
let open_dialog = lazy
begin
let dialog = GWindow.file_chooser_dialog
- ~action:`OPEN ~parent:w
+ ~action:(match Database.kind with `FILE -> `OPEN | `DIRECTORY -> `SELECT_FOLDER)
+ ~parent:w
~title:"Open a Monotone database" () in
dialog#add_button_stock `CLOSE `CLOSE ;
dialog#add_select_button_stock `OPEN `OPEN ;
============================================================
--- unidiff.ml adba6e0ccf2cd60de8b72a8a1126398839104791
+++ unidiff.ml 5b365e84428d582c26bc14e5ae1c4c3f7d62abea
@@ -43,11 +43,15 @@ let analyze_diff_output text =
Q.list_fold
(fun q (n, s, len) ->
if is_prefix "--- " text s
+ then Q.push q (HEADER n)
+ else if is_prefix "+++ " text s
then begin
- let filename = String.sub text (s + 4) (len - 4) in
- Q.push_list q [ HEADER n ; FILE (filename, n) ] end
- else if is_prefix "+++ " text s
- then Q.push q (HEADER n)
+ let filename =
+ let re = Str.regexp "[0-9a-f]+/\\(.*\\) (" in
+ if Str.string_match re text (s + 4)
+ then Str.matched_group 1 text
+ else String.sub text (s + 4) (len - 4) in
+ Q.push_list q [ HEADER n ; FILE (filename, n - 1) ] end
else if is_prefix "@@ " text s
then Q.push q (HUNK n)
else if is_prefix "-" text s
@@ -85,7 +89,7 @@ let save_dialog parent text =
let s = GWindow.file_chooser_dialog
~action:`SAVE ~parent
~destroy_with_parent:true
- ~title:"Save monotone diff output" () in
+ ~title:"Save git diff output" () in
s#add_button_stock `CANCEL `CANCEL ;
s#add_select_button_stock `SAVE `SAVE ;
s#set_default_response `SAVE ;
@@ -98,13 +102,13 @@ let save_dialog parent text =
with_file_out
(fun oc -> output_string oc text) f
with Sys_error _ ->
- Viz_types.errorf "Could not write monotone diff output to '%s'" f)) ;
+ Viz_types.errorf "Could not write git diff output to '%s'" f)) ;
s
let view_diff ?parent (junk_end, tags_coords) text orig_text =
let window = GWindow.dialog
~no_separator:true ?parent
- ~title:"Monotone diff output"
+ ~title:"Git diff output"
~type_hint:`NORMAL
~icon:(Lazy.force Icon.monotone) () in
window#add_button_stock `SAVE `SAVE ;
@@ -216,6 +220,6 @@ let view ~parent text =
~buttons:GWindow.Buttons.close
?parent
~destroy_with_parent:true
- ~title:"Monotone diff output" () in
+ ~title:"Git diff output" () in
ignore (d#connect#response (fun _ -> d#destroy ())) ;
d#show ()
============================================================
--- view.ml c9832d10fa8c7df2b6169cf5a6535b48bff583ad
+++ view.ml 590a55ffdf7771966025cd399911f5761dd53658
@@ -44,7 +44,6 @@ type branch_selector = {
type branch_selector = {
combo : GEdit.combo_box GEdit.text_combo ;
mutable combo_signal : GtkSignal.id option ;
- sub : GButton.toggle_button ;
mutable branches : string array ;
select_signal : Viz_types.query Signal.t ;
}
@@ -329,9 +328,7 @@ module Branch_selector = struct
match combo#active with
| -1 -> raise Exit
| 0 -> ALL
- | i ->
- let b = s.branches.(i - 1) in
- if s.sub#active then COLLECTION b else BRANCH b
+ | i -> BRANCH s.branches.(i - 1)
end
with Exit -> ()
@@ -351,27 +348,22 @@ module Branch_selector = struct
combo#pack r ;
combo#add_attribute r "markup" column ;
(combo, store) in
- let checkb =
- GButton.check_button
- ~label:"Include sub-branches"
- ~active:false ~packing:hb#pack () in
let entry = GEdit.entry ~packing:(hb#pack ~from:`END) () in
begin
let tooltips = GData.tooltips () in
tooltips#set_tip
- ~text:"Find a node by its revision id, tag or date (YYYY-MM-DD)"
+ ~text:"Find a node by its revision id or tag"
entry#coerce
end ;
let lbl = GMisc.label ~text:"Find:" ~packing:(hb#pack ~from:`END) () in
let c =
{ combo = combo ; combo_signal = None ;
- sub = checkb ; branches = [||] ;
+ branches = [||] ;
select_signal = Signal.make () } in
begin
let callback () = select_branch c in
let (combo, _) = combo in
- c.combo_signal <- Some (combo#connect#changed ~callback) ;
- ignore (checkb#connect#toggled ~callback)
+ c.combo_signal <- Some (combo#connect#changed ~callback)
end ;
let f = { last_find = "", [] ; find_signal = Signal.make () ; find_entry = entry } in
ignore (entry#connect#activate (fun () ->
@@ -381,8 +373,6 @@ module Branch_selector = struct
let connect v f =
Signal.connect v.selector.select_signal f
- let get_display_sub_branches v = v.selector.sub#active
-
let clear { selector = s } =
s.branches <- [||] ;
with_inactive_combo s
@@ -394,7 +384,7 @@ module Branch_selector = struct
s.branches <- Array.of_list br ;
begin
let row = model#append () in
- model#set ~row ~column "<i>Everything</i>"
+ model#set ~row ~column "<i>HEAD</i>"
end ;
List.iter
(fun b ->
@@ -412,10 +402,13 @@ module Branch_selector = struct
let (combo, _) = s.combo in
combo#set_active
begin
- try 1 + array_index s.branches b
- with Not_found ->
- error_notice_f ~parent:s.sub "Could not find the branch '%s'" b ;
- -1
+ match b with
+ | None -> 0
+ | Some b ->
+ try 1 + array_index s.branches b
+ with Not_found ->
+ error_notice_f ~parent:(fst s.combo) "Could not find the branch '%s'" b ;
+ -1
end
let get_branch { selector = s } =
@@ -999,8 +992,6 @@ let make ~aa ~prefs ~packing =
| `NODE_SELECT id ->
Canvas.display_selection_marker v id ;
Info_Display.fetch_and_display_data v id
- | `NODE_SWITCH_BRANCH branch ->
- Branch_selector.set_branch v branch
| `CLEAR ->
Info_Display.clear_info v ;
KeyNav.clear v ;
@@ -1035,7 +1026,7 @@ let open_db v fname branch =
let db = Database.open_db fname in
v.db <- Some db ;
Branch_selector.populate v (Database.fetch_branches db) ;
- may (Branch_selector.set_branch v) branch ;
+ Branch_selector.set_branch v branch ;
Signal.emit v.event_signal `OPEN_DB
with Viz_types.Error msg ->
error_notice ~parent:v.canvas.w msg
============================================================
--- view.mli 8cf21ebc1a553dbec23d160331a7eced392f7210
+++ view.mli 20aca504f554aa261079f762d6238447a0ee98e6
@@ -38,12 +38,6 @@ module Branch_selector :
module Branch_selector :
sig
val make : packing:(GObj.widget -> unit) -> branch_selector * find
- val connect : t -> (Viz_types.query -> unit) -> unit
- val get_display_sub_branches : t -> bool
- val clear : t -> unit
- val populate : t -> string list -> unit
- val set_branch : t -> string -> unit
- val get_branch : t -> string option
end
module KeyNav :
============================================================
--- viz_style.ml 0765e6a24c5c364c7e44b4e50b9b2620b60668d6
+++ viz_style.ml 41467004749f0b4db18d853b48b12a5499733060
@@ -240,7 +240,7 @@ let defaults =
let defaults =
{
font = "Monospace 8" ;
- autocolor = BY_KEYID ;
+ autocolor = NONE ;
lr_layout = false ;
monotone_path = "monotone" ;
style = [] ;