The unified diff between revisions [5ad89fbf..] and [78746ed3..] is displayed below. It can also be downloaded as a raw diff.
#
#
# rename "database.ml"
# to "database-mt.ml"
#
# add_file "git.ml"
# content [c5709e028ce1670f8b42fab662bc3204f3d6590a]
#
# patch "Makefile"
# from [cdc062fa1af834f40ae902df7a4bf63153245447]
# to [e24ee4ebcb8c535231a27e69c5bab89976e9b9d8]
#
# patch "README"
# from [18d17ed5745ddbe7b13cedd87304dd32a7126bbf]
# to [909fde8b736d5c46c04dd68111f2718dab03cfe7]
#
# patch "configure.ac"
# from [770dee80aed104ca0636dc6a8d5fbef24f2fdc02]
# to [fe7b2a288ec73db3487937bd1cc2538ba7494603]
#
# patch "database-mt.ml"
# from [f78fcb72f043c24d31f4f02e169633d4bbae37b1]
# to [4f652fbc8f02cf793f9f61724fee5ce446e201b8]
#
# patch "database.mli"
# from [587a34962c95fe2a1837b5df23e38a1c8acc3cbd]
# to [0f26f7c44b6aad6c24d2ac7809d6ac8868bcbbaa]
#
# patch "main.ml"
# from [3feaecce13b222addbbf8fd459a0738d7e2c36b0]
# to [171b8de171d32ae021b3ed083a57f12dbbf5ce35]
#
# patch "subprocess.ml"
# from [e047bb5bcd5ea674256397d3f8ea0b5c2ce3f919]
# to [108e578184541d73e6e98b98624c5bdaf4de0134]
#
# patch "subprocess.mli"
# from [b509614ed2a16c4c0f88a299484cc5bb3a9adeae]
# to [62bcdc81b9d9f88301f0e7b4cf99219da81ffba0]
#
# patch "ui.ml"
# from [993ceff439efadcd68bd16487fe25a9b60650b8f]
# to [7d827512c7a6b458a55372e159cfc7048e1ae789]
#
# patch "unidiff.ml"
# from [27d78ed2191d1fb186ad09637874b4832c59b480]
# to [fe18aec530b716b4d80c29b1730bdddb904bde36]
#
# patch "view.ml"
# from [046fbee5cc9e1c486a798b69a33764c8d1bc49a8]
# to [69c88b304f62c440cbc49ec4c62a89a98a42da90]
#
# patch "view.mli"
# from [8cf21ebc1a553dbec23d160331a7eced392f7210]
# to [20aca504f554aa261079f762d6238447a0ee98e6]
#
# patch "viz_misc.mli"
# from [0d137b9883d1ce144629f5b0aa5872752f9e1b6b]
# to [3a6714c41817a7f1c71d6852e4cc45b7c4962871]
#
# patch "viz_style.ml"
# from [0765e6a24c5c364c7e44b4e50b9b2620b60668d6]
# to [41467004749f0b4db18d853b48b12a5499733060]
#
============================================================
--- git.ml c5709e028ce1670f8b42fab662bc3204f3d6590a
+++ git.ml c5709e028ce1670f8b42fab662bc3204f3d6590a
@@ -0,0 +1,321 @@
+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 fetch_dir_of_ids git_dir subdir =
+ try
+ let dir = Filename.concat git_dir subdir in
+ List.map
+ (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 "tags"
+
+let fetch_history base id =
+ log "exec" "### exec: Running rev-tree %s'" id ;
+ match Gspawn.sync
+ ~working_directory:base
+ ~flags:[`SEARCH_PATH]
+ ["rev-tree"; id] with
+ | Gspawn.EXITSTATUS 0, stdout, _ ->
+ stdout
+ | _, _, stderr ->
+ Viz_types.errorf "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 'cat-file commit %s'" id ;
+ match Gspawn.sync
+ ~working_directory:base
+ ~flags:[`SEARCH_PATH]
+ ["cat-file"; "commit"; id] with
+ | Gspawn.EXITSTATUS 0, stdout, _ -> stdout
+ | _, _, stderr ->
+ Viz_types.errorf "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 'diff-tree %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 "diff-tree '%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 "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 changeset"
+
+let scan_change_pasky 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 changeset"
+
+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 "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"; parent; child] in
+ log "exec" "### exec: Running '%s'" (String.concat " " cmd) ;
+ try
+ status#push "Running git diff ..." ;
+ 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 exited with status %d:\n%s" status
+ (String.concat "\n" (List.map Printexc.to_string exceptions))
+ else
+ error "git diff error:\n%s" stderr
+ else
+ cb (`DIFF stdout)))
+ with Gspawn.Error (_, msg) ->
+ Viz_types.errorf "Could not execute monotone:\n%s" msg
============================================================
--- Makefile cdc062fa1af834f40ae902df7a4bf63153245447
+++ Makefile e24ee4ebcb8c535231a27e69c5bab89976e9b9d8
@@ -1,18 +1,20 @@ include config.make
include config.make
+NAME = git-viz
+VERSION = 0.1
+
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 +27,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,11 +43,8 @@ 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 \
- database.ml database.mli agraph.ml agraph.mli \
+ git.ml database-mt.ml database.mli agraph.ml agraph.mli \
unidiff.ml unidiff.mli 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 \
@@ -54,22 +52,25 @@ ifeq ($(OCAMLBEST), opt)
ifeq ($(OCAMLBEST), opt)
-monotone-viz : $(OBJX) lib3rdparty.a
+git-viz: $(OBJX) lib3rdparty.a
$(OCAMLOPT) -o $@ -I . -I $(LABLGTK_DIR) $(MLLIBS) $^ $(CRYPTO_LIB)
-monotone-viz : MLLIBS = str.cmxa lablgtk.cmxa gtkInit.cmx lablgnomecanvas.cmxa
+git-viz : MLLIBS = str.cmxa lablgtk.cmxa gtkInit.cmx lablgnomecanvas.cmxa
else
-monotone-viz : $(OBJ) lib3rdparty.a
+git-viz:
+ ln -sf git.ml database.ml
$(OCAMLC) -custom -o $@ -I . -I $(LABLGTK_DIR) $(MLLIBS) $^ $(CRYPTO_LIB)
-monotone-viz : MLLIBS = str.cma lablgtk.cma gtkInit.cmo lablgnomecanvas.cma
+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 $(MONOTONE_DIR)/sqlite/lib3rdparty_a-*.o $^
+ 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)"
-mlsqlite/ocaml-sqlite3.o : CINCDIRS = -I $(MONOTONE_DIR)/sqlite
crypto/ocaml-openssl.o : CINCDIRS = -ccopt "$(CRYPTO_CFLAGS)"
gnomecanvas_hack.o : CINCDIRS = -ccopt "$(GNOMECANVAS_CFLAGS)"
@@ -100,9 +101,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 18d17ed5745ddbe7b13cedd87304dd32a7126bbf
+++ README 909fde8b736d5c46c04dd68111f2718dab03cfe7
@@ -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 lablgtk-20041119 or lablgtk-20050218
- 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
============================================================
--- configure.ac 770dee80aed104ca0636dc6a8d5fbef24f2fdc02
+++ configure.ac fe7b2a288ec73db3487937bd1cc2538ba7494603
@@ -42,27 +42,4 @@ 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_MSG_CHECKING(sqlite sources)
-if 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)
-
AC_OUTPUT(config.make)
============================================================
--- database.ml f78fcb72f043c24d31f4f02e169633d4bbae37b1
+++ database-mt.ml 4f652fbc8f02cf793f9f61724fee5ce446e201b8
@@ -304,6 +304,7 @@ let sqlite_try f db =
+let kind = `FILE
let open_db fname =
if not (Sys.file_exists fname)
============================================================
--- 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 3feaecce13b222addbbf8fd459a0738d7e2c36b0
+++ main.ml 171b8de171d32ae021b3ed083a57f12dbbf5ce35
@@ -1,66 +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 ->
- match may_assoc "branch" options with
- | None -> MTopt_db db
- | Some branch -> MTopt_full (db, branch)
-
let parse_options args =
match args with
- | db :: [] | db :: "" :: _ -> MTopt_db db
- | db :: branch :: _ -> MTopt_full (db, branch)
- | [] -> parse_MT_options ()
+ | db :: _ -> Some 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))
@@ -74,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) ;
@@ -92,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 993ceff439efadcd68bd16487fe25a9b60650b8f
+++ ui.ml 7d827512c7a6b458a55372e159cfc7048e1ae789
@@ -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 27d78ed2191d1fb186ad09637874b4832c59b480
+++ unidiff.ml fe18aec530b716b4d80c29b1730bdddb904bde36
@@ -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
============================================================
--- view.ml 046fbee5cc9e1c486a798b69a33764c8d1bc49a8
+++ view.ml 69c88b304f62c440cbc49ec4c62a89a98a42da90
@@ -53,7 +53,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 ;
}
@@ -330,9 +329,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 -> ()
@@ -352,27 +349,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 () ->
@@ -382,8 +374,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
@@ -395,7 +385,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 ->
@@ -407,10 +397,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 } =
@@ -988,8 +981,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 ;
@@ -1022,7 +1013,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_misc.mli 0d137b9883d1ce144629f5b0aa5872752f9e1b6b
+++ viz_misc.mli 3a6714c41817a7f1c71d6852e4cc45b7c4962871
@@ -26,6 +26,7 @@ val debug : string -> bool
val get_home_dir : unit -> string
val debug : string -> bool
+val log : string -> ('a, unit, string, unit) format4 -> 'a
module Signal :
sig
============================================================
--- 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 = [] ;