monotone-viz-1.0.2.orig/0000755000000000000000000000000011353375135012011 5ustar monotone-viz-1.0.2.orig/Makefile0000644000000000000000000001234211307311436013444 0ustar include config.make MLINCDIRS_LOCAL = -I glib MLINCDIRS = -I $(LABLGTK_DIR) $(MLINCDIRS_LOCAL) GTK_CFLAGS := $(shell pkg-config gtk+-2.0 --cflags) GNOMECANVAS_CFLAGS := $(shell pkg-config libgnomecanvas-2.0 pangoft2 --cflags) SRC = glib/gspawn.ml glib/gspawn.mli glib/giochannel.ml glib/giochannel.mli \ glib/viz_gmisc.ml glib/gpattern.ml \ viz_misc.ml viz_misc.mli viz_types.ml viz_types.mli \ q.ml q.mli \ dot_lexer.ml dot_parser.ml dot_parser.mli \ basic_io_lexer.mli basic_io_lexer.ml revision.mli revision.ml \ subprocess.ml subprocess.mli \ components.ml \ automate.mli automate.ml monotone.mli monotone.ml \ agraph.ml agraph.mli \ autocolor.ml autocolor.mli viz_style.ml viz_style.mli \ version.ml icon.ml ui.ml ui.mli unidiff.ml unidiff.mli \ view.ml view.mli query.ml query.mli app.ml app.mli main.ml C_OBJ = glib/ocaml-gspawn.o glib/ocaml-giochannel.o \ glib/ocaml-misc.o glib/ocaml-gdate.o glib/ocaml-gpattern.o \ gnomecanvas_hack.o USE_P4 = viz_style.ml revision.ml OBJ = $(patsubst %.ml,%.cmo,$(filter %.ml, $(SRC))) OBJX = $(patsubst %.ml,%.cmx,$(filter %.ml, $(SRC))) DISTSRC = Makefile configure.ac config.make.in ocaml.m4 configure aclocal.m4 \ monotone-viz.style.sample README INSTALL NEWS COPYING version.ml.in \ viz_misc.ml viz_misc.mli viz_types.ml viz_types.mli q.ml q.mli \ autocolor.ml autocolor.mli viz_style.ml viz_style.mli \ dot_types.mli dot_lexer.mll dot_parser.mly \ subprocess.ml subprocess.mli icon.ml ui.ml ui.mli \ basic_io_lexer.mll basic_io_lexer.mli revision.mli revision.ml \ components.ml automate.mli automate.ml monotone.mli monotone.ml 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 \ glib/gspawn.ml glib/gspawn.mli glib/giochannel.ml glib/giochannel.mli \ glib/viz_gmisc.ml glib/gpattern.ml \ glib/ocaml-gspawn.c glib/ocaml-giochannel.c \ glib/ocaml-misc.c glib/ocaml-gdate.c glib/ocaml-gpattern.c \ glib/gspawn_tags.var glib/giochannel_tags.var DIST_LABLGTK= lablgtk/configure lablgtk/configure.in lablgtk/config.make.in \ lablgtk/COPYING lablgtk/CHANGES lablgtk/README* \ lablgtk/Makefile lablgtk/src/Makefile lablgtk/src/.depend \ lablgtk/src/*.ml lablgtk/src/*.ml[il4] lablgtk/src/*.props \ lablgtk/src/*.[ch] lablgtk/src/*.var lablgtk/src/lablgtk2.in LIB3RDPARTY_OBJ = $(C_OBJ) ifeq ($(OCAMLBEST), opt) monotone-viz : $(OBJX) lib3rdparty.a $(OCAMLOPT) -o $@ -I $(LABLGTK_DIR) $(MLLIBS) $^ monotone-viz : MLLIBS = str.cmxa lablgtk.cmxa gtkInit.cmx lablgnomecanvas.cmxa ifeq ($(LOCAL_LABLGTK), yes) $(OBJX) : .lablgtk endif else monotone-viz : $(OBJ) lib3rdparty.a $(OCAMLC) -custom -o $@ -I $(LABLGTK_DIR) $(MLLIBS) $^ monotone-viz : MLLIBS = str.cma lablgtk.cma gtkInit.cmo lablgnomecanvas.cma ifeq ($(LOCAL_LABLGTK), yes) $(OBJ) : .lablgtk endif endif lib3rdparty.a : $(C_OBJ) ar crs lib3rdparty.a $(LIB3RDPARTY_OBJ) glib/ocaml-gspawn.o : glib/gspawn_tags.c glib/gspawn_tags.h glib/ocaml-giochannel.o : glib/giochannel_tags.c glib/giochannel_tags.h glib/ocaml-%.o : CINCDIRS = -I $(LABLGTK_DIR) -ccopt "$(GTK_CFLAGS)" gnomecanvas_hack.o : CINCDIRS = -ccopt "$(GNOMECANVAS_CFLAGS)" REVISION_FILE := $(shell test -r _MTN/revision && echo _MTN/revision) REVISION_ID = $(shell mtn automate get_base_revision_id) version.ml : version.ml.in $(REVISION_FILE) sed -e 's/@REVISION@/$(REVISION_ID)/' -e 's/@VERSION@/$(VERSION)/' < $< > $@ %.ml : %.mll $(OCAMLLEX) $< %.mli %.ml : %.mly $(OCAMLYACC) $< PP = $(if $(findstring $(1),$(USE_P4)),-pp $(CAMLP4O)) %.cmo : %.ml $(OCAMLC) $(MLFLAGS) $(MLINCDIRS) $(call PP,$<) -c $< %.cmx : %.ml $(OCAMLOPT) $(MLFLAGS) $(MLINCDIRS) $(call PP,$<) -c $< %.cmi : %.mli $(OCAMLC) $(MLINCDIRS) $< %.o : %.c cd $( $@ @$(OCAMLDEP) $(DEP_FLAGS) -pp '$(CAMLP4O)' $(USE_P4) >> $@ dist : ../$(NAME)-$(VERSION).tar.gz 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)/,$^) && \ mv $(NAME)-$(VERSION) "$$DIRNAME" # no config.make ifndef OCAMLLEX $(error run ./configure first (cf README)) endif .lablgtk : $(MAKE) -C lablgtk world touch $@ monotone-viz-1.0.2.orig/configure.ac0000644000000000000000000000465411307306022014274 0ustar AC_INIT(monotone-viz, 1.0.2) AC_PROG_OCAML AC_PROG_OCAML_TOOLS AC_PROG_CAMLP4 if test -z "$CAMLP4O" ; then AC_MSG_ERROR([ Could not find camlp4o. Camlp4 is required to build monotone-viz.]) fi AC_ARG_PROGRAM # Check LablGTK AC_ARG_VAR(LABLGTK_DIR,[LablGTK location]) AC_ARG_WITH([lablgtk-dir], AS_HELP_STRING([--with-lablgtk-dir=], [specify location of lablgtk library]), LABLGTK_DIR=$withval) AC_ARG_WITH([local-lablgtk], AS_HELP_STRING([--without-local-lablgtk], [do not use the local copy of lablgtk]), LOCAL_LABLGTK=$withval, LOCAL_LABLGTK=maybe) AC_SUBST(LOCAL_LABLGTK) # Check if the local lablgtk is present and wether to use it if test "$LOCAL_LABLGTK" = "yes" ; then if ! test -d "lablgtk" ; then AC_MSG_ERROR([ Could not find the local LablGTK tree.]) fi elif test "$LOCAL_LABLGTK" = "maybe" ; then if test -d "lablgtk" ; then LOCAL_LABLGTK=yes else LOCAL_LABLGTK=no fi else LOCAL_LABLGTK=no fi if test "$LOCAL_LABLGTK" = "no" ; then 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 AC_MSG_ERROR([ Could not find LablGTK. Make sure LablGTK >= 2.4.0 is installed and 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/@")" # Check if LablGTK was compiled with libgnomecanvas support AC_MSG_CHECKING([GnomeCanvas support]) if test -r "$LABLGTK_DIR/lablgnomecanvas.cma" ; then AC_MSG_RESULT(found) else AC_MSG_ERROR([ libgnomecanvas support not found. LablGTK need to be built with GnomeCanvas support.]) fi # Check if LablGTK is natively compiled if test -r "$LABLGTK_DIR/lablgtk.cmxa" -a -r "$LABLGTK_DIR/lablgnomecanvas.cmxa"; then echo [Using the native code compiler] else echo [Using the byte code compiler] OCAMLBEST=byte fi else echo echo echo [CONFIGURING LOCAL LABLGTK] echo echo cd lablgtk ./configure --without-gl --without-glade --without-rsvg --with-gnomecanvas --without-gnomeui --without-panel --without-gtkspell cd .. echo echo echo [DONE CONFIGURING LOCAL LABLGTK] echo echo fi # Keep CPPFLAGS around, can be useful if caml headers are in a # non-standard location. AC_SUBST(CPPFLAGS) AC_OUTPUT(config.make) monotone-viz-1.0.2.orig/config.make.in0000644000000000000000000000101010573632162014511 0ustar # -*- makefile -*- OCAMLBEST = @OCAMLBEST@ OCAMLC = @OCAMLC@ OCAMLOPT = @OCAMLOPT@ OCAMLLEX = @OCAMLLEX@ OCAMLYACC = @OCAMLYACC@ OCAMLDEP = @OCAMLDEP@ CAMLP4O = @CAMLP4O@ LOCAL_LABLGTK := @LOCAL_LABLGTK@ ifeq ($(LOCAL_LABLGTK), yes) LABLGTK_DIR := $(shell pwd)/lablgtk/src else LABLGTK_DIR := @LABLGTK_DIR@ endif CPPFLAGS := @CPPFLAGS@ prefix := @prefix@ exec_prefix := @exec_prefix@ bindir := @bindir@ transform := @program_transform_name@ NAME := @PACKAGE_NAME@ VERSION := @PACKAGE_VERSION@ monotone-viz-1.0.2.orig/ocaml.m40000644000000000000000000001310310573632162013343 0ustar dnl -*- autoconf -*- macros for OCaml dnl by Olivier Andrieu dnl from a configure.in by Jean-Christophe FilliĆ¢tre, dnl from a first script by Georges Mariano dnl dnl defines AC_PROG_OCAML that will check the OCaml compiler dnl and set the following variables : dnl OCAMLC "ocamlc" if present in the path, or a failure dnl or "ocamlc.opt" if present with same version number as ocamlc dnl OCAMLOPT "ocamlopt" (or "ocamlopt.opt" if present), or unset dnl OCAMLBEST either "byte" if no native compiler was found, dnl "opt" otherwise dnl OCAMLDEP "ocamldep" dnl OCAMLLIB the path to the ocaml standard library dnl OCAMLVERSION the ocaml version number dnl dnl OCAMLMKTOP dnl OCAMLMKLIB dnl OCAMLDOC AC_DEFUN([AC_PROG_OCAML], [dnl # checking for ocamlc AC_CHECK_PROG(OCAMLC,ocamlc,ocamlc,AC_MSG_ERROR(Cannot find ocamlc.)) OCAMLVERSION=$($OCAMLC -version) AC_MSG_RESULT(OCaml version is $OCAMLVERSION) OCAMLLIB=$($OCAMLC -where) AC_MSG_RESULT(OCaml library path is $OCAMLLIB) # checking for ocamlopt AC_CHECK_PROG(OCAMLOPT,ocamlopt,ocamlopt) OCAMLBEST=byte if test -z "$OCAMLOPT"; then AC_MSG_WARN(Cannot find ocamlopt; bytecode compilation only.) else TMPVERSION=$($OCAMLOPT -version) if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT(versions differs from ocamlc; ocamlopt discarded.) unset OCAMLOPT else OCAMLBEST=opt fi fi # checking for ocamlc.opt AC_CHECK_PROG(OCAMLCDOTOPT,ocamlc.opt,ocamlc.opt) if test "$OCAMLCDOTOPT"; then TMPVERSION=$($OCAMLCDOTOPT -version) if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT(versions differs from ocamlc; ocamlc.opt discarded.) else OCAMLC=$OCAMLCDOTOPT fi fi # checking for ocamlopt.opt if test "$OCAMLOPT" ; then AC_CHECK_PROG(OCAMLOPTDOTOPT,ocamlopt.opt,ocamlopt.opt) if test "$OCAMLOPTDOTOPT"; then TMPVERSION=$($OCAMLOPTDOTOPT -version) if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT(version differs from ocamlc; ocamlopt.opt discarded.) else OCAMLOPT=$OCAMLOPTDOTOPT fi fi fi # checking for ocamldep AC_CHECK_PROG(OCAMLDEP,ocamldep,ocamldep,AC_MSG_ERROR(Cannot find ocamldep.)) #checking for ocamlmktop AC_CHECK_PROG(OCAMLMKTOP,ocamlmktop,ocamlmktop, AC_MSG_WARN(Cannot find ocamlmktop.)) #checking for ocamlmklib AC_CHECK_PROG(OCAMLMKLIB,ocamlmklib,ocamlmklib, AC_MSG_WARN(Cannot find ocamlmklib.)) # checking for ocamldoc AC_CHECK_PROG(OCAMLDOC,ocamldoc,ocamldoc, AC_MSG_WARN(Cannot find ocamldoc.)) # get the C compiler used by ocamlc if test -z "$CC" ; then touch conftest.c CC=$($OCAMLC -verbose conftest.c 2>&1 | awk '/^\+/ {print $[]2 ; exit}') echo OCaml uses $CC to compile C files fi AC_SUBST(OCAMLC) AC_SUBST(OCAMLOPT) AC_SUBST(OCAMLDEP) AC_SUBST(OCAMLBEST) AC_SUBST(OCAMLVERSION) AC_SUBST(OCAMLLIB) AC_SUBST(OCAMLMKLIB) AC_SUBST(OCAMLMKTOP) AC_SUBST(OCAMLDOC) ]) dnl dnl dnl dnl macro AC_PROG_OCAML_TOOLS will check OCamllex and OCamlyacc : dnl OCAMLLEX "ocamllex" or "ocamllex.opt" if present dnl OCAMLYACC "ocamlyac" AC_DEFUN([AC_PROG_OCAML_TOOLS], [dnl # checking for ocamllex and ocamlyacc AC_CHECK_PROG(OCAMLLEX,ocamllex,ocamllex,AC_MSG_ERROR(Cannot find ocamllex.)) if test "$OCAMLLEX"; then AC_CHECK_PROG(OCAMLLEXDOTOPT,ocamllex.opt,ocamllex.opt) if test "$OCAMLLEXDOTOPT"; then OCAMLLEX=$OCAMLLEXDOTOPT fi else AC_MSG_ERROR(Cannot find ocamllex.) fi AC_CHECK_PROG(OCAMLYACC,ocamlyacc,ocamlyacc,AC_MSG_ERROR(Cannot find ocamlyacc.)) AC_SUBST(OCAMLLEX) AC_SUBST(OCAMLYACC) ]) dnl dnl dnl dnl AC_PROG_CAMLP4 checks for Camlp4 AC_DEFUN([AC_PROG_CAMLP4], [dnl AC_REQUIRE([AC_PROG_OCAML]) # checking for camlp4 AC_CHECK_PROG(CAMLP4,camlp4,camlp4) if test "$CAMLP4"; then TMPVERSION=$($CAMLP4 -v 2>&1| sed -n -e 's|.*version *\(.*\)$|\1|p') if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_ERROR(versions differs from ocamlc) else AC_CHECK_PROG(CAMLP4O,camlp4o,camlp4o) fi fi AC_SUBST(CAMLP4) AC_SUBST(CAMLP4O) ]) dnl dnl dnl dnl macro AC_PROG_FINDLIB will check for the presence of dnl ocamlfind if configure is called with --with-findlib AC_DEFUN([AC_PROG_FINDLIB], [dnl AC_ARG_WITH(findlib,[ --with-findlib use findlib package system], use_findlib="$withval") # checking for ocamlfind if test "$use_findlib" = yes ; then AC_CHECK_PROG(OCAMLFIND,ocamlfind,ocamlfind, AC_MSG_ERROR(ocamlfind not found)) else unset OCAMLFIND fi AC_SUBST(OCAMLFIND) ]) dnl dnl dnl dnl AC_CHECK_OCAML_PKG checks wether a findlib package is present dnl defines pkg_name to name AC_DEFUN([AC_CHECK_OCAML_PKG], [dnl AC_REQUIRE([AC_PROG_FINDLIB]) if test "$use_findlib" = yes ; then AC_MSG_CHECKING(findlib package $1) if $OCAMLFIND query $1 >/dev/null 2>/dev/null; then AC_MSG_RESULT(found) pkg_$1="$1" else AC_MSG_WARN(not found) unset pkg_$1 fi fi ]) dnl dnl dnl dnl AC_ARG_OCAML_INSTALLDIR adds a --with-installdir option AC_DEFUN([AC_ARG_OCAML_INSTALLDIR], [dnl AC_ARG_WITH(installdir,[ --with-installdir=DIR specify installation directory],INSTALLDIR="$withval") if ! test "$INSTALLDIR" -o "$use_findlib" ; then INSTALLDIR='$(OCAMLLIB)/$(NAME)' fi AC_SUBST(INSTALLDIR) ]) dnl dnl dnl dnl AC_CHECK_OCAML_MODULE looks for a module in a given path dnl 1 -> name (for printing) dnl 2 -> env var name dnl 3 -> module to check dnl 4 -> default dirs AC_DEFUN([AC_CHECK_OCAML_MODULE], [dnl AC_MSG_CHECKING($1 directory) cat > conftest.ml < /dev/null 2>&1 ; then found=yes break fi done if test "$found" ; then AC_MSG_RESULT($$2) else AC_MSG_RESULT(not found) unset $2 fi AC_SUBST($2)]) monotone-viz-1.0.2.orig/configure0000755000000000000000000030671511307311130013714 0ustar #! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.63 for monotone-viz 1.0.2. # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix ;; esac fi # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo if (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' else if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' else as_echo_body='eval expr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval arg=$1; case $arg in *"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; esac; expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi export as_echo_body as_echo='sh -c $as_echo_body as_echo' fi # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || $as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH if test "x$CONFIG_SHELL" = x; then if (eval ":") 2>/dev/null; then as_have_required=yes else as_have_required=no fi if test $as_have_required = yes && (eval ": (as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=\$LINENO as_lineno_2=\$LINENO test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } ") 2> /dev/null; then : else as_candidate_shells= as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. case $as_dir in /*) for as_base in sh bash ksh sh5; do as_candidate_shells="$as_candidate_shells $as_dir/$as_base" done;; esac done IFS=$as_save_IFS for as_shell in $as_candidate_shells $SHELL; do # Try only shells that exist, to save several forks. if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { ("$as_shell") 2> /dev/null <<\_ASEOF if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix ;; esac fi : _ASEOF }; then CONFIG_SHELL=$as_shell as_have_required=yes if { "$as_shell" 2> /dev/null <<\_ASEOF if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix ;; esac fi : (as_func_return () { (exit $1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = "$1" ); then : else exitcode=1 echo positional parameters were not saved. fi test $exitcode = 0) || { (exit 1); exit 1; } ( as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } _ASEOF }; then break fi fi done if test "x$CONFIG_SHELL" != x; then for as_var in BASH_ENV ENV do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done export CONFIG_SHELL exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} fi if test $as_have_required = no; then echo This script requires a shell more modern than all the echo shells that I found on your system. Please install a echo modern shell, or manually run the script under such a echo shell if you do have one. { (exit 1); exit 1; } fi fi fi (eval "as_func_return () { (exit \$1) } as_func_success () { as_func_return 0 } as_func_failure () { as_func_return 1 } as_func_ret_success () { return 0 } as_func_ret_failure () { return 1 } exitcode=0 if as_func_success; then : else exitcode=1 echo as_func_success failed. fi if as_func_failure; then exitcode=1 echo as_func_failure succeeded. fi if as_func_ret_success; then : else exitcode=1 echo as_func_ret_success failed. fi if as_func_ret_failure; then exitcode=1 echo as_func_ret_failure succeeded. fi if ( set x; as_func_ret_success y && test x = \"\$1\" ); then : else exitcode=1 echo positional parameters were not saved. fi test \$exitcode = 0") || { echo No shell found that supports shell functions. echo Please tell bug-autoconf@gnu.org about your system, echo including any error possibly output before this message. echo This can help us improve future autoconf versions. echo Configuration will now proceed without shell functions. } as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi if test -x / >/dev/null 2>&1; then as_test_x='test -x' else if ls -dL / >/dev/null 2>&1; then as_ls_L_option=L else as_ls_L_option= fi as_test_x=' eval sh -c '\'' if test -d "$1"; then test -d "$1/."; else case $1 in -*)set "./$1";; esac; case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in ???[sx]*):;;*)false;;esac;fi '\'' sh ' fi as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='monotone-viz' PACKAGE_TARNAME='monotone-viz' PACKAGE_VERSION='1.0.2' PACKAGE_STRING='monotone-viz 1.0.2' PACKAGE_BUGREPORT='' ac_subst_vars='LTLIBOBJS LIBOBJS CPPFLAGS LOCAL_LABLGTK LABLGTK_DIR CAMLP4O CAMLP4 OCAMLYACC OCAMLLEXDOTOPT OCAMLLEX OCAMLLIB OCAMLVERSION OCAMLBEST OCAMLDOC OCAMLMKLIB OCAMLMKTOP OCAMLDEP OCAMLOPTDOTOPT OCAMLCDOTOPT OCAMLOPT OCAMLC target_alias host_alias build_alias LIBS ECHO_T ECHO_N ECHO_C DEFS mandir localedir libdir psdir pdfdir dvidir htmldir infodir docdir oldincludedir includedir localstatedir sharedstatedir sysconfdir datadir datarootdir libexecdir sbindir bindir program_transform_name prefix exec_prefix PACKAGE_BUGREPORT PACKAGE_STRING PACKAGE_VERSION PACKAGE_TARNAME PACKAGE_NAME PATH_SEPARATOR SHELL' ac_subst_files='' ac_user_opts=' enable_option_checking with_lablgtk_dir with_local_lablgtk ' ac_precious_vars='build_alias host_alias target_alias LABLGTK_DIR' # Initialize some variables set by options. ac_init_help= ac_init_version=false ac_unrecognized_opts= ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && { $as_echo "$as_me: error: invalid feature name: $ac_useropt" >&2 { (exit 1); exit 1; }; } ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && { $as_echo "$as_me: error: invalid feature name: $ac_useropt" >&2 { (exit 1); exit 1; }; } ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && { $as_echo "$as_me: error: invalid package name: $ac_useropt" >&2 { (exit 1); exit 1; }; } ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && { $as_echo "$as_me: error: invalid package name: $ac_useropt" >&2 { (exit 1); exit 1; }; } ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { $as_echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { $as_echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { $as_echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;; fatal) { $as_echo "$as_me: error: unrecognized options: $ac_unrecognized_opts" >&2 { (exit 1); exit 1; }; } ;; *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi # Check all directory arguments for consistency. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var # Remove trailing slashes. case $ac_val in */ ) ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` eval $ac_var=\$ac_val;; esac # Be sure to have absolute directory names. case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac { $as_echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; } done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || { $as_echo "$as_me: error: working directory cannot be determined" >&2 { (exit 1); exit 1; }; } test "X$ac_ls_di" = "X$ac_pwd_ls_di" || { $as_echo "$as_me: error: pwd does not report name of working directory" >&2 { (exit 1); exit 1; }; } # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$as_myself" || $as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_myself" : 'X\(//\)[^/]' \| \ X"$as_myself" : 'X\(//\)$' \| \ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_myself" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." { $as_echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || { $as_echo "$as_me: error: $ac_msg" >&2 { (exit 1); exit 1; }; } pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures monotone-viz 1.0.2 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/monotone-viz] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF Program names: --program-prefix=PREFIX prepend PREFIX to installed program names --program-suffix=SUFFIX append SUFFIX to installed program names --program-transform-name=PROGRAM run sed PROGRAM on installed program names _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of monotone-viz 1.0.2:";; esac cat <<\_ACEOF Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-lablgtk-dir= specify location of lablgtk library --without-local-lablgtk do not use the local copy of lablgtk Some influential environment variables: LABLGTK_DIR LablGTK location Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF monotone-viz configure 1.0.2 generated by GNU Autoconf 2.63 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by monotone-viz $as_me 1.0.2, which was generated by GNU Autoconf 2.63. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. $as_echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { $as_echo "$as_me:$LINENO: WARNING: cache variable $ac_var contains a newline" >&5 $as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac $as_echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------------- ## ## File substitutions. ## ## ------------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac $as_echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo cat confdefs.h echo fi test "$ac_signal" != 0 && $as_echo "$as_me: caught signal $ac_signal" $as_echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer an explicitly selected file to automatically selected ones. ac_site_file1=NONE ac_site_file2=NONE if test -n "$CONFIG_SITE"; then ac_site_file1=$CONFIG_SITE elif test "x$prefix" != xNONE; then ac_site_file1=$prefix/share/config.site ac_site_file2=$prefix/etc/config.site else ac_site_file1=$ac_default_prefix/share/config.site ac_site_file2=$ac_default_prefix/etc/config.site fi for ac_site_file in "$ac_site_file1" "$ac_site_file2" do test "x$ac_site_file" = xNONE && continue if test -r "$ac_site_file"; then { $as_echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 $as_echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { $as_echo "$as_me:$LINENO: loading cache $cache_file" >&5 $as_echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { $as_echo "$as_me:$LINENO: creating cache $cache_file" >&5 $as_echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { $as_echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 $as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { $as_echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 $as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then # differences in whitespace do not lead to failure. ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then { $as_echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 $as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else { $as_echo "$as_me:$LINENO: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 $as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi { $as_echo "$as_me:$LINENO: former value: \`$ac_old_val'" >&5 $as_echo "$as_me: former value: \`$ac_old_val'" >&2;} { $as_echo "$as_me:$LINENO: current value: \`$ac_new_val'" >&5 $as_echo "$as_me: current value: \`$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} { $as_echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 $as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { $as_echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 $as_echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # checking for ocamlc # Extract the first word of "ocamlc", so it can be a program name with args. set dummy ocamlc; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_OCAMLC+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$OCAMLC"; then ac_cv_prog_OCAMLC="$OCAMLC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_OCAMLC="ocamlc" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLC" && ac_cv_prog_OCAMLC="{ { $as_echo "$as_me:$LINENO: error: Cannot find ocamlc." >&5 $as_echo "$as_me: error: Cannot find ocamlc." >&2;} { (exit 1); exit 1; }; }" fi fi OCAMLC=$ac_cv_prog_OCAMLC if test -n "$OCAMLC"; then { $as_echo "$as_me:$LINENO: result: $OCAMLC" >&5 $as_echo "$OCAMLC" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi OCAMLVERSION=$($OCAMLC -version) { $as_echo "$as_me:$LINENO: result: OCaml version is $OCAMLVERSION" >&5 $as_echo "OCaml version is $OCAMLVERSION" >&6; } OCAMLLIB=$($OCAMLC -where) { $as_echo "$as_me:$LINENO: result: OCaml library path is $OCAMLLIB" >&5 $as_echo "OCaml library path is $OCAMLLIB" >&6; } # checking for ocamlopt # Extract the first word of "ocamlopt", so it can be a program name with args. set dummy ocamlopt; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_OCAMLOPT+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$OCAMLOPT"; then ac_cv_prog_OCAMLOPT="$OCAMLOPT" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_OCAMLOPT="ocamlopt" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi OCAMLOPT=$ac_cv_prog_OCAMLOPT if test -n "$OCAMLOPT"; then { $as_echo "$as_me:$LINENO: result: $OCAMLOPT" >&5 $as_echo "$OCAMLOPT" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi OCAMLBEST=byte if test -z "$OCAMLOPT"; then { $as_echo "$as_me:$LINENO: WARNING: Cannot find ocamlopt; bytecode compilation only." >&5 $as_echo "$as_me: WARNING: Cannot find ocamlopt; bytecode compilation only." >&2;} else TMPVERSION=$($OCAMLOPT -version) if test "$TMPVERSION" != "$OCAMLVERSION" ; then { $as_echo "$as_me:$LINENO: result: versions differs from ocamlc; ocamlopt discarded." >&5 $as_echo "versions differs from ocamlc; ocamlopt discarded." >&6; } unset OCAMLOPT else OCAMLBEST=opt fi fi # checking for ocamlc.opt # Extract the first word of "ocamlc.opt", so it can be a program name with args. set dummy ocamlc.opt; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_OCAMLCDOTOPT+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$OCAMLCDOTOPT"; then ac_cv_prog_OCAMLCDOTOPT="$OCAMLCDOTOPT" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_OCAMLCDOTOPT="ocamlc.opt" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi OCAMLCDOTOPT=$ac_cv_prog_OCAMLCDOTOPT if test -n "$OCAMLCDOTOPT"; then { $as_echo "$as_me:$LINENO: result: $OCAMLCDOTOPT" >&5 $as_echo "$OCAMLCDOTOPT" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi if test "$OCAMLCDOTOPT"; then TMPVERSION=$($OCAMLCDOTOPT -version) if test "$TMPVERSION" != "$OCAMLVERSION" ; then { $as_echo "$as_me:$LINENO: result: versions differs from ocamlc; ocamlc.opt discarded." >&5 $as_echo "versions differs from ocamlc; ocamlc.opt discarded." >&6; } else OCAMLC=$OCAMLCDOTOPT fi fi # checking for ocamlopt.opt if test "$OCAMLOPT" ; then # Extract the first word of "ocamlopt.opt", so it can be a program name with args. set dummy ocamlopt.opt; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_OCAMLOPTDOTOPT+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$OCAMLOPTDOTOPT"; then ac_cv_prog_OCAMLOPTDOTOPT="$OCAMLOPTDOTOPT" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_OCAMLOPTDOTOPT="ocamlopt.opt" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi OCAMLOPTDOTOPT=$ac_cv_prog_OCAMLOPTDOTOPT if test -n "$OCAMLOPTDOTOPT"; then { $as_echo "$as_me:$LINENO: result: $OCAMLOPTDOTOPT" >&5 $as_echo "$OCAMLOPTDOTOPT" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi if test "$OCAMLOPTDOTOPT"; then TMPVERSION=$($OCAMLOPTDOTOPT -version) if test "$TMPVERSION" != "$OCAMLVERSION" ; then { $as_echo "$as_me:$LINENO: result: version differs from ocamlc; ocamlopt.opt discarded." >&5 $as_echo "version differs from ocamlc; ocamlopt.opt discarded." >&6; } else OCAMLOPT=$OCAMLOPTDOTOPT fi fi fi # checking for ocamldep # Extract the first word of "ocamldep", so it can be a program name with args. set dummy ocamldep; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_OCAMLDEP+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$OCAMLDEP"; then ac_cv_prog_OCAMLDEP="$OCAMLDEP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_OCAMLDEP="ocamldep" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLDEP" && ac_cv_prog_OCAMLDEP="{ { $as_echo "$as_me:$LINENO: error: Cannot find ocamldep." >&5 $as_echo "$as_me: error: Cannot find ocamldep." >&2;} { (exit 1); exit 1; }; }" fi fi OCAMLDEP=$ac_cv_prog_OCAMLDEP if test -n "$OCAMLDEP"; then { $as_echo "$as_me:$LINENO: result: $OCAMLDEP" >&5 $as_echo "$OCAMLDEP" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi #checking for ocamlmktop # Extract the first word of "ocamlmktop", so it can be a program name with args. set dummy ocamlmktop; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_OCAMLMKTOP+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$OCAMLMKTOP"; then ac_cv_prog_OCAMLMKTOP="$OCAMLMKTOP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_OCAMLMKTOP="ocamlmktop" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLMKTOP" && ac_cv_prog_OCAMLMKTOP="{ $as_echo "$as_me:$LINENO: WARNING: Cannot find ocamlmktop." >&5 $as_echo "$as_me: WARNING: Cannot find ocamlmktop." >&2;}" fi fi OCAMLMKTOP=$ac_cv_prog_OCAMLMKTOP if test -n "$OCAMLMKTOP"; then { $as_echo "$as_me:$LINENO: result: $OCAMLMKTOP" >&5 $as_echo "$OCAMLMKTOP" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi #checking for ocamlmklib # Extract the first word of "ocamlmklib", so it can be a program name with args. set dummy ocamlmklib; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_OCAMLMKLIB+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$OCAMLMKLIB"; then ac_cv_prog_OCAMLMKLIB="$OCAMLMKLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_OCAMLMKLIB="ocamlmklib" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLMKLIB" && ac_cv_prog_OCAMLMKLIB="{ $as_echo "$as_me:$LINENO: WARNING: Cannot find ocamlmklib." >&5 $as_echo "$as_me: WARNING: Cannot find ocamlmklib." >&2;}" fi fi OCAMLMKLIB=$ac_cv_prog_OCAMLMKLIB if test -n "$OCAMLMKLIB"; then { $as_echo "$as_me:$LINENO: result: $OCAMLMKLIB" >&5 $as_echo "$OCAMLMKLIB" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi # checking for ocamldoc # Extract the first word of "ocamldoc", so it can be a program name with args. set dummy ocamldoc; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_OCAMLDOC+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$OCAMLDOC"; then ac_cv_prog_OCAMLDOC="$OCAMLDOC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_OCAMLDOC="ocamldoc" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLDOC" && ac_cv_prog_OCAMLDOC="{ $as_echo "$as_me:$LINENO: WARNING: Cannot find ocamldoc." >&5 $as_echo "$as_me: WARNING: Cannot find ocamldoc." >&2;}" fi fi OCAMLDOC=$ac_cv_prog_OCAMLDOC if test -n "$OCAMLDOC"; then { $as_echo "$as_me:$LINENO: result: $OCAMLDOC" >&5 $as_echo "$OCAMLDOC" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi # get the C compiler used by ocamlc if test -z "$CC" ; then touch conftest.c CC=$($OCAMLC -verbose conftest.c 2>&1 | awk '/^\+/ {print $2 ; exit}') echo OCaml uses $CC to compile C files fi # checking for ocamllex and ocamlyacc # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_OCAMLLEX+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$OCAMLLEX"; then ac_cv_prog_OCAMLLEX="$OCAMLLEX" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_OCAMLLEX="ocamllex" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLLEX" && ac_cv_prog_OCAMLLEX="{ { $as_echo "$as_me:$LINENO: error: Cannot find ocamllex." >&5 $as_echo "$as_me: error: Cannot find ocamllex." >&2;} { (exit 1); exit 1; }; }" fi fi OCAMLLEX=$ac_cv_prog_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:$LINENO: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi if test "$OCAMLLEX"; then # Extract the first word of "ocamllex.opt", so it can be a program name with args. set dummy ocamllex.opt; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_OCAMLLEXDOTOPT+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$OCAMLLEXDOTOPT"; then ac_cv_prog_OCAMLLEXDOTOPT="$OCAMLLEXDOTOPT" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_OCAMLLEXDOTOPT="ocamllex.opt" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi OCAMLLEXDOTOPT=$ac_cv_prog_OCAMLLEXDOTOPT if test -n "$OCAMLLEXDOTOPT"; then { $as_echo "$as_me:$LINENO: result: $OCAMLLEXDOTOPT" >&5 $as_echo "$OCAMLLEXDOTOPT" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi if test "$OCAMLLEXDOTOPT"; then OCAMLLEX=$OCAMLLEXDOTOPT fi else { { $as_echo "$as_me:$LINENO: error: Cannot find ocamllex." >&5 $as_echo "$as_me: error: Cannot find ocamllex." >&2;} { (exit 1); exit 1; }; } fi # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_OCAMLYACC+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$OCAMLYACC"; then ac_cv_prog_OCAMLYACC="$OCAMLYACC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_OCAMLYACC="ocamlyacc" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLYACC" && ac_cv_prog_OCAMLYACC="{ { $as_echo "$as_me:$LINENO: error: Cannot find ocamlyacc." >&5 $as_echo "$as_me: error: Cannot find ocamlyacc." >&2;} { (exit 1); exit 1; }; }" fi fi OCAMLYACC=$ac_cv_prog_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:$LINENO: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi # checking for camlp4 # Extract the first word of "camlp4", so it can be a program name with args. set dummy camlp4; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_CAMLP4+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$CAMLP4"; then ac_cv_prog_CAMLP4="$CAMLP4" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CAMLP4="camlp4" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CAMLP4=$ac_cv_prog_CAMLP4 if test -n "$CAMLP4"; then { $as_echo "$as_me:$LINENO: result: $CAMLP4" >&5 $as_echo "$CAMLP4" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi if test "$CAMLP4"; then TMPVERSION=$($CAMLP4 -v 2>&1| sed -n -e 's|.*version *\(.*\)$|\1|p') if test "$TMPVERSION" != "$OCAMLVERSION" ; then { { $as_echo "$as_me:$LINENO: error: versions differs from ocamlc" >&5 $as_echo "$as_me: error: versions differs from ocamlc" >&2;} { (exit 1); exit 1; }; } else # Extract the first word of "camlp4o", so it can be a program name with args. set dummy camlp4o; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if test "${ac_cv_prog_CAMLP4O+set}" = set; then $as_echo_n "(cached) " >&6 else if test -n "$CAMLP4O"; then ac_cv_prog_CAMLP4O="$CAMLP4O" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CAMLP4O="camlp4o" $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CAMLP4O=$ac_cv_prog_CAMLP4O if test -n "$CAMLP4O"; then { $as_echo "$as_me:$LINENO: result: $CAMLP4O" >&5 $as_echo "$CAMLP4O" >&6; } else { $as_echo "$as_me:$LINENO: result: no" >&5 $as_echo "no" >&6; } fi fi fi if test -z "$CAMLP4O" ; then { { $as_echo "$as_me:$LINENO: error: Could not find camlp4o. Camlp4 is required to build monotone-viz." >&5 $as_echo "$as_me: error: Could not find camlp4o. Camlp4 is required to build monotone-viz." >&2;} { (exit 1); exit 1; }; } fi test "$program_prefix" != NONE && program_transform_name="s&^&$program_prefix&;$program_transform_name" # Use a double $ so make ignores it. test "$program_suffix" != NONE && program_transform_name="s&\$&$program_suffix&;$program_transform_name" # Double any \ or $. # By default was `s,x,x', remove it if useless. ac_script='s/[\\$]/&&/g;s/;s,x,x,$//' program_transform_name=`$as_echo "$program_transform_name" | sed "$ac_script"` # Check LablGTK # Check whether --with-lablgtk-dir was given. if test "${with_lablgtk_dir+set}" = set; then withval=$with_lablgtk_dir; LABLGTK_DIR=$withval fi # Check whether --with-local-lablgtk was given. if test "${with_local_lablgtk+set}" = set; then withval=$with_local_lablgtk; LOCAL_LABLGTK=$withval else LOCAL_LABLGTK=maybe fi # Check if the local lablgtk is present and wether to use it if test "$LOCAL_LABLGTK" = "yes" ; then if ! test -d "lablgtk" ; then { { $as_echo "$as_me:$LINENO: error: Could not find the local LablGTK tree." >&5 $as_echo "$as_me: error: Could not find the local LablGTK tree." >&2;} { (exit 1); exit 1; }; } fi elif test "$LOCAL_LABLGTK" = "maybe" ; then if test -d "lablgtk" ; then LOCAL_LABLGTK=yes else LOCAL_LABLGTK=no fi else LOCAL_LABLGTK=no fi if test "$LOCAL_LABLGTK" = "no" ; then FINDLIB_LABLGTK="$(ocamlfind query lablgtk2 2> /dev/null)" { $as_echo "$as_me:$LINENO: checking lablgtk directory" >&5 $as_echo_n "checking lablgtk directory... " >&6; } cat > conftest.ml < /dev/null 2>&1 ; then found=yes break fi done if test "$found" ; then { $as_echo "$as_me:$LINENO: result: $LABLGTK_DIR" >&5 $as_echo "$LABLGTK_DIR" >&6; } else { $as_echo "$as_me:$LINENO: result: not found" >&5 $as_echo "not found" >&6; } unset LABLGTK_DIR fi # Stop if LablGTK is not found if test -z "$LABLGTK_DIR" ; then { { $as_echo "$as_me:$LINENO: error: Could not find LablGTK. Make sure LablGTK >= 2.4.0 is installed and specify its location to configure with the \`--with-lablgtk-dir=' option or the LABLGTK_DIR environment variable." >&5 $as_echo "$as_me: error: Could not find LablGTK. Make sure LablGTK >= 2.4.0 is installed and specify its location to configure with the \`--with-lablgtk-dir=' option or the LABLGTK_DIR environment variable." >&2;} { (exit 1); exit 1; }; } fi LABLGTK_DIR="$(echo $LABLGTK_DIR | sed "s@^+@$OCAMLLIB/@")" # Check if LablGTK was compiled with libgnomecanvas support { $as_echo "$as_me:$LINENO: checking GnomeCanvas support" >&5 $as_echo_n "checking GnomeCanvas support... " >&6; } if test -r "$LABLGTK_DIR/lablgnomecanvas.cma" ; then { $as_echo "$as_me:$LINENO: result: found" >&5 $as_echo "found" >&6; } else { { $as_echo "$as_me:$LINENO: error: libgnomecanvas support not found. LablGTK need to be built with GnomeCanvas support." >&5 $as_echo "$as_me: error: libgnomecanvas support not found. LablGTK need to be built with GnomeCanvas support." >&2;} { (exit 1); exit 1; }; } fi # Check if LablGTK is natively compiled if test -r "$LABLGTK_DIR/lablgtk.cmxa" -a -r "$LABLGTK_DIR/lablgnomecanvas.cmxa"; then echo Using the native code compiler else echo Using the byte code compiler OCAMLBEST=byte fi else echo echo echo CONFIGURING LOCAL LABLGTK echo echo cd lablgtk ./configure --without-gl --without-glade --without-rsvg --with-gnomecanvas --without-gnomeui --without-panel --without-gtkspell cd .. echo echo echo DONE CONFIGURING LOCAL LABLGTK echo echo fi # Keep CPPFLAGS around, can be useful if caml headers are in a # non-standard location. ac_config_files="$ac_config_files config.make" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { $as_echo "$as_me:$LINENO: WARNING: cache variable $ac_var contains a newline" >&5 $as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) $as_unset $ac_var ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then test "x$cache_file" != "x/dev/null" && { $as_echo "$as_me:$LINENO: updating cache $cache_file" >&5 $as_echo "$as_me: updating cache $cache_file" >&6;} cat confcache >$cache_file else { $as_echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 $as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. ac_script=' :mline /\\$/{ N s,\\\n,, b mline } t clear :clear s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g t quote s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g t quote b any :quote s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g s/\[/\\&/g s/\]/\\&/g s/\$/$$/g H :any ${ g s/^\n// s/\n/ /g p } ' DEFS=`sed -n "$ac_script" confdefs.h` ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`$as_echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { $as_echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 $as_echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in *posix*) set -o posix ;; esac fi # PATH needs CR # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo if (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' else if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' else as_echo_body='eval expr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval arg=$1; case $arg in *"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; esac; expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi export as_echo_body as_echo='sh -c $as_echo_body as_echo' fi # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 { (exit 1); exit 1; } fi # Work around bugs in pre-3.0 UWIN ksh. for as_var in ENV MAIL MAILPATH do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || $as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # CDPATH. $as_unset CDPATH as_lineno_1=$LINENO as_lineno_2=$LINENO test "x$as_lineno_1" != "x$as_lineno_2" && test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line after each line using $LINENO; the second 'sed' # does the real work. The second script uses 'N' to pair each # line-number line with the line containing $LINENO, and appends # trailing '-' during substitution so that $LINENO is not a special # case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # scripts with optimization help from Paolo Bonzini. Blame Lee # E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in -n*) case `echo 'x\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. *) ECHO_C='\c';; esac;; *) ECHO_N='-n';; esac if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi if test -x / >/dev/null 2>&1; then as_test_x='test -x' else if ls -dL / >/dev/null 2>&1; then as_ls_L_option=L else as_ls_L_option= fi as_test_x=' eval sh -c '\'' if test -d "$1"; then test -d "$1/."; else case $1 in -*)set "./$1";; esac; case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in ???[sx]*):;;*)false;;esac;fi '\'' sh ' fi as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 # Save the log message, to keep $[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by monotone-viz $as_me 1.0.2, which was generated by GNU Autoconf 2.63. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF case $ac_config_files in *" "*) set x $ac_config_files; shift; ac_config_files=$*;; esac cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # Files that config.status was made for. config_files="$ac_config_files" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTION]... [FILE]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit -q, --quiet, --silent do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_version="\\ monotone-viz config.status 1.0.2 configured by $0, generated by GNU Autoconf 2.63, with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2008 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' test -n "\$AWK" || AWK=awk _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # The default lists apply if the user does not specify any file. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) $as_echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift case $ac_optarg in *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; esac CONFIG_FILES="$CONFIG_FILES '$ac_optarg'" ac_need_defaults=false;; --he | --h | --help | --hel | -h ) $as_echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { $as_echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' export CONFIG_SHELL exec "\$@" fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX $as_echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "config.make") CONFIG_FILES="$CONFIG_FILES config.make" ;; *) { { $as_echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 $as_echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= trap 'exit_status=$? { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status ' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || { $as_echo "$as_me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. # This happens for instance with `./config.status config.h'. if test -n "$CONFIG_FILES"; then ac_cr=' ' ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then ac_cs_awk_cr='\\r' else ac_cs_awk_cr=$ac_cr fi echo 'BEGIN {' >"$tmp/subs1.awk" && _ACEOF { echo "cat >conf$$subs.awk <<_ACEOF" && echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && echo "_ACEOF" } >conf$$subs.sh || { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 $as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'` ac_delim='%!_!# ' for ac_last_try in false false false false false :; do . ./conf$$subs.sh || { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 $as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` if test $ac_delim_n = $ac_delim_num; then break elif $ac_last_try; then { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 $as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done rm -f conf$$subs.sh cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 cat >>"\$tmp/subs1.awk" <<\\_ACAWK && _ACEOF sed -n ' h s/^/S["/; s/!.*/"]=/ p g s/^[^!]*!// :repl t repl s/'"$ac_delim"'$// t delim :nl h s/\(.\{148\}\).*/\1/ t more1 s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ p n b repl :more1 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t nl :delim h s/\(.\{148\}\).*/\1/ t more2 s/["\\]/\\&/g; s/^/"/; s/$/"/ p b :more2 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t delim ' >$CONFIG_STATUS || ac_write_fail=1 rm -f conf$$subs.awk cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK cat >>"\$tmp/subs1.awk" <<_ACAWK && for (key in S) S_is_set[key] = 1 FS = "" } { line = $ 0 nfields = split(line, field, "@") substed = 0 len = length(field[1]) for (i = 2; i < nfields; i++) { key = field[i] keylen = length(key) if (S_is_set[key]) { value = S[key] line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) len += length(value) + length(field[++i]) substed = 1 } else len += 1 + keylen } print line } _ACAWK _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" else cat fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \ || { { $as_echo "$as_me:$LINENO: error: could not setup config files machinery" >&5 $as_echo "$as_me: error: could not setup config files machinery" >&2;} { (exit 1); exit 1; }; } _ACEOF # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/ s/:*\${srcdir}:*/:/ s/:*@srcdir@:*/:/ s/^\([^=]*=[ ]*\):*/\1/ s/:*$// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 fi # test -n "$CONFIG_FILES" eval set X " :F $CONFIG_FILES " shift for ac_tag do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) { { $as_echo "$as_me:$LINENO: error: invalid tag $ac_tag" >&5 $as_echo "$as_me: error: invalid tag $ac_tag" >&2;} { (exit 1); exit 1; }; };; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || { { $as_echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 $as_echo "$as_me: error: cannot find input file: $ac_f" >&2;} { (exit 1); exit 1; }; };; esac case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac ac_file_inputs="$ac_file_inputs '$ac_f'" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' `' by configure.' if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { $as_echo "$as_me:$LINENO: creating $ac_file" >&5 $as_echo "$as_me: creating $ac_file" >&6;} fi # Neutralize special characters interpreted by sed in replacement strings. case $configure_input in #( *\&* | *\|* | *\\* ) ac_sed_conf_input=`$as_echo "$configure_input" | sed 's/[\\\\&|]/\\\\&/g'`;; #( *) ac_sed_conf_input=$configure_input;; esac case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin" \ || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5 $as_echo "$as_me: error: could not create $ac_file" >&2;} { (exit 1); exit 1; }; } ;; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` { as_dir="$ac_dir" case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || { { $as_echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 $as_echo "$as_me: error: cannot create directory $as_dir" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= ac_sed_dataroot=' /datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p ' case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { $as_echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 $as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_sed_extra="$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s|@configure_input@|$ac_sed_conf_input|;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@top_build_prefix@&$ac_top_build_prefix&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \ || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5 $as_echo "$as_me: error: could not create $ac_file" >&2;} { (exit 1); exit 1; }; } test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && { $as_echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&5 $as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined." >&2;} rm -f "$tmp/stdin" case $ac_file in -) cat "$tmp/out" && rm -f "$tmp/out";; *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; esac \ || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5 $as_echo "$as_me: error: could not create $ac_file" >&2;} { (exit 1); exit 1; }; } ;; esac done # for ac_tag { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save test $ac_write_fail = 0 || { { $as_echo "$as_me:$LINENO: error: write failure creating $CONFIG_STATUS" >&5 $as_echo "$as_me: error: write failure creating $CONFIG_STATUS" >&2;} { (exit 1); exit 1; }; } # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { $as_echo "$as_me:$LINENO: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} fi monotone-viz-1.0.2.orig/aclocal.m40000644000000000000000000000113310573632216013646 0ustar # generated automatically by aclocal 1.9.6 -*- Autoconf -*- # Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, # 2005 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY, to the extent permitted by law; without # even the implied warranty of MERCHANTABILITY or FITNESS FOR A # PARTICULAR PURPOSE. m4_include([ocaml.m4]) monotone-viz-1.0.2.orig/monotone-viz.style.sample0000644000000000000000000000040710573632162017017 0ustar (* This file should be named `.monotone-viz.style' . *) font "Monospace" ignored_certs "gitcommit-id" cert tag "." [ outline_color = "royalblue"; ] cert author "graydon@.*" [ color = "lightyellow"; ] cert author "njs@pobox.com" [ color = "palegreen"; ] monotone-viz-1.0.2.orig/README0000644000000000000000000000373010745166561012701 0ustar Monotone-viz ============ This is a small GNOME application to visualize monotone ancestry graphs. Monotone-viz is licensed under the GPL (General Public License), either version 2, or (at your option) any later version. REQUIREMENTS ============ - dot from the graphviz package http://www.research.att.com/sw/tools/graphviz/ - GTK+ >= 2.6, libgnomecanvas COMPILING ========= - compile/install ocaml - if you've pulled this from the monotone repository: compile/install LablGTK run `aclocal -I . && autoconf' to generate configure - run ./configure, with the following options if needed: --with-lablgtk-dir= --without-local-lablgtk --bindir - make - make install see INSTALL for an in-depth description of this procedure. RUNNING ======= usage: monotone-viz [options] [db [branch]] options: -noaa don't use an anti-aliased canvas --version print version number and exit 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 `.mononote-viz.style', in the home directory. grammar: "font" "cert" cert_name "[" ( attribute "=" ";" )+ "]" "autocolor" "layout" comments are delimited by "(*" and "*)" When displaying a node, if the node has a cert named 'cert_name' whose value matches 'regexp', then the specified attributes are used when displaying the node. example: font "Monospace 10" cert author "graydon@.*" [ color = "lightyellow"; ] the supported attributes are: color : background color for the node (a color name or a triplet "#rrggbb") outline_color : color of the node outline width_pixels : width of the outline text_color : color of the node's label -- Olivier Andrieu http://oandrieu.nerim.net/monotone-viz/ monotone-viz-1.0.2.orig/INSTALL0000644000000000000000000000265310732462562013051 0ustar Compiling monotone-viz from sources =================================== * OCaml Monotone-viz is written in Objective caml, so you'll need the ocaml compilers [1]. They are binaries available, from the ocaml homepage or from other vendors (e.g. Linux distributions). It is also easy to compile from source, something like this should work: $ ./configure -prefix /opt/caml $ make world.opt $ make install * GTK+, libgnomecanvas You'll need the development packages of GTK+ 2.6 (or newer) and libgnomecanvas. * LablGTK LablGTK is a GTK+ bindings for ocaml [2]. Tarballs distributions of monotone-viz include LablGTK so you don't have to build & install it. If you pulled monotone-viz from the monotone repository, you need a compiled LablGTK. It is packaged for some Linux distributions, but make sure you have a version more recent than 2.4.0. The latest version is lablgtk2-2.10.0. lablgtk-2.4.0 will *not* work. If you're compiling LablGTK from source, make sure LablGTK is built with libgnomecanvas support: $ ./configure --with-gnomecanvas $ make world $ make install * Monotone-viz Compiling monotone-viz should now be as simple as: $ make $ make install * Cleaning The ocaml compiler statically links everything caml-related so you can delete your ocaml installation if you wish: $ rm -Rf /opt/ocaml [1] http://caml.inria.fr/ocaml/release.en.html [2] http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html monotone-viz-1.0.2.orig/NEWS0000644000000000000000000001016011307313004012470 0ustar 1.0.2: - compile fix for recent lablgtk releases - do not crash the application with an unreadable style file 1.0.1: - fix a compilation problem on some systems - be more precise concerning the license (GPL 2+) 1.0: - do not access the monotone database directly: obtain all necessary information via the "mtn automate" mechanism - add an "About" dialog 0.15: - adapt to newer monotone versions (new name of the program, new book-keeping directory format) - do not display nodes that are simple propagates to another branch ; add an option to allow the old behaviour - make sure the keyboard navigation tries to stay on the same branch - display the number of revisions per branch in the branch selection dialog 0.14: - support new format of monotone db (using BLOBs instead of base64 encoding) /!\ these newer monotones (after 0.26pre2) use sqlite 3.3, if you're building monotone-viz with a shared sqlite lib, make sure it is compatible ! - display a nice dialog when the database is locked (e.g. during netsync) - when a revision has a tag cert, use it as label instead of the revision's id 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 - allow the ancestry graph view to be limited by date - the `query' window now uses monotone selectors - change the reconnection algorithm - cert values can be copied to the clipboard (via a context menu) - DnD support: accept drops from a file manager - rewrite the sqlite bindings (use parsed statements now) 0.11: - a new `query' window to search for revision matching some criterion - some DnD support: drag a node and drop it in a terminal to copy its revision id - tweak the reconnection algorithm - build with a shared sqlite library by default - add a preference option for the location of the `dot' program 0.10: - try to reconnect disconnected parts of the graph (by adding grey edges) - libgnomecanvas hack to speed up drawing - somehow display the output of monotone diff, even if it is not valid UTF-8 - middle clicking on the graph with a (prefix) of an id selected will center the view on this id - support builds with a shared sqlite library (--with-shared-sqlite option to configure) 0.9: - the application window has an icon ! - the layout is a bit more compact - the find box also finds tags regexps and dates - the diff window has a save button 0.8: - update to sqlite3 - fix the keyboard navigation for left-to-right layout - adapt to the new command line syntax of monotone 0.17 - add entries to the context menu of a node to copy the revision id and manifest id to the clipboard. 0.7: - add an 'everything' entry in the branch selection drop-down list - show the graph as it is rendered - add an option for left-to-right layout 0.6: - keyboard navigation: use the arrow and Backspace keys to navigate the graph - automatic coloring of nodes, based on keyid, author cert or branch cert - display parents and children nodes that are from another branch (with a dotted border) - adapt to the new syntax of the MT/options 0.5: - display the changesets of a revision - can display the diff between any two nodes in the graph - verify cert signatures - add a 'find' function to quickly locate a node 0.4: - can display truncated IDs (32 bits only) and IDs encoded in "bibble babble" (taken from polytony) - adapt for the new database schema with revisions (from the net.venge.monotone.changesets branch) - put all the head nodes at the bottom of the graph 0.3: - display edges as splines instead of straight lines (looks much better) - better adjust the sizes of labels and boxes - display manifest comment certs - other cosmetic improvements 0.2: - merge and propagate nodes are shown as a circle and without a label - add context menu for a node - display the output of monotone diff between a node and one of its ancestors - try to convert everything to/from UTF-8 - display a red rectangle around the selected node 0.1: - first public release monotone-viz-1.0.2.orig/COPYING0000644000000000000000000004313310573632162013047 0ustar GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program 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. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. monotone-viz-1.0.2.orig/version.ml.in0000644000000000000000000000006710573632162014437 0ustar let version = "@VERSION@" let revision = "@REVISION@" monotone-viz-1.0.2.orig/viz_misc.ml0000644000000000000000000001145710616155674014203 0ustar let string_is_prefix a ?(offset=0) b = let l_a = String.length a in let l_b = String.length b - offset in l_a <= l_b && a = String.sub b offset l_a let string_split ?(collapse=true) ?(max_elem=0) c s = let len = String.length s in let rec split n i = function | j when j > len -> [] | j when j = len || s.[j] = c -> if collapse && j = i then split n (j+1) (j+1) else if max_elem > 0 && n >= max_elem then [ if i = 0 then s else String.sub s i (String.length s -i) ] else (String.sub s i (j-i)) :: (split (n+1) (j+1) (j+1)) | j -> split n i (j+1) in split 1 0 0 let string_slice ?s ?e str = let len = String.length str in let start = match s with | None -> 0 | Some i when i < 0 -> i + len | Some i -> i in let stop = match e with | None -> len | Some e when e < 0 -> e + len | Some e -> e in String.sub str start (stop - start) let string_contains p = let r = Str.regexp_string_case_fold p in fun s -> try ignore (Str.search_forward r s 0) ; true with Not_found -> false let option_of_list = function | [] -> None | x :: _ -> Some x let list_uniq l = let rec uniq = function | x :: y :: tl when x = y -> x :: uniq tl | x :: tl -> x :: uniq tl | [] -> [] in uniq (List.sort compare l) let rec list_assoc_all k = function | (a, b) :: tl when a = k -> b :: list_assoc_all k tl | _ :: tl -> list_assoc_all k tl | [] -> [] let rec list_rassoc v = function | (a, b) :: _ when b = v -> a | _ :: tl -> list_rassoc v tl | [] -> raise Not_found let list_filter_map p f l = List.fold_left (fun acc e -> if p e then f e :: acc else acc) [] l let array_index a v = let rec loop i = if i >= Array.length a then raise Not_found ; if a.(i) = v then i else loop (i + 1) in loop 0 let some = function | Some v -> v | None -> invalid_arg "some" let may f = function | None -> () | Some v -> f v let maybe f = function | None -> None | Some v -> Some (f v) let default v = function | None -> v | Some x -> x let may_assoc el l = try Some (List.assoc el l) with Not_found -> None let may_cons v l = match v with | Some v -> v :: l | None -> l let bracket ~before ~action ~after arg = let resource = before arg in let result = try action resource with exn -> after resource ; raise exn in after resource ; result let with_file_in f = function | "-" -> f stdin | fname -> bracket ~before:open_in ~after:close_in ~action:f fname let with_file_out f = function | "-" -> f stdout | fname -> bracket ~before:open_out ~after:close_out ~action:f fname let input_lines ic = let lines = ref [] in begin try while true do lines := (input_line ic) :: !lines done with End_of_file -> () end ; List.rev !lines let input_channel ic = (* Buffer.add_channel sucks *) let buff = Buffer.create 1024 in begin let s = String.create 1024 in let r = ref (-1) in while !r <> 0 do r := input ic s 0 (String.length s) ; Buffer.add_substring buff s 0 !r done end ; Buffer.contents buff let get_home_dir = Viz_gmisc.get_home_dir let debug_kwd = try let v = Sys.getenv "MONOTONE_VIZ_DEBUG" in string_split ':' v with Not_found -> [] let debug kwd = List.mem kwd debug_kwd || List.mem "all" debug_kwd let log kwd fmt = Printf.kprintf (fun s -> if debug kwd then Printf.eprintf "### %s: %s\n%!" kwd s) fmt module Signal = struct type 'a t = ('a -> unit) list ref let make () = ref [] let emit s arg = List.iter (fun f -> f arg) !s let connect s f = s := f :: !s end (* not used right now ... let hex_of_char = function | '0' .. '9' as c -> Char.code c - Char.code '0' | 'a' .. 'f' as c -> 0xa + Char.code c - Char.code 'a' | 'A' .. 'F' as c -> 0xa + Char.code c - Char.code 'A' | _ -> invalid_arg "hex_of_char" let hex_dec s = let len = String.length s in if len mod 2 <> 0 then invalid_arg "hex_dec" ; let o = String.create (len / 2) in for i = 0 to len / 2 - 1 do o.[i] <- Char.chr (hex_of_char s.[2*i] lsl 4 lor hex_of_char s.[2*i+1]) done ; 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 -> try Hashtbl.find tbl k with Not_found -> let v = g k in Hashtbl.add tbl k v ; v let hashtbl_of_list l = let tbl = Hashtbl.create (List.length l) in List.iter (fun (k, v) -> Hashtbl.add tbl k v) l ; tbl monotone-viz-1.0.2.orig/viz_misc.mli0000644000000000000000000000322410616155674014345 0ustar val string_is_prefix : string -> ?offset:int -> string -> bool val string_split : ?collapse:bool -> ?max_elem:int -> char -> string -> string list val string_slice : ?s:int -> ?e:int -> string -> string (** @raise Invalid_argument if slice isn't valid *) val string_contains : string -> string -> bool val option_of_list : 'a list -> 'a option val list_uniq : 'a list -> 'a list val list_assoc_all : 'a -> ('a * 'b) list -> 'b list val list_rassoc : 'b -> ('a * 'b) list -> 'a (** @raise Not_found *) val list_filter_map : ('a -> bool) -> ('a -> 'b) -> 'a list -> 'b list val array_index : 'a array -> 'a -> int (** @raise Not_found *) val some : 'a option -> 'a val may : ('a -> unit) -> 'a option -> unit val maybe : ('a -> 'b) -> 'a option -> 'b option val default : 'a -> 'a option -> 'a val may_assoc : 'a -> ('a * 'b) list -> 'b option val may_cons : 'a option -> 'a list -> 'a list val bracket : before:('a -> 'b) -> action:('b -> 'c) -> after:('b -> unit) -> 'a -> 'c val with_file_in : (in_channel -> 'a) -> string -> 'a (** @raise Sys_error *) val with_file_out : (out_channel -> 'a) -> string -> 'a (** @raise Sys_error *) val input_lines : in_channel -> string list (** @raise Sys_error *) val input_channel : in_channel -> string (** @raise Sys_error *) val get_home_dir : unit -> string val debug : string -> bool val log : string -> ('a, unit, string, unit) format4 -> 'a module Signal : sig type 'a t val make : unit -> 'a t val emit : 'a t -> 'a -> unit val connect : 'a t -> ('a -> unit) -> unit end val hex_enc : string -> string val make_cache : ('a -> 'b) -> 'a -> 'b val hashtbl_of_list : ('a * 'b) list -> ('a, 'b) Hashtbl.t monotone-viz-1.0.2.orig/viz_types.ml0000644000000000000000000000427510573632162014406 0ustar exception Error of string let error s = raise (Error s) let errorf fmt = Printf.kprintf error fmt module StringMap = Map.Make(String) type query_domain = string list type date = string type query_limit = | QUERY_NO_LIMIT | QUERY_BETWEEN of date * date type query = { dom : query_domain ; lim : query_limit ; all_propagates : bool } type select_info = { query : query; preselect : string option; } module NodeMap = StringMap module EdgeMap = Map.Make (struct type t = string * string let compare = Pervasives.compare end) module IdSet = Set.Make(String) type sig_verif = | SIG_OK | SIG_BAD | SIG_UNKNOWN type cert = { c_id : string ; c_name : string ; c_value : string ; c_signer_id : string ; c_signature : sig_verif ; } type node_kind = | REGULAR | NEIGHBOUR_IN | NEIGHBOUR_OUT | MERGE | DISAPPROVE | TAGGED of string type relation = PARENT | CHILD type a_node = { id : string ; mutable kind : node_kind ; mutable family : (string * relation) list ; } let neighbour_kind = function | NEIGHBOUR_IN | NEIGHBOUR_OUT -> true | REGULAR | MERGE | DISAPPROVE | TAGGED _ -> false type node_data = { revision_id : string ; manifest_id : string ; revision_set : (string * Revision.change list) list ; certs : cert list ; } type edge_kind = | SAME_BRANCH | DISAPPROVED | BRANCHING | BRANCHING_NEIGH | SPANNING type agraph = { nodes : a_node NodeMap.t ; ancestry : edge_kind EdgeMap.t ; } type c_node = { n_x : float; n_y : float; n_w : float; n_h : float; c_kind : node_kind ; } type edge = { startp : float array; endp : float array; controlp : float array; edge_kind : edge_kind; } type cgraph = { bb : float * float * float * float; c_nodes : c_node NodeMap.t; c_edges : edge EdgeMap.t; } let empty_agraph = { nodes = NodeMap.empty; ancestry = EdgeMap.empty } let empty_cgraph = { bb = (0., 0., 0., 0.); c_nodes = NodeMap.empty ; c_edges = EdgeMap.empty } type direction = [ `PARENT | `CHILD | `NEXT | `PREV ] type autocolor = | NONE | BY_AUTHOR_HASH | BY_BRANCH_HASH monotone-viz-1.0.2.orig/viz_types.mli0000644000000000000000000000436210573632162014554 0ustar exception Error of string (** exception used to report error conditions, to be displayed to the user in a dialog box *) val error : string -> 'a val errorf : ('a, unit, string, 'b) format4 -> 'a module StringMap : Map.S with type key = string type query_domain = string list type date = string type query_limit = | QUERY_NO_LIMIT | QUERY_BETWEEN of date * date type query = { dom : query_domain ; lim : query_limit ; all_propagates : bool } type select_info = { query : query; preselect : string option; } module NodeMap : Map.S with type key = string module EdgeMap : Map.S with type key = string * string module IdSet : Set.S with type elt = string type sig_verif = | SIG_OK | SIG_BAD | SIG_UNKNOWN type cert = { c_id : string ; c_name : string ; c_value : string ; c_signer_id : string ; c_signature : sig_verif ; } type node_kind = | REGULAR | NEIGHBOUR_IN | NEIGHBOUR_OUT | MERGE | DISAPPROVE | TAGGED of string type relation = PARENT | CHILD type a_node = { id : string ; mutable kind : node_kind ; mutable family : (string * relation) list ; } val neighbour_kind : node_kind -> bool type node_data = { revision_id : string ; manifest_id : string ; revision_set : (string * Revision.change list) list ; certs : cert list ; } type edge_kind = | SAME_BRANCH | DISAPPROVED | BRANCHING | BRANCHING_NEIGH | SPANNING type agraph = { nodes : a_node NodeMap.t ; ancestry : edge_kind EdgeMap.t ; } type c_node = { n_x : float; n_y : float; n_w : float; n_h : float; c_kind : node_kind ; } type edge = { startp : float array; endp : float array; controlp : float array; edge_kind : edge_kind ; } type cgraph = { bb : float * float * float * float; c_nodes : c_node NodeMap.t; c_edges : edge EdgeMap.t; } (** Type with the geometrical information for the layout of the ancestry graph *) val empty_agraph : agraph (** dummy value for initialization. *) val empty_cgraph : cgraph (** dummy value for initialization. *) type direction = [ `PARENT | `CHILD | `NEXT | `PREV ] type autocolor = | NONE | BY_AUTHOR_HASH | BY_BRANCH_HASH monotone-viz-1.0.2.orig/q.ml0000644000000000000000000000115410573632162012603 0ustar type 'a t = 'a list * 'a list let norm f r = if f = [] then List.rev r, [] else f, r let empty = [], [] let pop = function | ([], r) -> assert (r = []) ; None | (x :: f, r) -> Some (x, norm f r) let push (f, r) x = norm f (x :: r) let push_list q l = match q with | ([], r) -> assert (r = []) ; (l, []) | (f, r) -> (f, List.rev_append l r) let concat (f1, r1) (f2, r2) = (List.append f1 (List.rev_append r1 f2), r2) let to_list (f, r) = List.append f (List.rev r) let of_list l = (l, []) let list_fold g l = to_list (List.fold_left g empty l) monotone-viz-1.0.2.orig/q.mli0000644000000000000000000000052610573632162012756 0ustar (** Simple functional queues *) type +'a t val empty : 'a t val push : 'a t -> 'a -> 'a t val pop : 'a t -> ('a * 'a t) option val push_list : 'a t -> 'a list -> 'a t val concat : 'a t -> 'a t -> 'a t val to_list : 'a t -> 'a list val of_list : 'a list -> 'a t val list_fold : ('a t -> 'b -> 'a t) -> 'b list -> 'a list monotone-viz-1.0.2.orig/autocolor.ml0000644000000000000000000000326410573632162014356 0ustar open Viz_types (* HLS to RGB conversion, taken from CSS3 spec *) let hue_to_rgb m1 m2 h = let h = if h < 0. then h +. 1. else if h > 1. then h -. 1. else h in if h *. 6. < 1. then m1 +. (m2 -. m1) *. h *. 6. else if h *. 2. < 1. then m2 else if h *. 3. < 2. then m1 +. (m2 -. m1) *. (2. /. 3. -. h) *. 6. else m1 let hls_to_rgb hue li sat = let m2 = if li <= 0.5 then li *. (sat +. 1.) else li +. sat -. li *. sat in let m1 = li *. 2. -. m2 in let r = hue_to_rgb m1 m2 (hue +. 1./.3.) in let g = hue_to_rgb m1 m2 hue in let b = hue_to_rgb m1 m2 (hue -. 1./.3.) in let to_int v = int_of_float (v *. 256.) in (to_int r, to_int g, to_int b) let rgba_color (r, g, b) = Int32.logor (Int32.shift_left (Int32.of_int (r lsl 16 + g lsl 8 + b)) 8) 0xffl let autocolor_hash s = let hash = Digest.string s in let f_of_hash p = float (Char.code hash.[p]) /. 256. in (* take 8 bits for hue *) let hue = f_of_hash 0 in (* take 8 bits for lightness and map to [75% .. 90%] *) let li = f_of_hash 1 *. 0.15 +. 0.75 in (* take 8 bits for saturation and map to [50% .. 80%]*) let sat = f_of_hash 2 *. 0.3 +. 0.5 in let (r, g, b) as triplet = hls_to_rgb hue li sat in if Viz_misc.debug "color" then Printf.eprintf "autocolor (%30s) = H=%.2f L=%.2f S=%.2f R=%3d G=%3d B=%3d\n%!" s hue li sat r g b ; rgba_color triplet let white = 0xffffffffl let autocolor kind = let lookup_autocolor = Viz_misc.make_cache begin match kind with | NONE -> (fun id -> white) | BY_AUTHOR_HASH -> autocolor_hash | BY_BRANCH_HASH -> autocolor_hash end in function | c :: _ -> lookup_autocolor c | [] -> white monotone-viz-1.0.2.orig/autocolor.mli0000644000000000000000000000010010573632162014511 0ustar val autocolor : Viz_types.autocolor -> (string list -> int32) monotone-viz-1.0.2.orig/viz_style.ml0000644000000000000000000002316411307307740014375 0ustar open Viz_misc open Viz_types (* "Generic" preferences *) type item = [ `BOOL of bool | `FLOAT of float | `INT of int | `STRING of string ] type generic_prefs = (string * item) list let print_item () = function | `BOOL b -> string_of_bool b | `FLOAT f -> string_of_float f | `INT i -> string_of_int i | `STRING s -> Printf.sprintf "%S" s let bool_of_item = function | `BOOL b -> b | `INT i -> i <> 0 | `STRING "yes" | `STRING "true" -> true | `STRING "no" | `STRING "false" -> false | _ -> failwith "bool_of_item" let int_of_item = function | `INT i -> i | `FLOAT f -> int_of_float f | _ -> failwith "int_of_item" let string_of_item = function | `STRING s -> s | _ -> failwith "string_of_item" let string_list_of_item = function | `STRING s -> Str.split (Str.regexp ", *") s | _ -> failwith "string_list_of_item" let autocolor_of_item = function | `STRING "none" | `BOOL false -> NONE | `STRING "author" -> BY_AUTHOR_HASH | `STRING "branch" -> BY_BRANCH_HASH | _ -> failwith "autocolor_of_item" let string_of_autocolor = function | NONE -> "none" | BY_AUTHOR_HASH -> "author" | BY_BRANCH_HASH -> "branch" let item_of_autocolor ac = `STRING (string_of_autocolor ac) type 'a key = string * (item -> 'a) let bool_key s = (s, bool_of_item) let string_key s = (s, string_of_item) let string_list_key s = (s, string_list_of_item) let autocolor_key s = (s, autocolor_of_item) let add_pref l (k, v) = (k, v) :: (if List.mem_assoc k l then List.remove_assoc k l else l) let lookup p (k, conv) = try Some (conv (List.assoc k p)) with Failure _ | Not_found -> None (* Styles *) type cert_style = string * Str.regexp * string * generic_prefs type style = cert_style list type prefs = { font : string ; autocolor : autocolor ; lr_layout : bool ; monotone_path : string ; dot_path : string ; ignored_certs : string list ; style : style ; } type shape_props = [ `FILL_COLOR of string | `OUTLINE_COLOR of string | `WIDTH_PIXELS of int] type text_props = [ `FILL_COLOR of string | `FONT of string | `WEIGHT of int] let match_style { autocolor = autocolor_pref ; style = style } g mtn = let autocolor = Autocolor.autocolor autocolor_pref in fun id (default_rect_props, default_txt_props) -> let get_cert = Monotone.cert_value mtn id in let matching_attrs = List.fold_left (fun acc (cert_name, value_re, _, attr) -> List.fold_left (fun acc c_value -> if Str.string_match value_re c_value 0 then List.fold_left add_pref acc attr else acc) acc (get_cert cert_name)) [] style in let build_props dflt keys = List.fold_left (fun acc key -> Viz_misc.may_cons (lookup matching_attrs key) acc) dflt keys in let rect_props : shape_props list = build_props default_rect_props [ ("color", fun i -> `FILL_COLOR (string_of_item i)) ; ("outline_color", fun i -> `OUTLINE_COLOR (string_of_item i)) ; ("width_pixels", fun i -> `WIDTH_PIXELS (int_of_item i)) ; ] in let text_props : text_props list = build_props default_txt_props [ ("text_color", fun i -> `FILL_COLOR (string_of_item i)) ; ("font", fun i -> `FONT (string_of_item i)) ; ("weight", fun i -> `WEIGHT (int_of_item i)) ; ] in let cleanup_rect_props = fst (List.fold_left (fun ((props, seen_props) as acc) -> function | `FILL_COLOR _ when List.mem `FILL_COLOR seen_props -> acc | `FILL_COLOR _ as i -> (i :: props, `FILL_COLOR :: seen_props) | `OUTLINE_COLOR _ when List.mem `OUTLINE_COLOR seen_props -> acc | `OUTLINE_COLOR _ as i -> (i :: props, `OUTLINE_COLOR :: seen_props) | `WIDTH_PIXELS _ when List.mem `WIDTH_PIXELS seen_props -> acc | `WIDTH_PIXELS _ as i -> (i :: props, `WIDTH_PIXELS :: seen_props)) ([], []) rect_props) in let cleanup_text_props = fst (List.fold_left (fun ((props, seen_props) as acc) -> function | `FILL_COLOR _ when List.mem `FILL_COLOR seen_props -> acc | `FILL_COLOR _ as i -> (i :: props, `FILL_COLOR :: seen_props) | `FONT _ when List.mem `FONT seen_props -> acc | `FONT _ as i -> (i :: props, `FONT :: seen_props) | `WEIGHT _ when List.mem `WEIGHT seen_props -> acc | `WEIGHT _ as i -> (i :: props, `WEIGHT :: seen_props)) ([], []) text_props) in let rect_props = if List.exists (function `FILL_COLOR _ -> true | _ -> false) cleanup_rect_props then cleanup_rect_props else begin let autocolor_key = match autocolor_pref with | BY_AUTHOR_HASH -> get_cert "author" | BY_BRANCH_HASH -> get_cert "branch" | NONE -> [] in `FILL_COLOR_RGBA (autocolor autocolor_key) :: cleanup_rect_props end in (rect_props, cleanup_text_props) (* Parsing *) type token = Genlex.token = | Kwd of string | Ident of string | Int of int | Float of float | String of string | Char of char let lex = Genlex.make_lexer [ "[" ; "="; ";"; "]" ] let rec parse_list ?(q=Q.empty) p = parser | [< e = p ; nxt >] -> parse_list ~q:(Q.push q e) p nxt | [<>] -> Q.to_list q let rec parse_list_sep sep ?(q=Q.empty) p = parser | [< e = p ; nxt >] -> opt_sep sep (Q.push q e) p nxt | [<>] -> Q.to_list q and opt_sep sep q p = parser | [< ' Kwd s when s = sep ; nxt >] -> parse_list_sep sep ~q p nxt | [<>] -> Q.to_list q type entry = | Cert_style of cert_style | Pref of (string * item) let rec parse strm = parse_list style_or_pref strm and style_or_pref = parser | [< ' Ident "cert" ; ' Ident cert_name ; ' String cert_value_re ; attr = attr_list >] -> Cert_style (cert_name, Str.regexp cert_value_re, cert_value_re, attr) | [< ' Ident key ; v = value >] -> Pref (key, v) and attr_list = parser | [< ' Kwd "["; l = parse_list_sep ";" attr ; ' Kwd "]" >] -> l and attr = parser | [< ' Ident key; ' Kwd "="; v = value >] -> (key, v) and value = parser | [< ' Ident "true" >] -> `BOOL true | [< ' Ident "yes" >] -> `BOOL true | [< ' Ident "false" >] -> `BOOL false | [< ' Ident "no" >] -> `BOOL false | [< ' Ident i >] -> `STRING i | [< ' Int i >] -> `INT i | [< ' Float f >] -> `FLOAT f | [< ' String s >] -> `STRING s let parse_file filename = if not (Sys.file_exists filename ) then [] else Viz_misc.with_file_in (fun ic -> parse (lex (Stream.of_channel ic))) filename let parse_merge_items (prefs, style) filename = let parsed_data = try parse_file filename with | Sys_error msg -> Viz_types.errorf "Error while accessing the style file '%s':\n%s" filename msg | Stream.Failure | Stream.Error _ -> Viz_types.errorf "Syntax error in the style file '%s'" filename in let (prefs, style_entries) = List.fold_left (fun (prefs, style) -> function | Cert_style c -> (prefs, Q.push style c) | Pref k -> (add_pref prefs k, style)) (prefs, Q.empty) parsed_data in (prefs, style @ (Q.to_list style_entries)) (* Conversion *) let defaults = { font = "Monospace 8" ; autocolor = BY_AUTHOR_HASH ; lr_layout = false ; monotone_path = "mtn" ; dot_path = "dot" ; ignored_certs = [] ; style = [] ; } let prefs_of_items (i, style) = let get mk n = some (lookup i (mk n)) in { font = get string_key "font" ; autocolor = get autocolor_key "autocolor" ; lr_layout = get bool_key "lr_layout" ; monotone_path = get string_key "monotone" ; dot_path = get string_key "dot" ; ignored_certs = get string_list_key "ignored_certs" ; style = style ; } let items_of_prefs p = [ "font", `STRING p.font ; "autocolor", item_of_autocolor p.autocolor ; "lr_layout", `BOOL p.lr_layout ; "monotone", `STRING p.monotone_path ; "dot", `STRING p.dot_path ; "ignored_certs", `STRING (String.concat "," p.ignored_certs) ; ], p.style let style_file_name = Filename.concat (get_home_dir ()) ".monotone-viz.style" let parse_merge p filename = prefs_of_items (parse_merge_items (items_of_prefs p) filename) let load () = try parse_merge defaults style_file_name with _ -> prerr_endline "Couldn't parse .monotone-viz.style file." ; defaults let separator = "-*- monotone-viz -*-" let save_prefs b prefs = Printf.bprintf b "autocolor %s\n" (string_of_autocolor prefs.autocolor) ; Printf.bprintf b "lr_layout %B\n" prefs.lr_layout ; Printf.bprintf b "monotone %S\n" prefs.monotone_path ; Printf.bprintf b "dot %S\n" prefs.dot_path let save prefs = let lines = if Sys.file_exists style_file_name then with_file_in input_lines style_file_name else [] in let keep_lines = let re = Str.regexp (" *(\\* *" ^ (Str.quote separator) ^ " *\\*)") in let rec keep = function | l :: tl when Str.string_match re l 0 -> [] | l :: tl -> l :: keep tl | [] -> [] in keep lines in let keep_styles = List.fold_right (fun i acc -> match i with | Cert_style s -> s :: acc | Pref _ -> acc) (parse (lex (Stream.of_string (String.concat "\n" keep_lines)))) [] in let b = Buffer.create 4096 in save_prefs b prefs ; List.iter (function | s when List.mem s keep_styles -> () | (cert_name, _, re, attrs) -> Printf.bprintf b "cert %s %S [%s]\n" cert_name re (String.concat "; " (List.map (fun (k, v) -> Printf.sprintf "%s = %a" k print_item v) attrs))) prefs.style ; with_file_out (fun oc -> let ol l = output_string oc l ; output_char oc '\n' in List.iter ol keep_lines ; Printf.fprintf oc "(* %s *)\n\n" separator ; Buffer.output_buffer oc b) style_file_name monotone-viz-1.0.2.orig/viz_style.mli0000644000000000000000000000136410573632162014547 0ustar open Viz_types type style (* a style defines some attributes for nodes based on certs values *) type prefs = { font : string ; autocolor : autocolor ; lr_layout : bool ; monotone_path : string ; dot_path : string ; ignored_certs : string list ; style : style ; } val load : unit -> prefs val save : prefs -> unit type shape_props = [ `FILL_COLOR of string | `OUTLINE_COLOR of string | `WIDTH_PIXELS of int] type text_props = [ `FILL_COLOR of string | `FONT of string | `WEIGHT of int] val match_style : prefs -> Agraph.t -> Monotone.t -> string -> shape_props list * text_props list -> [> shape_props | `FILL_COLOR_RGBA of int32] list * [> text_props] list monotone-viz-1.0.2.orig/dot_types.mli0000644000000000000000000000144710573632162014533 0ustar type graph = { strict : bool ; kind : [`GRAPH | `DIGRAPH] ; id : string option ; stmt : statement list ; } and statement = [ | `NODE of string * port option * attr list | `SUBGRAPH of string option * statement list | `ATTR_GRAPH of attr list | `ATTR_NODE of attr list | `ATTR_EDGE of attr list | `ID_EQUAL of string * string | `EDGE of (subgraph_or_node * edegeop * attr list) ] and subgraph_or_node = [ `SUBGRAPH of string option * statement list | `NODEID of (string * port option) ] and port = ([`NO_LOCATION | `LOCATION of [`ONE_ID of string | `TWO_ID of string * string ]] * [`NO_ANGLE | `ANGLE of string]) and attr = string * string and edegeop = ([`DIRECTED | `UNDIRECTED] * subgraph_or_node) list monotone-viz-1.0.2.orig/dot_lexer.mll0000644000000000000000000000351710573632162014511 0ustar { open Dot_types open Dot_parser let kwd = Hashtbl.create 37 let _ = List.iter (fun (k, tok) -> Hashtbl.add kwd k tok) [ "strict", STRICT; "graph", GRAPH; "digraph", DIGRAPH; "node", NODE; "edge", EDGE; "subgraph", SUBGRAPH; ] } let ws = [' ' '\t' '\n' '\r'] let alpha = ['A'-'Z' 'a'-'z'] let digit = ['0'-'9'] let ident = (alpha | '_') (alpha | '_' | digit)* let number = digit+ rule lex = parse | ws+ { lex lexbuf } | '#' [^ '\n']* '\n' { lex lexbuf } | "//" [^ '\n']* '\n' { lex lexbuf } | "/*" { comment lexbuf ; lex lexbuf } | "{" { LBRACE } | "}" { RBRACE } | "(" { LPAREN } | ")" { RPAREN } | "[" { LBRACKET } | "]" { RBRACKET } | "," { COMMA } | ";" { SEMICOLON } | "=" { EQUAL } | "@" { AT } | ":" { COLON } | "+" { PLUS } | "->" { DIR_EDGEOP } | "--" { UNDIR_EDGEOP } | ident { let lexeme = (Lexing.lexeme lexbuf) in try Hashtbl.find kwd lexeme with Not_found -> IDENT lexeme } | digit { NUMBER (Lexing.lexeme lexbuf) } | '"' { let b = Buffer.create 128 in string b lexbuf ; STRING (Buffer.contents b) } and string b = parse | '"' { () } | '\\' '\r'? '\n' { string b lexbuf } | "\\\"" { Buffer.add_char b '"' ; string b lexbuf } | _ { Buffer.add_char b (Lexing.lexeme_char lexbuf 0) ; string b lexbuf } and comment = parse | "*/" { () } | _ { comment lexbuf } monotone-viz-1.0.2.orig/dot_parser.mly0000644000000000000000000000677210573632162014711 0ustar %{ open Dot_types %} %token STRICT %token GRAPH %token DIGRAPH %token NODE %token EDGE %token SUBGRAPH %token LBRACE %token RBRACE %token LPAREN %token RPAREN %token LBRACKET %token RBRACKET %token COMMA %token SEMICOLON %token EQUAL %token AT %token COLON %token PLUS %token DIR_EDGEOP %token UNDIR_EDGEOP %token IDENT %token STRING %token NUMBER %nonassoc below_LBRACE %nonassoc LBRACE %start graph %type graph %% graph: strict_flag graph_kind opt_id LBRACE stmt_list RBRACE { { strict = $1 ; kind = $2 ; id = $3 ; stmt = Q.to_list $5 } } ; strict_flag: /* empty */ { false } | STRICT { true } ; graph_kind: GRAPH { `GRAPH } | DIGRAPH { `DIGRAPH } ; opt_id: /* empty */ { None } | id { Some $1 } ; stmt_list: stmt_semi { Q.push Q.empty $1 } | stmt_list stmt_semi { Q.push $1 $2 } ; stmt_semi: stmt { $1 } | stmt SEMICOLON { $1 } ; stmt: node_stmt { `NODE $1 } | edge_stmt { `EDGE $1 } | attr_stmt { $1 } | id_equal { `ID_EQUAL $1 } | subgraph { `SUBGRAPH $1 } ; id_equal: id EQUAL id { ($1, $3) } ; node_stmt: node_id opt_attr_list { let (id, port) = $1 in (id, port, Q.to_list $2) } ; node_id: id opt_port { ($1, $2) } ; opt_port: /* empty */ { None } | port { Some $1 } ; port: port_location { (`LOCATION $1, `NO_ANGLE) } | port_location port_angle { (`LOCATION $1, `ANGLE $2) } | port_angle port_location { (`LOCATION $2, `ANGLE $1) } | port_angle { (`NO_LOCATION, `ANGLE $1) } ; port_location: COLON id { `ONE_ID $2 } | COLON LPAREN id COMMA id RPAREN { `TWO_ID ($3, $5) } ; port_angle: AT id { $2 } ; subgraph: | SUBGRAPH id LBRACE stmt_list RBRACE { (Some $2, Q.to_list $4) } | SUBGRAPH LBRACE stmt_list RBRACE { (None, Q.to_list $3) } | LBRACE stmt_list RBRACE { (None, Q.to_list $2) } | SUBGRAPH id %prec below_LBRACE { (Some $2, []) } ; opt_attr_list: /* empty */ { Q.empty } | attr_list { $1 } ; attr_list: | LBRACKET a_list RBRACKET { $2 } | attr_list LBRACKET a_list RBRACKET { Q.concat $1 $3 } ; a_list: a_list_item { Q.push Q.empty $1 } | a_list a_list_item { Q.push $1 $2 } ; a_list_item: id EQUAL id COMMA { ($1, $3) } | id EQUAL id { ($1, $3) } | id COMMA { ($1, "true") } | id { ($1, "true") } ; attr_stmt: GRAPH attr_list { `ATTR_GRAPH (Q.to_list $2) } | NODE attr_list { `ATTR_NODE (Q.to_list $2) } | EDGE attr_list { `ATTR_EDGE (Q.to_list $2) } ; node_or_subgraph: node_id { `NODEID $1 } | subgraph { `SUBGRAPH $1 } ; edge_stmt: node_or_subgraph edgeRHS_list opt_attr_list { ($1, Q.to_list $2, Q.to_list $3) } ; edgeRHS_list: edgeRHS { Q.push Q.empty $1 } | edgeRHS_list edgeRHS { Q.push $1 $2 } ; edgeRHS: DIR_EDGEOP node_or_subgraph { (`DIRECTED, $2) } | UNDIR_EDGEOP node_or_subgraph { (`UNDIRECTED, $2) } ; id: IDENT { $1 } | string { String.concat "" (Q.to_list $1) } | NUMBER { $1 } ; string: STRING { Q.push Q.empty $1 } | string PLUS STRING { Q.push $1 $3 } ; monotone-viz-1.0.2.orig/subprocess.ml0000644000000000000000000001344610573632162014542 0ustar open Viz_misc let init = Giochannel.init ; Gspawn.init let debug fmt = Printf.kprintf (if Viz_misc.debug "spawn" then (fun s -> Printf.eprintf "### spawn: %s\n%!" s) else ignore) fmt type encoding = [ `NONE | `LOCALE | `CHARSET of string ] let setup_channel ~nonblock encoding fd = let chan = Giochannel.new_fd (some fd) in if nonblock then Giochannel.set_flags_noerr chan [`NONBLOCK] ; begin match encoding with | `NONE -> Giochannel.set_encoding chan None ; Giochannel.set_buffered chan false | `LOCALE -> let (is_utf8, charset) = Glib.Convert.get_charset () in if not is_utf8 then Giochannel.set_encoding chan (Some charset) | `CHARSET charset -> Giochannel.set_encoding chan (Some charset) end ; chan let all_done_cb ~nb cb = let count = ref nb in fun () -> decr count ; if !count = 0 then cb () type watch = { mutable finished : bool ; name : string ; chan : Giochannel.t ; exn_cb : exn -> unit ; done_cb : unit -> unit ; } let stop_watch w = w.finished <- true ; debug "%s cb: closing pipe" w.name ; try Giochannel.shutdown w.chan true with Giochannel.Error (_, msg) | Glib.Convert.Error (_, msg) -> debug "%s cb: error closing pipe %s" w.name msg let reset_watch w continue = if not continue then begin stop_watch w ; w.done_cb () end ; continue let in_channel_watch w input = let input_pos = ref 0 in let callback conditions = debug "stdin cb: %d left in buffer" (String.length input - !input_pos) ; let to_write = String.length input - !input_pos in let do_write = ref (to_write > 0 && List.mem `OUT conditions) in if !do_write then begin let bytes_written = ref 0 in try match Giochannel.write_chars w.chan ~bytes_written ~off:!input_pos input with | `NORMAL written -> debug "stdin cb: wrote %d" written ; input_pos := !input_pos + written | `AGAIN -> debug "stdin cb: EAGAIN ?" with | Giochannel.Error (_, msg) | Glib.Convert.Error (_, msg) as exn -> w.exn_cb exn ; debug "stdin cb: error %s, wrote %d" msg !bytes_written ; do_write := false end ; reset_watch w !do_write in Giochannel.add_watch w.chan [ `OUT ; `HUP ; `ERR ] callback let out_channel_watch w b = let sb = String.create 4096 in let callback conditions = let need_to_read = ref (List.mem `IN conditions) in if !need_to_read then begin try match Giochannel.read_chars w.chan sb with | `NORMAL read -> debug "%s cb: read %d" w.name read ; Buffer.add_substring b sb 0 read | `EOF -> debug "%s cb: eof" w.name ; need_to_read := false | `AGAIN -> debug "%s cb: AGAIN" w.name with | Giochannel.Error (_, msg) | Glib.Convert.Error (_, msg) as exn -> w.exn_cb exn ; debug "%s cb: error %s" w.name msg ; need_to_read := false end ; reset_watch w !need_to_read in Giochannel.add_watch w.chan [ `IN ; `HUP ; `ERR ] callback let pid_watch pid callback = let callback status = debug "child %d exiting, status %d" (Gspawn.int_of_pid pid) status ; callback status ; () in Gspawn.add_child_watch pid callback type t = { mutable watches : (watch * Giochannel.source_id) list ; mutable aborted : bool ; mutable status : int ; } let spawn ~encoding ~cmd ~input:input_opt ~reap_callback done_callback = if Viz_misc.debug "exec" then Printf.eprintf "### exec: Running '%s'\n%!" (String.concat " " cmd) ; let has_input = input_opt <> None in let spawn_flags = [ `PIPE_STDOUT ; `PIPE_STDERR ; `SEARCH_PATH ; `DO_NOT_REAP_CHILD ] in let child_info = Gspawn.async_with_pipes (if has_input then `PIPE_STDIN :: spawn_flags else spawn_flags) cmd in let state = { watches = [] ; aborted = false ; status = -1 } in let out_buffer = Buffer.create 4096 in let err_buffer = Buffer.create 1024 in let exn_list = ref [] in let all_done = all_done_cb ~nb:(if has_input then 4 else 3) (fun () -> if not state.aborted then done_callback ~exceptions:!exn_list ~stdout:(Buffer.contents out_buffer) ~stderr:(Buffer.contents err_buffer) state.status) in let exn_cb exn = exn_list := exn :: !exn_list in let add_watch w id = state.watches <- (w, id) :: state.watches in if has_input then begin let ic = setup_channel ~nonblock:true encoding child_info.Gspawn.standard_input in let in_watch = { name = "stdin" ; finished = false ; chan = ic ; exn_cb = exn_cb ; done_cb = all_done } in let in_id = in_channel_watch in_watch (some input_opt) in add_watch in_watch in_id end ; begin let oc = setup_channel ~nonblock:false encoding child_info.Gspawn.standard_output in let out_watch = { name = "stdout" ; finished = false ; chan = oc ; exn_cb = exn_cb ; done_cb = all_done } in let out_id = out_channel_watch out_watch out_buffer in add_watch out_watch out_id end ; begin let ec = setup_channel ~nonblock:false encoding child_info.Gspawn.standard_error in let err_watch = { name = "stderr" ; finished = false ; chan = ec ; exn_cb = exn_cb ; done_cb = all_done } in let err_id = out_channel_watch err_watch err_buffer in add_watch err_watch err_id end ; let pid = some child_info.Gspawn.pid in ignore (pid_watch pid (fun s -> state.status <- s ; begin try reap_callback () with _ -> () end ; Gspawn.close_pid pid ; all_done ())) ; state type callback = exceptions:exn list -> stdout:string -> stderr:string -> int -> unit let abort sub_data = if not sub_data.aborted then begin sub_data.aborted <- true ; List.iter (fun (w, id) -> if not w.finished then begin Giochannel.remove_watch id ; stop_watch w end) sub_data.watches end monotone-viz-1.0.2.orig/subprocess.mli0000644000000000000000000000047710573632162014713 0ustar type encoding = [ `CHARSET of string | `LOCALE | `NONE ] type t type callback = exceptions:exn list -> stdout:string -> stderr:string -> int -> unit val spawn : encoding:encoding -> cmd:string list -> input:string option -> reap_callback:(unit -> unit) -> callback -> t val abort : t -> unit monotone-viz-1.0.2.orig/icon.ml0000644000000000000000000000241010573632162013267 0ustar (* XPM *) let monotone_xpm = [| "25 32 17 1"; " c None"; ". c #040606"; "+ c #443E50"; "@ c #5F5269"; "# c #695E7B"; "$ c #8D7EA4"; "% c #9C7F9D"; "& c #A48AAD"; "* c #9F8EB5"; "= c #9D91B0"; "- c #9E92BE"; "; c #B78EAB"; "> c #AB98B2"; ", c #C890A5"; "' c #DE9DB0"; ") c #EEA2B6"; "! c #EAA5B6"; " "; " ,!' "; " !' !)), "; " ,)!, $-- ,)))! "; " )))),%---------- !)))) "; " )))!!,*---------*;!)))) "; " ,)!!!'*---------*,!!))! "; " !!!!'*----------&!!!)! "; " ;!!!,*-----------;!!)' "; " -*'!!;------------*;!!, "; " --&'!&--------------;' "; " ---&,---------------*& "; " ----*------------------ "; " ----------------------- "; " ---------------------- "; " ---------------------* "; " =-------------------- "; " *---$#--------*+#--- "; " *--+.$-------#.+--- "; " *--+.@-------+.@--- "; " *-*+#-------$$--- "; " >---------------- "; " =--------------$ "; " =------------* "; " >-*%-----*$-* "; " =-%&---*%-- "; " >-*;&;;;&-- "; " *-;'!!'*- "; " =-;!!!'*- "; " =;!!!'** "; " %''';= "; " " |] let monotone = lazy (GdkPixbuf.from_xpm_data monotone_xpm) monotone-viz-1.0.2.orig/ui.ml0000644000000000000000000004530110732463032012755 0ustar open Viz_misc open Viz_types let valid_utf8 = Glib.Utf8.validate let wrap_in_scroll_window packing = let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing () in sw#add let error_notice ~parent message = let d = GWindow.message_dialog ~message ~message_type:`ERROR ~buttons:GWindow.Buttons.close ~parent ~destroy_with_parent:true ~show:true () in ignore (d#connect#after#close d#destroy) ; ignore (d#connect#response (fun _ -> d#destroy ())) let error_notice_f ~parent fmt = Printf.kprintf (error_notice ~parent) fmt let with_grab f = let w = Viz_gmisc.invisible_new () in GtkMain.Grab.add w ; try let r = f () in GtkMain.Grab.remove w ; GtkBase.Object.destroy w ; r with exn -> GtkMain.Grab.remove w ; GtkBase.Object.destroy w ; raise exn let pump () = while Glib.Main.iteration false do () done let fold_in_loop ?(granularity=10) f init l = with_grab (fun () -> let i = ref 0 in List.fold_left (fun acc e -> incr i ; if !i mod granularity = 0 then pump () ; f acc e) init l) let add_label ~text ~packing = ignore (GMisc.label ~text ~packing ()) module Busy = struct let busy_cursor = lazy (Gdk.Cursor.create `WATCH) let normal_cursor = lazy (Gdk.Cursor.create `LEFT_PTR) let set_busy_cursor w busy = Gdk.Window.set_cursor w#misc#window (Lazy.force (if busy then busy_cursor else normal_cursor)) type t = { widget : GObj.widget ; mutable depth : int ; mutable timer_id : Glib.Timeout.id option ; } let make w = { widget = w#coerce ; depth = 0 ; timer_id = None } let start b = b.depth <- b.depth + 1 ; match b.timer_id with | None when b.depth = 1 -> let id = Glib.Timeout.add 500 (fun () -> b.timer_id <- None ; set_busy_cursor b.widget true ; false) in b.timer_id <- Some id | _ -> () let stop b = match b.timer_id with | None when b.depth = 1 -> set_busy_cursor b.widget false ; b.depth <- 0 | Some id when b.depth = 1 -> Glib.Timeout.remove id ; b.timer_id <- None ; b.depth <- 0 | _ when b.depth > 1 -> b.depth <- b.depth - 1 | _ -> () end let category title packing = let vb = GPack.vbox ~packing () in let _ = GMisc.label ~markup:(Printf.sprintf "%s" (Glib.Markup.escape_text title)) ~xalign:0. ~packing:(vb#pack ~expand:false) () in let al = GBin.alignment ~border_width:8 ~packing:(vb#pack ~expand:true) () in al#misc#set_property "left-padding" (`INT 16) ; (GPack.vbox ~packing:al#add ())#pack let make_factory () = let set = GtkStock.Icon_factory.lookup_default "gtk-execute" in let add id label = GtkStock.Item.add { GtkStock.stock_id = id ; label = label ; modifier = [] ; keyval = 0 } ; ignore (GtkStock.make_icon_factory ~icons:[ `STOCK id, set ] ()) in add "mviz-query" "_Query" ; add "mviz-view" "_View" let _ = make_factory () class status_bar ~packing = let status = GMisc.statusbar ~packing () in let progress = GRange.progress_bar () in let _ = (* work around some limitations in the GtkStatusBar mapping *) let status_w = status#as_widget in let b = GtkPack.Box.cast status_w in GtkPack.Box.pack_end b progress#as_widget false false 0 ; Gobject.Property.set_dyn status_w "has-resize-grip" (`BOOL false) in fun description -> object (self) val ctx = status#new_context description method push msg = ignore (ctx#push msg) method pop = ctx#pop val mutable total = 0. val mutable count = 0 val mutable last_fraction = 0. method progress_start msg tot = progress#set_fraction 0. ; total <- float tot ; count <- 0 ; last_fraction <- 0. ; ignore (ctx#push msg) method progress nb = count <- count + nb ; let f = float count /. total in if f -. last_fraction >= 0.02 then begin last_fraction <- f ; progress#set_fraction f end method progress_end () = progress#set_fraction 0. ; ctx#pop () method with_status : 'a. string -> (unit -> 'a) -> 'a = fun msg f -> self#push msg ; try let res = f () in self#pop () ; res with exn -> self#pop () ; raise exn end module Prefs = struct let make ctrl = let prefs = ref ctrl#get_prefs in let w = GWindow.dialog ~title:"Monotone-viz Preferences" ~parent:ctrl#get_toplevel ~destroy_with_parent:true ~allow_grow:false ~border_width:8 () in begin let packing = category "Ancestry Graph Layout" w#vbox#pack in let button = GButton.check_button ~label:"left-to-right _layout" ~use_mnemonic:true ~active:!prefs.Viz_style.lr_layout ~packing () in ignore (button#connect#toggled (fun () -> prefs := { !prefs with Viz_style.lr_layout = not !prefs.Viz_style.lr_layout })) end ; begin let packing = category "Autocolouring" w#vbox#pack in ignore (List.fold_left (fun group (label, autocolor_style) -> let b = GButton.radio_button ?group ~label ~active:(!prefs.Viz_style.autocolor = autocolor_style) ~packing () in ignore (b#connect#toggled (fun () -> if b#active then prefs := { !prefs with Viz_style.autocolor = autocolor_style })) ; if group = None then Some b#group else group) None [ "no automatic coloring", NONE ; "color by author", BY_AUTHOR_HASH ; "color by branch", BY_BRANCH_HASH ] ) end ; begin let packing = category "External Programs" w#vbox#pack in let tb = GPack.table ~columns:2 ~rows:2 ~packing () in begin let _ = GMisc.label ~text:"monotone: " ~xalign:1. ~packing:(tb#attach ~left:1 ~top:1) () in let e = GEdit.entry ~text:(!prefs.Viz_style.monotone_path) ~packing:(tb#attach ~left:2 ~top:1 ~expand:`X) () in ignore (e#connect#changed (fun () -> prefs := { !prefs with Viz_style.monotone_path = e#text })) end ; begin let _ = GMisc.label ~text:"dot: " ~xalign:1. ~packing:(tb#attach ~left:1 ~top:2) () in let e = GEdit.entry ~text:(!prefs.Viz_style.dot_path) ~packing:(tb#attach ~left:2 ~top:2 ~expand:`X) () in ignore (e#connect#changed (fun () -> prefs := { !prefs with Viz_style.dot_path = e#text })) end ; end ; w#add_button_stock `CLOSE `CLOSE ; w#add_button_stock `SAVE `SAVE ; w#add_button_stock `APPLY `APPLY ; ignore (w#connect#after#close w#misc#hide) ; ignore (w#event#connect#delete (fun _ -> w#misc#hide () ; true)) ; ignore (w#connect#response (function | `APPLY -> ctrl#set_prefs !prefs | `SAVE -> Viz_style.save !prefs | `CLOSE | `DELETE_EVENT -> w#misc#hide ())) ; w let update_prefs ctrl old_prefs p = let need_layout = old_prefs.Viz_style.font <> p.Viz_style.font || old_prefs.Viz_style.lr_layout <> p.Viz_style.lr_layout in let need_redraw = old_prefs.Viz_style.autocolor <> p.Viz_style.autocolor || old_prefs.Viz_style.style <> p.Viz_style.style in if need_layout then ctrl#re_layout () else if need_redraw then ctrl#redraw () let show ctrl = let p = lazy (make ctrl) in fun () -> (Lazy.force p)#present () end module About = struct let authors = ["Olivier Andrieu "] let comments = "Lets you visualize ancestry graphs from the Revision Control System monotone" let copyright = "Copyright Ā© 2004-2007 Olivier Andrieu" let license = "\ monotone-viz is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version." let name = "monotone-viz" let version = Version.version let website = "http://oandrieu.nerim.net/monotone-viz/" let website_label = "monotone-viz website" let make ctrl = let d = GWindow.about_dialog ~authors ~comments ~copyright ~license ~logo:(Lazy.force Icon.monotone) ~name ~version ~website ~website_label ~parent:ctrl#get_toplevel () in ignore (d#event#connect#delete (fun _ -> d#misc#hide () ; true)) ; ignore (d#connect#response (fun _ -> d#misc#hide ())) ; d let show ctrl = let d = lazy (make ctrl) in fun () -> (Lazy.force d)#present () end module Open = struct type t = [`OPEN|`CLOSE|`DELETE_EVENT] GWindow.file_chooser_dialog let make ctrl = let dialog = GWindow.file_chooser_dialog ~action:`OPEN ~parent:ctrl#get_toplevel ~destroy_with_parent:true ~title:"Open a Monotone database" () in dialog#add_button_stock `CLOSE `CLOSE ; dialog#add_select_button_stock `OPEN `OPEN ; ignore (dialog#connect#after#close (fun () -> dialog#response `CLOSE)) ; dialog let show dialog = let resp = match dialog#run () with | `CLOSE | `DELETE_EVENT -> None | `OPEN -> dialog#filename in dialog#misc#hide () ; resp end (* module LockedDB = struct let message ctrl = let db_fname = Database.get_filename (some ctrl#get_db) in Printf.sprintf "Database %s is currently in use by another process." (Glib.Markup.escape_text db_fname) let show ctrl = (* for some reason GtkMessageDialog looks ugly here, so I rool my own GtkDialog *) let dialog = GWindow.dialog ~no_separator:true ~parent:ctrl#get_toplevel ~destroy_with_parent:true ~title:"Monotone-viz: database locked" ~modal:true () in begin let vbox = dialog#vbox in vbox#set_border_width 12 ; let hbox = GPack.hbox ~spacing:12 ~border_width:12 ~packing:vbox#pack () in ignore (GMisc.image ~stock:`DIALOG_WARNING ~icon_size:`DIALOG ~yalign:0. ~packing:hbox#pack ()) ; ignore (GMisc.label ~markup:(message ctrl) ~line_wrap:true ~selectable:true ~xalign:0. ~yalign:0. ~packing:(hbox#pack ~expand:true) ()) end ; begin ignore (dialog#connect#close (fun () -> dialog#response `CANCEL)) ; dialog#add_button_stock `CANCEL `CANCEL ; dialog#add_button "Retry" `RETRY end ; let resp = match dialog#run () with | `CANCEL | `DELETE_EVENT -> `FAIL | `RETRY -> `RETRY in dialog#destroy () ; resp end *) let ui_info = "\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ " type popup_data = { menu : GMenu.menu ; diff_many : GMenu.menu_item ; mutable popup_id : string ; group : GAction.action_group ; mutable signals : (unit Gobject.obj * GtkSignal.id) list ; menu_cert : GMenu.menu ; clipboard1 : GData.clipboard ; clipboard2 : GData.clipboard ; } type manager = { manager : GAction.ui_manager ; db_group : GAction.action_group ; view_group : GAction.action_group ; popup_data : popup_data Lazy.t ; } let make_groups () = let add = GAction.add_action in let g_main = GAction.action_group ~name:"main" () in GAction.add_actions g_main [ add "FileMenu" ~label:"_File" ; add "Open" ~stock:`OPEN ~tooltip:"Open a database" ; add "Quit" ~stock:`QUIT ~tooltip:"Exit" ; add "Prefs" ~stock:`PREFERENCES ~tooltip:"Edit Preferences" ; add "FindEntry" ~accel:"l" ; add "HelpMenu" ~label:"_Help" ; add "About" ~stock:`ABOUT ] ; let g_db = GAction.action_group ~name:"db" () in GAction.add_actions g_db [ add "Close" ~stock:`CLOSE ~tooltip:"Close the database" ; add "New" ~stock:`NEW ~label:"New view" ~tooltip:"View a monotone ancestry graph" ] ; g_db#set_sensitive false ; let g_popup = GAction.action_group ~name:"popup" () in GAction.add_actions g_popup [ add "Certs" ~label:"Display certs" ; add "Diff_one" ~label:"Diff with ancestor" ; add "Diff_many" ~label:"Diff with ancestor" ; add "Diff_other" ~label:"Diff with selected node" ; add "Copy_cert" ~stock:`COPY ~label:"Copy the cert value to the clipboard" ; add "Copy_revision" ~stock:`COPY ~label:"Copy revision id to the clipboard" ; add "Copy_manifest" ~stock:`COPY ~label:"Copy manifest id to the clipboard" ] ; let g_view = GAction.action_group ~name:"view" () in GAction.add_actions g_view [ add "ViewMenu" ~label:"_View" ; add "Refresh" ~stock:`REFRESH ~tooltip:"Redraw" ~accel:"R" ; add "Zoom_in" ~stock:`ZOOM_IN ~tooltip:"Zoom in" ~accel:"plus" ; add "Zoom_out" ~stock:`ZOOM_OUT ~tooltip:"Zoom out" ~accel:"minus" ; add "Query" ~stock:`FIND ~tooltip:"Search the database" ] ; g_view#set_sensitive false ; (g_main, g_db, g_popup, g_view) let get_obj m name = (m#get_widget name)#as_widget let make_popup_data m g = { menu = new GMenu.menu (GtkMenu.Menu.cast (get_obj m "/popup")) ; diff_many = new GMenu.menu_item (GtkMenu.MenuItem.cast (get_obj m "/popup/Diff_many")) ; group = g ; signals = [] ; popup_id = "" ; menu_cert = new GMenu.menu (GtkMenu.Menu.cast (get_obj m "/popup_cert")) ; clipboard1 = GData.clipboard Gdk.Atom.clipboard ; clipboard2 = GData.clipboard Gdk.Atom.primary } let make () = let m = GAction.ui_manager () in let (g_main, g_db, g_popup, g_view) = make_groups () in m#insert_action_group g_main 1 ; m#insert_action_group g_db 2 ; m#insert_action_group g_popup 3 ; m#insert_action_group g_view 4 ; ignore (m#add_ui_from_string ui_info) ; let menubar = m#get_widget "/menubar" in let toolbar = m#get_widget "/toolbar" in { manager = m ; db_group = g_db ; view_group = g_view ; popup_data = lazy (make_popup_data m g_popup) }, menubar, toolbar let get_popup_data { popup_data = p } = Lazy.force p let reset_popup_menu p id = List.iter (fun (o, id) -> GtkSignal.disconnect o id) p.signals ; p.signals <- [] ; p.diff_many#remove_submenu () ; p.popup_id <- id let popup_cert m button = let p = get_popup_data m in let time = GtkMain.Main.get_current_event_time () in p.menu_cert#popup ~button ~time let set_clipboard m data = let p = get_popup_data m in p.clipboard1#set_text data ; p.clipboard2#set_text data let popup m ctrl ~popup_id button = let p = get_popup_data m in reset_popup_menu p popup_id ; let remember_signal o callback = p.signals <- (Gobject.coerce o#as_action, o#connect#activate ~callback) :: p.signals in (* setup the copy entries *) begin let copy_revision = p.group#get_action "Copy_revision" in let copy_manifest = p.group#get_action "Copy_manifest" in let data = Monotone.get_revision (some ctrl#get_mtn) popup_id in remember_signal copy_revision (fun () -> set_clipboard m data.revision_id) ; remember_signal copy_manifest (fun () -> set_clipboard m data.manifest_id) end ; (* Setup the "diff with other entry" *) begin let diff_other = p.group#get_action "Diff_other" in match ctrl#get_selected_node with | Some id when id <> popup_id -> diff_other#set_sensitive true ; remember_signal diff_other (fun () -> ctrl#show_diff id popup_id) | _ -> diff_other#set_sensitive false end ; (* Setup the "diff with ancestor(s)" entry *) begin let diff_one = p.group#get_action "Diff_one" in match Agraph.get_ancestors (some ctrl#get_agraph) popup_id with | [] -> p.diff_many#misc#hide () ; diff_one#set_visible true; diff_one#set_sensitive false ; | [ ancestor_id ] -> p.diff_many#misc#hide () ; remember_signal diff_one (fun () -> ctrl#show_diff ancestor_id popup_id) ; diff_one#set_visible true ; diff_one#set_sensitive true | a -> diff_one#set_visible false ; let submenu = GMenu.menu ~packing:p.diff_many#set_submenu () in List.iter (fun (ancestor_id as label) -> let i = GMenu.menu_item ~label ~packing:submenu#append () in ignore (i#connect#activate (fun () -> ctrl#show_diff ancestor_id popup_id))) a ; p.diff_many#misc#show () end ; (* popup the menu *) let time = GtkMain.Main.get_current_event_time () in p.menu#popup ~button ~time let automate_cb auto o = begin match o with | `OUTPUT msg -> Printf.eprintf "### automate: output '%s'\n%!" (String.escaped msg) ; let message = Printf.sprintf "interface_version: %s" msg in let d = GWindow.message_dialog ~message ~use_markup:true ~message_type:`INFO ~buttons:GWindow.Buttons.close () in ignore (d#run ()) ; d#destroy () | `SYNTAX_ERROR msg -> Printf.eprintf "### automate: syntax error '%s'\n%!" msg | `ERROR msg -> Printf.eprintf "### automate: error '%s'\n%!" msg end ; ignore (Glib.Timeout.add 5000 (fun () -> Automate.exit auto ; false)) let setup ({ manager = ui } as m) ctrl = ctrl#get_toplevel#add_accel_group m.manager#get_accel_group ; let action_connect name callback = ignore ((ui#get_action name)#connect#activate ~callback) in action_connect "/menubar/FileMenu/Close" ctrl#close_db ; action_connect "/menubar/FileMenu/Open" ctrl#show_open ; action_connect "/menubar/FileMenu/Quit" GMain.quit ; action_connect "/menubar/ViewMenu/Zoom_in" ctrl#zoom_in ; action_connect "/menubar/ViewMenu/Zoom_out" ctrl#zoom_out ; action_connect "/menubar/ViewMenu/Refresh" ctrl#reload ; action_connect "/menubar/FileMenu/Prefs" ctrl#show_prefs ; action_connect "/menubar/ViewMenu/Query" ctrl#show_search ; action_connect "/menubar/FileMenu/New" ctrl#show_view ; action_connect "/menubar/HelpMenu/About" (About.show ctrl) ; action_connect "/popup/Certs" (fun () -> ctrl#display_certs (get_popup_data m).popup_id) ; action_connect "/popup_cert/Copy_cert" (fun () -> may (set_clipboard m) ctrl#get_current_cert_value) ; action_connect "/FindEntry" ctrl#focus_find_entry let open_db m ctrl = m.db_group#set_sensitive true let close_db m ctrl = m.db_group#set_sensitive false let clear m = m.view_group#set_sensitive false let update_begin m = m.view_group#set_sensitive true monotone-viz-1.0.2.orig/ui.mli0000644000000000000000000000267610573632162013143 0ustar val valid_utf8 : string -> bool val error_notice : parent:#GWindow.window_skel -> string -> unit val error_notice_f : parent:#GWindow.window_skel -> ('a, unit, string, unit) format4 -> 'a val with_grab : (unit -> 'a) -> 'a val fold_in_loop : ?granularity:int -> ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a val wrap_in_scroll_window : (GObj.widget -> unit) -> GObj.widget -> unit val add_label : text:string -> packing:(GObj.widget -> unit) -> unit module Busy : sig type t val make : #GObj.widget -> t val start : t -> unit val stop : t -> unit end val category : string -> (GObj.widget -> unit) -> ?from:Gtk.Tags.pack_type -> ?expand:bool -> ?fill:bool -> ?padding:int -> GObj.widget -> unit class status_bar : packing:(GObj.widget -> unit) -> string -> App.status module Prefs : sig val update_prefs : #App.t -> Viz_style.prefs -> Viz_style.prefs -> unit val show : #App.t -> unit -> unit end module Open : sig type t val make : #App.t -> t val show : t -> string option end (* module LockedDB : sig val show : #App.t -> [`FAIL | `RETRY] end *) type manager val make : unit -> manager * GObj.widget * GObj.widget val setup : manager -> #App.t -> unit val popup : manager -> #App.t -> popup_id:string -> int -> unit val popup_cert : manager -> int -> unit val open_db : manager -> #App.t -> unit val close_db : manager -> #App.t -> unit val clear : manager -> unit val update_begin : manager -> unit monotone-viz-1.0.2.orig/basic_io_lexer.mll0000644000000000000000000000500210573632162015462 0ustar { type v = | ID of string | STRING of string | MULT of string list | NONE type stanza = (string * v) list type t = stanza list let string_buffer = Buffer.create 128 let rec make_value lex_value lb = match lex_value lb with | `NL -> NONE | `STRING s -> begin match make_value lex_value lb with | NONE -> STRING s | STRING s2 -> MULT [ s ; s2 ] | MULT sl -> MULT (s :: sl) | ID _ -> failwith "Basic_io_lexer: value" end | `ID id -> match lex_value lb with | `NL -> ID id | _ -> failwith "Basic_io_lexer: value" } let id = ['a'-'f' '0'-'9']* let ident = ['a'-'z' '_']+ let ws = [' ' '\t']+ let nl = [ '\n' ] rule lex = parse | ws { lex lexbuf } | ident as k { let v = make_value lex_value lexbuf in `TOK (k, v) } | nl { `END_OF_STANZA } | eof { `EOF } and nl = parse | ws { nl lexbuf } | nl { () } and lex_value = parse | ws { lex_value lexbuf } | nl { `NL } | '[' (id as id) ']' { `ID id } | '"' { Buffer.clear string_buffer ; `STRING (string lexbuf) } and string = parse | '"' { Buffer.contents string_buffer } | '\\' ['"' '\\'] { Buffer.add_char string_buffer (Lexing.lexeme_char lexbuf 1) ; string lexbuf } | [^ '"' '\\']+ { let off = lexbuf.Lexing.lex_start_pos in let len = lexbuf.Lexing.lex_curr_pos - off in Buffer.add_substring string_buffer lexbuf.Lexing.lex_buffer off len ; string lexbuf } { let rec _get_stanza acc lb = match lex lb with | `TOK ((k, _) as v) -> _get_stanza (v :: acc) lb | `END_OF_STANZA when acc = [] -> _get_stanza acc lb | `EOF | `END_OF_STANZA as e -> e, List.rev acc let get_stanza lb = match _get_stanza [] lb with | `EOF, [] -> None | _, st -> Some st let rec _parse acc lb = match _get_stanza [] lb with | `EOF, [] -> List.rev acc | `EOF, st -> List.rev (st :: acc) | `END_OF_STANZA, st -> assert (st <> []) ; _parse (st :: acc) lb let parse lb = _parse [] lb let string_of_elem = function | MULT (s :: _) | STRING s | ID s -> s | MULT [] | NONE -> "" } monotone-viz-1.0.2.orig/basic_io_lexer.mli0000644000000000000000000000037510573632162015467 0ustar type v = | ID of string | STRING of string | MULT of string list | NONE type stanza = (string * v) list type t = stanza list val get_stanza : Lexing.lexbuf -> stanza option val parse : Lexing.lexbuf -> t val string_of_elem : v -> string monotone-viz-1.0.2.orig/revision.mli0000644000000000000000000000057310573632162014356 0ustar type change = | DELETE of string | RENAME of string * string | ADD_DIR of string | ADD_FILE of string * string | PATCH of string * string * string | ATTR_CLEAR of string * string | ATTR_SET of string * string * string type edge = { old_revision : string ; change_set : change list ; } type t = string * edge list val revision_set : Lexing.lexbuf -> t monotone-viz-1.0.2.orig/revision.ml0000644000000000000000000000377710573632162014216 0ustar type change = | DELETE of string | RENAME of string * string | ADD_DIR of string | ADD_FILE of string * string | PATCH of string * string * string | ATTR_CLEAR of string * string | ATTR_SET of string * string * string type edge = { old_revision : string ; change_set : change list ; } type t = string * edge list type tok = Basic_io_lexer.v = | ID of string | STRING of string | MULT of string list | NONE let rec _star acc p = parser | [< v = p ; nxt >] -> _star (v :: acc) p nxt | [<>] -> acc let format = parser | [< ' [ "format_version", STRING "1" ] >] -> () let new_manifest = parser | [< ' [ "new_manifest", ID id ] >] -> id let delete = parser | [< ' [ "delete", STRING p ] >] -> DELETE p let rename = parser | [< ' [ "rename", STRING p ; "to", STRING np ] >] -> RENAME (p, np) let add_dir = parser | [< ' [ "add_dir", STRING p ] >] -> ADD_DIR p let add_file = parser | [< ' [ "add_file", STRING p ; "content", ID id ] >] -> ADD_FILE (p, id) let patch = parser | [< ' [ "patch", STRING p ; "from", ID id1 ; "to", ID id2 ] >] -> PATCH (p, id1, id2) let clear = parser | [< ' [ "clear", STRING p ; "attr", STRING a ] >] -> ATTR_CLEAR (p, a) let set = parser | [< ' [ "set", STRING p ; "attr", STRING a ; "value", STRING v ] >] -> ATTR_SET (p, a, v) let change_set = parser | [< cs = _star [] delete ; cs = _star cs rename ; cs = _star cs add_dir ; cs = _star cs add_file ; cs = _star cs patch ; cs = _star cs clear ; cs = _star cs set >] -> List.rev cs let edge = parser | [< ' [ "old_revision", ID id ] ; cs = change_set >] -> { old_revision = id ; change_set = cs } let revision = parser | [< () = format ; manifest = new_manifest ; edges = _star [] edge >] -> manifest, List.rev edges let revision_set lb = let strm = Stream.from (fun _ -> Basic_io_lexer.get_stanza lb) in revision strm monotone-viz-1.0.2.orig/components.ml0000644000000000000000000000406110573632162014530 0ustar open Viz_types let is_neighbor n = match n.kind with | NEIGHBOUR_IN | NEIGHBOUR_OUT -> true | _ -> false let all_children_neighbors g n = let rec proc acc = function | [] -> acc | (_, PARENT) :: tl -> proc acc tl | (id, CHILD) :: tl -> match try Some (is_neighbor (NodeMap.find id g)) with Not_found -> None with | Some true -> proc (id :: acc) tl | Some false -> [] | None -> proc acc tl in proc [] n.family let get_neighbors_of_leaves g = NodeMap.fold (fun id node acc -> if is_neighbor node then acc else (all_children_neighbors g node) @ acc) g [] let explore get_children f start_node = let rec explore_rec explored q = match Q.pop q with | None -> () | Some (node, tl) when IdSet.mem node explored -> explore_rec explored tl | Some (node, tl) -> let explored = IdSet.add node explored in match f node with | `REJECT -> explore_rec explored tl | `CONTINUE -> explore_rec explored (get_children node tl) in explore_rec IdSet.empty (get_children start_node Q.empty) exception Found of string let reconnect fetch_children agraph = let disconnection_points = get_neighbors_of_leaves agraph.nodes in if Viz_misc.debug "comp" then begin Viz_misc.log "comp" "disconnection points (%d):\n %s" (List.length disconnection_points) (String.concat "\n " disconnection_points) end ; let get_children id q = fetch_children id Q.push q in let with_spanning_edges = List.fold_left (fun acc id -> match try explore get_children (fun id -> try let n = NodeMap.find id agraph.nodes in if n.kind = NEIGHBOUR_IN then raise (Found id) ; `REJECT with Not_found -> `CONTINUE) id ; None with Found target -> Viz_misc.log "comp" "found an edge: %s -> %s" id target ; Some (id, target) with | None -> acc | Some edge -> EdgeMap.add edge SPANNING acc) agraph.ancestry disconnection_points in { agraph with ancestry = with_spanning_edges } monotone-viz-1.0.2.orig/automate.mli0000644000000000000000000000062210621642732014330 0ustar type t type command_id = int type output = [ | `OUTPUT of string | `ERROR of string | `SYNTAX_ERROR of string] val get_info : t -> string * string val get_dbfname : t -> string val make : string -> string -> t val exit : t -> unit val submit : t -> string list -> (output -> unit) -> command_id val submit_sync : t -> string list -> string val abort : t -> command_id -> unit monotone-viz-1.0.2.orig/automate.ml0000644000000000000000000003206710621642732014167 0ustar open Viz_misc let init = Giochannel.init ; Gspawn.init let debug = Viz_misc.debug "automate" let log fmt = Printf.kprintf (fun s -> Printf.eprintf "### automate: %s\n%!" s) fmt (** Type definitions *) type pb = [ | `HANGUP | `FAILURE | `ERROR of exn ] type watch_state = [ | `DISABLED | `WATCH of Giochannel.source_id | pb ] type watch = { w_name : string ; w_chan : Giochannel.t ; mutable w_state : watch_state ; mutable exn_cb : pb -> unit ; } type in_watch = { in_w : watch ; mutable in_data : (int * string) list ; mutable in_pos : int ; } type out_watch = { out_w : watch ; out_sb : string ; out_buffer : Buffer.t ; mutable out_cb : (Buffer.t -> unit) } type command_id = int type output = [ | `OUTPUT of string | `ERROR of string | `SYNTAX_ERROR of string] type chunk = command_id * int * bool * string type process = { p_in : in_watch ; p_out : out_watch ; p_err : out_watch ; mutable cmd_number : command_id ; mutable callbacks : (command_id * (output -> unit)) list ; mutable chunks : (command_id * chunk list ref) list ; mutable state : [`RUNNING|`EXITING|`EXIT of int] ; mutable exit_cb : (pb -> string -> unit) ; } type t = { mtn : string ; db_fname : string ; mutable process : process option ; } let get_info c = c.mtn, c.db_fname let get_dbfname c = c.db_fname let string_of_conditions cond = let s = String.make 6 '.' in Array.iteri (fun i (v, c) -> if List.mem v cond then s.[i] <- c) [| `IN, 'I' ; `OUT, 'O' ; `HUP, 'H' ; `ERR, 'E' ; `PRI, 'P' ; `NVAL, 'N' |] ; s let string_of_pb = function | `ERROR exn -> Printf.sprintf "EXN '%s'" (Printexc.to_string exn) | `FAILURE -> "ERR" | `HANGUP -> "HUP" let error_cb w conditions = if debug then log "%s hup_cb = %s" w.w_name (string_of_conditions conditions) ; if List.mem `ERR conditions then begin w.exn_cb `FAILURE end else begin assert (conditions = [`HUP]) ; w.exn_cb `HANGUP end let do_write w data = let bytes_written = ref 0 in try match Giochannel.write_chars w.in_w.w_chan ~bytes_written ~off:w.in_pos data with | `NORMAL written -> if debug then log "%s cb: wrote %d" w.in_w.w_name written ; w.in_pos <- w.in_pos + written ; w.in_pos >= String.length data | `AGAIN -> (* should not happen, our out channels are blocking *) if debug then log "%s cb: EAGAIN ?" w.in_w.w_name ; false with | Giochannel.Error (_, msg) as exn -> if debug then log "%s cb: error %s, wrote %d" w.in_w.w_name msg !bytes_written ; w.in_w.exn_cb (`ERROR exn) ; false let _write_cb w conditions = if debug then log "%s cb = %s" w.in_w.w_name (string_of_conditions conditions) ; match w.in_data with | [] -> (* nothing to write, remove the source from the main loop *) if debug then log "%s cb: empty write queue, removing watch" w.in_w.w_name ; w.in_w.w_state <- `DISABLED | (nb, data) :: tl -> (* some data to write *) let len = String.length data in let to_write = len - w.in_pos in assert (len > 0 && to_write > 0) ; if debug then log "%s cb: %d left in buffer" w.in_w.w_name to_write ; if debug && w.in_pos = 0 then log "%s cb: writing '%s'" w.in_w.w_name (String.escaped data) ; if List.mem `OUT conditions then begin let finished = do_write w data in if finished then begin if debug then log "%s cb: finished writing cmd %d" w.in_w.w_name nb ; (* written everything, proceed to the next chunk *) w.in_data <- tl ; w.in_pos <- 0 end end else error_cb w.in_w conditions let _read_cb w conditions = if debug then log "%s cb = %s" w.out_w.w_name (string_of_conditions conditions) ; if List.mem `IN conditions then begin try match Giochannel.read_chars w.out_w.w_chan w.out_sb with | `NORMAL read -> if debug then log "%s cb: read %d" w.out_w.w_name read ; Buffer.add_substring w.out_buffer w.out_sb 0 read ; w.out_cb w.out_buffer | `EOF -> if debug then log "%s cb: eof ?" w.out_w.w_name ; w.out_w.exn_cb `FAILURE | `AGAIN -> if debug then log "%s cb: AGAIN" w.out_w.w_name with exn -> if debug then log "%s cb: error %s" w.out_w.w_name (Printexc.to_string exn) ; w.out_w.exn_cb (`ERROR exn) end else error_cb w.out_w conditions let reschedule_watch w = match w.w_state with | `WATCH _ -> true | _ -> false let write_cb w c = try _write_cb w c ; reschedule_watch w.in_w with exn -> if debug then log "write cb %s: uncaught exception '%s'" w.in_w.w_name (Printexc.to_string exn) ; true let read_cb w c = try _read_cb w c ; reschedule_watch w.out_w with exn -> if debug then log "read cb %s: uncaught exception '%s'" w.out_w.w_name (Printexc.to_string exn) ; true let setup_watch_write w nb data = match w.in_w.w_state with | `DISABLED -> assert (w.in_data = []) ; w.in_data <- [ nb, data ] ; w.in_pos <- 0 ; let id = Giochannel.add_watch w.in_w.w_chan [ `OUT ; `HUP ; `ERR ] (write_cb w) in w.in_w.w_state <- `WATCH id ; | `WATCH _ -> w.in_data <- w.in_data @ [ nb, data ] | _ -> assert (false) let setup_watch_read w = assert (w.out_w.w_state = `DISABLED) ; let id = Giochannel.add_watch w.out_w.w_chan [ `IN ; `HUP ; `ERR ] (read_cb w) in w.out_w.w_state <- `WATCH id let setup_exn_cb w cb = w.exn_cb <- cb w let setup_channel ~nonblock fd = let chan = Giochannel.new_fd (some fd) in if nonblock then Giochannel.set_flags_noerr chan [`NONBLOCK] ; Giochannel.set_encoding chan None ; Giochannel.set_buffered chan false ; chan let make_watch name chan = { w_name = name ; w_chan = chan ; w_state = `DISABLED ; exn_cb = ignore } let make_in_watch name fd = let chan = setup_channel ~nonblock:true fd in { in_w = make_watch name chan ; in_data = [] ; in_pos = 0 } let make_out_watch name fd = let chan = setup_channel ~nonblock:false fd in let w = { out_w = make_watch name chan ; out_sb = String.create 4096 ; out_buffer = Buffer.create 1024 ; out_cb = ignore } in setup_watch_read w ; w let send_data p nb data = if String.length data = 0 then invalid_arg "Automate.send_data: empty string" ; setup_watch_write p.p_in nb data let encode_stdio cmd = let b = Buffer.create 512 in Buffer.add_char b 'l' ; List.iter (fun s -> Printf.bprintf b "%d:%s" (String.length s) s) cmd ; Buffer.add_string b "e\n" ; Buffer.contents b let find_four_colon b = let to_find = ref 4 in let i = ref 0 in while !to_find > 0 do let c = Buffer.nth b !i in if c = ':' then decr to_find ; incr i done ; !i let truncate_buffer b off len = let data = Buffer.sub b off len in let rest = Buffer.sub b (off + len) (Buffer.length b - off - len) in Buffer.clear b ; Buffer.add_string b rest ; data let decode_stdio_chunk b = try let header_len = find_four_colon b in let h = Buffer.sub b 0 header_len in let c1 = String.index_from h 0 ':' in let number = int_of_string (string_slice ~e:c1 h) in let code = int_of_char h.[c1 + 1] - int_of_char '0' in let c2 = String.index_from h (c1 + 1) ':' in let last = h.[c2 + 1] in let c3 = String.index_from h (c2 + 1) ':' in let c4 = String.index_from h (c3 + 1) ':' in let len = int_of_string (string_slice ~s:(c3 + 1) ~e:c4 h) in if Buffer.length b < header_len + len then `INCOMPLETE else let data = truncate_buffer b header_len len in `CHUNK (number, code, last = 'l', data) with Invalid_argument _ -> `INCOMPLETE let aborted_cmd p nb = not (List.mem_assoc nb p.callbacks) let rec out_cb p b = match decode_stdio_chunk b with | `INCOMPLETE -> () | `CHUNK (nb, _, _, _) when aborted_cmd p nb -> p.chunks <- List.remove_assoc nb p.chunks ; out_cb p b | `CHUNK ((nb, code, false, data) as chunk) -> if debug then log "decoded a chunk" ; let previous_chunks = try List.assoc nb p.chunks with Not_found -> let c = ref [] in p.chunks <- (nb, c) :: p.chunks ; c in previous_chunks := chunk :: !previous_chunks ; out_cb p b | `CHUNK ((nb, code, true, data) as chunk) -> if debug then log "decoded last chunk" ; let chunks = try let c = List.assoc nb p.chunks in p.chunks <- List.remove_assoc nb p.chunks ; List.rev (chunk :: !c) with Not_found -> [ chunk ] in let cb = List.assoc nb p.callbacks in p.callbacks <- List.remove_assoc nb p.callbacks ; let msg = String.concat "" (List.map (fun (_, _, _, d) -> d) chunks) in let data = match code with | 0 -> `OUTPUT msg | 1 -> `SYNTAX_ERROR msg | 2 -> `ERROR msg | _ -> failwith "invalid_code in automate stdio output" in ignore (Glib.Idle.add ~prio:0 (fun () -> cb data ; false)) ; out_cb p b let check_exit p = match p.state with | `RUNNING | `EXITING -> () | `EXIT _ -> let stderr = Buffer.contents p.p_err.out_buffer in let r = if p.p_in.in_w.w_state <> `HANGUP then p.p_in.in_w.w_state else if p.p_out.out_w.w_state <> `HANGUP then p.p_out.out_w.w_state else if p.p_err.out_w.w_state <> `HANGUP then p.p_err.out_w.w_state else `HANGUP in match r with | #pb as r -> p.exit_cb r stderr | _ -> () let exn_cb p w r = if debug then log "%s exn_cb: %s" w.w_name (string_of_pb r) ; if p.state = `RUNNING then p.state <- `EXITING ; Giochannel.shutdown w.w_chan false ; w.w_state <- (r : pb :> watch_state) ; check_exit p let reap_cb p pid st = if debug then log "reap_cb: %d" st ; Gspawn.close_pid pid ; if p.p_in.in_w.w_state = `DISABLED then exn_cb p p.p_in.in_w `HANGUP ; p.state <- `EXIT st ; check_exit p let _submit p cmd cb = Viz_misc.log "mtn" "sending command '%s'" (String.concat " " cmd) ; let id = p.cmd_number in send_data p id (encode_stdio cmd) ; p.cmd_number <- id + 1 ; p.callbacks <- (id, cb) :: p.callbacks ; id let spawn mtn db = let cmd = [ mtn ; "-d" ; db ; "automate" ; "stdio" ] in if Viz_misc.debug "exec" then Printf.eprintf "### exec: Running '%s'\n%!" (String.concat " " cmd) ; let flags = [ `PIPE_STDIN ; `PIPE_STDOUT ; `PIPE_STDERR ; `SEARCH_PATH ; `DO_NOT_REAP_CHILD] in let child = Gspawn.async_with_pipes ~flags cmd in let p = { p_in = make_in_watch "stdin" child.Gspawn.standard_input ; p_out = make_out_watch "stdout" child.Gspawn.standard_output ; p_err = make_out_watch "stderr" child.Gspawn.standard_error ; state = `RUNNING ; cmd_number = 0 ; callbacks = [] ; chunks = [] ; exit_cb = (fun _ -> assert false) } in let pid = some child.Gspawn.pid in ignore (Gspawn.add_child_watch ~prio:50 pid (reap_cb p pid)) ; p.p_out.out_cb <- out_cb p ; setup_exn_cb p.p_in.in_w (exn_cb p) ; setup_exn_cb p.p_out.out_w (exn_cb p) ; setup_exn_cb p.p_err.out_w (exn_cb p) ; p let exit_cb ctrl p r stderr = if debug then log "exit_cb: r='%s' stderr='%s'" (string_of_pb r) stderr ; (* display dialog box in case of error ... *) match ctrl.process with | Some p' when p' == p -> ctrl.process <- None ; List.iter (fun (_, cb) -> cb (`ERROR stderr)) p.callbacks | _ -> () let ensure_process ctrl = match ctrl.process with | Some ({ state = `RUNNING } as p) -> p | Some { state = `EXITING | `EXIT _ } | None -> let p = spawn ctrl.mtn ctrl.db_fname in p.exit_cb <- exit_cb ctrl p ; ctrl.process <- Some p ; p let make mtn db = { mtn = mtn ; db_fname = db ; process = None } let exit ctrl = match ctrl.process with | Some ({ state = `RUNNING } as p) -> if debug then log "forced exit" ; let w = p.p_in.in_w in begin match w.w_state with | `WATCH id -> Giochannel.remove_watch id | _ -> () end ; Giochannel.shutdown w.w_chan false ; w.w_state <- `HANGUP | Some { state = `EXITING | `EXIT _ } | None -> () let submit ctrl cmd cb = _submit (ensure_process ctrl) cmd cb let submit_sync ctrl cmd = let output = ref None in let exit_loop = ref false in let _ = submit ctrl cmd (fun v -> output := Some v ; exit_loop := true) in while not !exit_loop do ignore (Glib.Main.iteration true) done ; match some !output with | `OUTPUT msg -> msg | `ERROR msg | `SYNTAX_ERROR msg -> Viz_types.errorf "mtn automate error: %s" msg let abort ctrl nb = match ctrl.process with | None -> () | Some p -> p.callbacks <- List.remove_assoc nb p.callbacks ; match p.p_in.in_data with | (id, _) :: tl when id = nb -> if p.p_in.in_pos = 0 then begin p.p_in.in_data <- tl ; p.p_in.in_pos <- 0 end | h :: tl -> p.p_in.in_data <- h :: (List.remove_assoc nb tl) | [] -> () (* TODO: - add a timeout to exit the subprocess in case of inactivity - add a submit_delayed to submit a cancellable command with a small timeout (for keyboard nav) - check exceptions and callbacks - add asserts and sanity checks *) monotone-viz-1.0.2.orig/monotone.mli0000644000000000000000000000141710616155674014362 0ustar type t = Automate.t val make : string -> string -> t val exit : t -> unit val run_monotone_diff : t -> unit; pop : unit -> unit; ..> -> ([>`SUB_PROC_ERROR of string | `OUTPUT of string] -> unit) -> string * string -> unit val run_monotone_count_branches : t -> (string -> int) val escape_selector : string -> string val branches : t -> string list val get_revision : t -> string -> Viz_types.node_data val get_certs_and_revision : t -> string -> Viz_types.node_data val cert_value : t -> string -> string -> string list val select : t -> string -> string list val agraph : t -> Viz_types.query -> Viz_types.agraph val select_async : t -> ([>`SUB_PROC_ERROR of string | `IDS of string list] -> unit) -> string list -> Automate.command_id list monotone-viz-1.0.2.orig/monotone.ml0000644000000000000000000002260110621642732014177 0ustar open Viz_types type t = Automate.t let make = Automate.make let exit = Automate.exit let report_error cb fmt = Printf.kprintf (fun s -> cb (`SUB_PROC_ERROR s)) fmt let spawn_monotone mtn cmd input status cb = let mtn_exe, db_fname = Automate.get_info mtn in let cmd = mtn_exe :: "--db" :: db_fname :: cmd in try status#push "Running monotone ..." ; Subprocess.spawn ~encoding:`NONE ~cmd ~input ~reap_callback:status#pop (fun ~exceptions ~stdout ~stderr status -> if status = 0 then cb (`OUTPUT stdout) else if stderr = "" then report_error cb "Monotone exited with status %d:\n%s" status (String.concat "\n" (List.map Printexc.to_string exceptions)) else report_error cb "Monotone error:\n%s" stderr) with Gspawn.Error (_, msg) -> Viz_types.errorf "Could not execute monotone:\n%s" msg let run_monotone_diff mtn status cb (old_id, new_id) = ignore (spawn_monotone mtn [ "--revision" ; old_id ; "--revision" ; new_id ; "diff" ] None status cb) let decode_count_branches d = match Viz_misc.string_split '\n' d with | _ :: l -> let re = Str.regexp "\\([0-9]+\\) | \\(.*\\)" in List.map (fun r -> if Str.string_match re r 0 then begin let b = Str.matched_group 2 r and n = Str.matched_group 1 r in b, int_of_string n end else failwith "Monotone.decode_count_branches: bad format") l | _ -> failwith "Monotone.decode_count_branches: bad format" let fake_status () = object method push _ = () method pop () = () end let wait_subproc mtn args = let output = ref None and exit_loop = ref false in let cb v = output := Some v ; exit_loop := true in ignore (spawn_monotone mtn args None (fake_status ()) cb) ; while not !exit_loop do ignore (Glib.Main.iteration true) done ; Viz_misc.some !output let run_monotone_count_branches mtn = let counts = let args = [ "db" ; "execute" ; "SELECT COUNT(*), value FROM revision_certs WHERE name = 'branch' GROUP BY value" ] in match wait_subproc mtn args with | `SUB_PROC_ERROR _ -> [] | `OUTPUT d -> try decode_count_branches d with Failure _ -> [] in match counts with | [] -> fun b -> 0 | _ -> let tbl = Viz_misc.hashtbl_of_list counts in fun b -> try Hashtbl.find tbl b with Not_found -> 0 let escape_selector s = let len = String.length s in let nb_escp = ref 0 in for i = 0 to len - 1 do let c = s.[i] in if c = '\\' || c = '/' then incr nb_escp done ; if !nb_escp = 0 then s else begin let o = String.create (len + !nb_escp) in let j = ref 0 in for i = 0 to len - 1 do let c = s.[i] in if c = '\\' || c = '/' then (o.[!j] <- '\\' ; incr j) ; o.[!j] <- c ; incr j done ; assert (!j = len + !nb_escp) ; o end let ( +> ) x f = f x let decode_branches msg = Viz_misc.string_split '\n' msg let branches mtn = Automate.submit_sync mtn [ "branches" ] +> decode_branches let node_data_of_revision rev_id certs (m_id, edges) = { revision_id = rev_id ; manifest_id = m_id ; revision_set = List.map (fun e -> e.Revision.old_revision, e.Revision.change_set) edges ; certs = certs ; } let _get_revision mtn id certs = Automate.submit_sync mtn [ "get_revision" ; id ] +> Lexing.from_string +> Revision.revision_set +> node_data_of_revision id certs let get_revision mtn id = _get_revision mtn id [] let get_elem st k = try Basic_io_lexer.string_of_elem (List.assoc k st) with Not_found -> "??" let sig_verif = function | "ok" -> SIG_OK | "bad" -> SIG_BAD | "unknown" -> SIG_UNKNOWN | _ -> failwith "Monotone.sig_verif" let cert_of_stanza id st = { c_id = id ; c_name = get_elem st "name" ; c_value = get_elem st "value" ; c_signer_id = get_elem st "key" ; c_signature = sig_verif (get_elem st "signature") ; } let raw_certs mtn id = Automate.submit_sync mtn [ "certs" ; id ] +> Lexing.from_string +> Basic_io_lexer.parse let certs mtn id = raw_certs mtn id +> List.map (cert_of_stanza id) let get_certs_and_revision mtn id = certs mtn id +> _get_revision mtn id let cert_value mtn id = let c = raw_certs mtn id in fun name -> Viz_misc.list_filter_map (fun st -> get_elem st "name" = name) (fun st -> get_elem st "value") c let select mtn selector = Automate.submit_sync mtn [ "select" ; selector ] +> Viz_misc.string_split '\n' let selectors_of_query q = match q.lim with | QUERY_NO_LIMIT -> List.map (fun b -> b, "b:" ^ escape_selector b) q.dom | QUERY_BETWEEN (d1, d2) -> let s_d = match escape_selector d1, escape_selector d2 with | "", "" -> [] | d1, "" -> [ "l:" ^ d1 ] | "", d2 -> [ "e:" ^ d2 ] | d1, d2 -> [ "l:" ^ d1 ; "e:" ^ d2 ] in List.map (fun b -> let s_b = "b:" ^ escape_selector b in let s_t = String.concat "/" (s_b :: s_d) in b, s_t) q.dom let get_ids mtn query = List.fold_left (fun set (b, s) -> List.fold_left (fun set id -> try let bl = NodeMap.find id set in bl := b :: !bl ; set with Not_found -> NodeMap.add id (ref [ b ]) set) set (select mtn s)) NodeMap.empty (selectors_of_query query) let graph mtn = Automate.submit_sync mtn [ "graph" ] let children mtn id f init = Automate.submit_sync mtn [ "children" ; id ] +> Viz_misc.string_split '\n' +> List.fold_left f init let decode_graph f init data = let pos = ref 0 in let acc = ref init in begin try while true do let e = String.index_from data !pos '\n' in let nb = (e - !pos + 1) / 41 in (* len = 40 x k + k - 1 where k āˆˆ { 1, 2, 3 } *) let id = String.sub data !pos 40 in let p = if nb <= 1 then [] else if nb <= 2 then [ String.sub data (!pos + 41) 40 ] else [ String.sub data (!pos + 41) 40 ; String.sub data (!pos + 82) 40 ] in acc := f !acc id p ; pos := e + 1 done with Not_found -> () end ; !acc let ensure_node agraph id kind family = try let n = NodeMap.find id agraph.nodes in if n.kind < kind then n.kind <- kind ; n.family <- family @ n.family ; agraph with Not_found -> let n = { id = id ; kind = kind ; family = family } in { agraph with nodes = NodeMap.add id n agraph.nodes } let edge_kind b_set i1 i2 = try let b1 = NodeMap.find i1 b_set in let b2 = NodeMap.find i2 b_set in if List.exists (fun b -> List.mem b !b1) !b2 then SAME_BRANCH else BRANCHING with Not_found -> BRANCHING_NEIGH let ensure_edge agraph b_set i1 i2 = let e = edge_kind b_set i1 i2 in { agraph with ancestry = EdgeMap.add (i1, i2) e agraph.ancestry } let interesting_node id_set id = id_set = NodeMap.empty || NodeMap.mem id id_set let only_one_child mtn id = children mtn id (fun n _ -> n + 1) 0 <= 1 let keep_neighbor_out mtn all_propagates p p_in_graph = all_propagates || List.length p_in_graph = List.length p || List.for_all (only_one_child mtn) p_in_graph let add_node mtn query ids agraph id p = if interesting_node ids id then begin let agraph = ensure_node agraph id (if List.length p >= 2 then MERGE else REGULAR) (List.map (fun i -> i, PARENT) p) in let p = List.map (fun id_p -> id_p, interesting_node ids id_p) p in List.fold_left (fun agraph (id_p, is_reg) -> let agraph = ensure_node agraph id_p (if is_reg then REGULAR else NEIGHBOUR_IN) [ id, CHILD ] in ensure_edge agraph ids id_p id) agraph p end else match List.filter (interesting_node ids) p with | [] -> agraph | p_in_graph when keep_neighbor_out mtn query.all_propagates p p_in_graph -> let agraph = ensure_node agraph id NEIGHBOUR_OUT (List.map (fun i -> i, PARENT) p_in_graph) in List.fold_left (fun agraph id_p -> let agraph = ensure_node agraph id_p REGULAR [ id, CHILD ] in ensure_edge agraph ids id_p id) agraph p_in_graph | _ -> agraph let grab_tags mtn agraph = Automate.submit_sync mtn [ "tags" ] +> Lexing.from_string +> Basic_io_lexer.parse +> List.fold_left (fun agraph st -> try let n = NodeMap.find (get_elem st "revision") agraph.nodes in n.kind <- TAGGED (get_elem st "tag") ; agraph with Not_found -> agraph) agraph let agraph mtn query = let ids = get_ids mtn query in graph mtn +> decode_graph (add_node mtn query ids) empty_agraph +> grab_tags mtn +> Components.reconnect (children mtn) (* TODO: - distinguish between true neighbor nodes and nodes that are outside the date limit. *) let join nb cb = let cnt = ref nb in let acc = ref [] in function | `OUTPUT data when !cnt = 1 -> let total = List.rev (data :: !acc) in cb (`OUTPUT total) | `OUTPUT data -> acc := data :: !acc ; decr cnt | `ERROR msg | `SYNTAX_ERROR msg -> cnt := 0 ; cb (`SUB_PROC_ERROR msg) let decode cb = function | `SUB_PROC_ERROR _ as r -> cb r | `OUTPUT d -> let ids = List.flatten (List.map (Viz_misc.string_split '\n') d) in cb (`IDS ids) let select_async mtn cb selectors = let nb_selectors = List.length selectors in let auto_cb = join nb_selectors (decode cb) in List.map (fun sel -> Automate.submit mtn [ "select" ; sel ] auto_cb) selectors monotone-viz-1.0.2.orig/agraph.ml0000644000000000000000000002270310573632162013610 0ustar open Viz_misc open Viz_types type layout = Viz_types.cgraph type layout_params = { box_w : float ; box_h : float ; char_width : float ; lr_layout : bool ; dot_program : string ; } type t = { query : Viz_types.query ; agraph : Viz_types.agraph ; layout_params : layout_params ; mutable layout : layout option ; mutable dot_subproc : Subprocess.t option ; } exception Not_yet let ppi = 72. let node_kind agraph id = (NodeMap.find id agraph.nodes).kind (* DOT output *) let find_heads agraph = let (parents, children) = EdgeMap.fold (fun (parent, child) _ (parents, children) -> IdSet.add parent parents, IdSet.add child children) agraph.ancestry (IdSet.empty, IdSet.empty) in IdSet.filter (fun id -> not (neighbour_kind (node_kind agraph id))) (IdSet.diff children parents) let dot_format params agraph = let b = Buffer.create 4096 in let ( !+ ) fmt = Printf.bprintf b fmt in let do_nodes p = NodeMap.iter (fun id n -> if p n then !+ " %S ;\n" id) agraph.nodes in !+ "digraph \"monotone-viz\"\n{\n" ; if params.lr_layout then !+ " graph [rankdir=LR] ;\n" ; !+ " graph [ranksep=\"0.25\"] ;\n" ; !+ " node [label=\"\"] ;\n" ; begin (* regular (rectangular) nodes *) !+ " node [shape=box, width = %f, height = %f] ;\n" params.box_w params.box_h ; do_nodes (fun n -> match n.kind with REGULAR | NEIGHBOUR_IN | NEIGHBOUR_OUT -> true | _ -> false) end ; begin (* nodes with tags *) NodeMap.iter (fun id n -> match n.kind with | TAGGED tag -> let w = params.char_width *. float (String.length tag + 4) in !+ " %S [width = %g] ;\n" id w | _ -> ()) agraph.nodes end ; begin (* merge nodes *) let s = min params.box_w params.box_h in !+ " node [shape=circle, width = %f, height = %f] ;\n" s s ; do_nodes (fun n -> n.kind = MERGE) ; end ; (* begin *) (* (* disapproval nodes *) *) (* let s = min params.box_w params.box_h in *) (* !+ " node [shape=diamond, width = %f, height = %f] ;\n" s s ; *) (* do_nodes (fun n -> n.kind = DISAPPROVE) ; *) (* end ; *) let heads = find_heads agraph in begin (* heads *) !+ " subgraph heads {\n" ; !+ " rank = sink ;\n" ; IdSet.iter (fun id -> !+ " %S ;\n" id) heads ; !+ " }\n" end ; begin (* edges *) EdgeMap.iter (fun (s, t) kind -> !+ " %S -> %S" s t ; if kind = SPANNING then !+ " [minlen = 5]" ; if kind = BRANCHING_NEIGH && node_kind agraph t = NEIGHBOUR_OUT then !+ " [weight = 4]" ; if IdSet.mem t heads then !+ " [weight = 2]" ; !+ " ;\n") agraph.ancestry end ; !+ "}\n" ; let res = Buffer.contents b in Buffer.reset b ; res (* DOT input *) let rec find_bb = function | `ATTR_GRAPH a :: tl -> begin try List.assoc "bb" a with Not_found -> find_bb tl end | _ :: tl -> find_bb tl | [] -> failwith "no bb" type node_attribute = { shape : string ; width : float ; height : float ; } let init_node_attr = { shape = "box" ; width = 0. ; height = 0. } let update_node_attr attr l = List.fold_left (fun attr -> function | "shape" , v -> { attr with shape = v } | "width" , v -> (try { attr with width = float_of_string v } with Failure _ -> attr) | "height", v -> (try { attr with height = float_of_string v } with Failure _ -> attr) | _ -> attr) attr l let convert_node agraph nodes node_attr id a = let this_node_attr = update_node_attr node_attr a in try let kind = node_kind agraph id in let width = ppi *. this_node_attr.width in let height = ppi *. this_node_attr.height in let (x, y) = match List.map float_of_string (string_split ',' (List.assoc "pos" a)) with | [x; y] -> (x, y) | _ -> failwith "bad pos" in NodeMap.add id { c_kind = kind ; n_x = x ; n_y = y ; n_w = width ; n_h = height } nodes with Not_found | Failure _ -> nodes let parse_coords x = Array.of_list (List.map float_of_string (List.tl (string_split ',' x))) let convert_edge agraph edges edge a = try let edge_kind = EdgeMap.find edge agraph.ancestry in let coords = string_split ' ' (List.assoc "pos" a) in let endp, coords = match coords with | x :: t when string_is_prefix "e," x -> (parse_coords x, t) | l -> [||], l in let startp, coords = match coords with | x :: t when string_is_prefix "s," x -> (parse_coords x, t) | l -> [||], l in let controlp = List.flatten (List.map (string_split ',') coords) in let controlp = Array.of_list (List.map float_of_string controlp) in let spline = { startp = startp ; endp = endp ; controlp = controlp ; edge_kind = edge_kind } in if let len = Array.length controlp in len mod 6 = 2 && len >= 8 then EdgeMap.add edge spline edges else edges with Not_found | Failure _ -> edges let rec convert_graph agraph ((node_attr, nodes, edges) as acc) = function | `SUBGRAPH (_, stmt) -> let (_, nodes, edges) = List.fold_left (convert_graph agraph) acc stmt in (node_attr, nodes, edges) | `ATTR_NODE a -> (update_node_attr node_attr a, nodes, edges) | `NODE (id, _, a) -> let nodes = convert_node agraph nodes node_attr id a in (node_attr, nodes, edges) | `EDGE (`NODEID (id_tail, _), [`DIRECTED, `NODEID (id_head, _)], a) -> let edges = convert_edge agraph edges (id_tail, id_head) a in (node_attr, nodes, edges) | _ -> acc let convert_dot_data agraph { Dot_types.stmt = graph } = let bb = match List.map float_of_string (string_split ',' (find_bb graph)) with | [x1; y1; x2; y2] -> (x1, min y1 y2, x2, max y1 y2) | _ -> failwith "bad bb" in let (_, nodes, edges) = List.fold_left (convert_graph agraph) (init_node_attr, NodeMap.empty, EdgeMap.empty) graph in { bb = bb; c_nodes = nodes; c_edges = edges } (* Spawn dot *) let spawn_dot graph status done_cb = let dot_prg = graph.layout_params.dot_program in let cmd = if Viz_misc.debug "dot" then [ "/bin/sh" ; "-c" ; Printf.sprintf "set -o pipefail ; \ tee agraph.in.dot | %s -q -y -s%.0f | tee agraph.out.dot" dot_prg ppi ] else [ dot_prg ; "-q" ; "-y" ; Printf.sprintf "-s%.0f" ppi ] in let error fmt = Printf.kprintf (fun s -> done_cb (`LAYOUT_ERROR s)) fmt in try status#push "Running dot ..." ; Subprocess.spawn ~encoding:`NONE ~cmd ~input:(Some (dot_format graph.layout_params graph.agraph)) ~reap_callback:status#pop (fun ~exceptions ~stdout ~stderr status -> graph.dot_subproc <- None ; if status <> 0 then if stderr = "" then error "Dot exited with status %d:%s\n" status (String.concat "\n" (List.map Printexc.to_string exceptions)) else error "Dot error:\n%s" stderr else try let lb = Lexing.from_string stdout in let data = Dot_parser.graph Dot_lexer.lex lb in let cgraph = convert_dot_data graph.agraph data in graph.layout <- Some cgraph ; done_cb `LAYOUT_DONE with | Parsing.Parse_error | Failure _ -> error "Could not parse dot output" | exn -> error "unhandled exception: %s\n%!" (Printexc.to_string exn) ) with Gspawn.Error (_, msg) -> Viz_types.errorf "Could not execute dot:\n%s" msg (* Public API *) type done_cb = [`LAYOUT_DONE | `LAYOUT_ERROR of string] -> unit let make agraph query layout_params status (done_cb : done_cb) = let graph = { query = query ; agraph = agraph ; layout_params = { layout_params with char_width = layout_params.char_width /. ppi ; box_w = layout_params.box_w /. ppi ; box_h = layout_params.box_h /. ppi } ; layout = None ; dot_subproc = None ; } in (* Spawn the dot process *) graph.dot_subproc <- Some (spawn_dot graph status done_cb) ; (* immediately return an (incomplete) value *) graph let get_layout = function | { layout = Some l } -> l | { layout = None } -> raise Not_yet let abort_layout = function | { dot_subproc = None } -> () | { dot_subproc = Some proc } as g -> Subprocess.abort proc ; g.dot_subproc <- None let get_query { query = q } = q let get_ids { agraph = g } = NodeMap.fold (fun id _ acc -> id :: acc) g.nodes [] let mem { agraph = g } id = NodeMap.mem id g.nodes let sort_nodes lr nl = List.sort (if lr then (fun (_, n1) (_, n2) -> compare n2.n_y n1.n_y) else (fun (_, n1) (_, n2) -> compare n1.n_x n2.n_x)) nl let get_related_ids g rel id = List.fold_left (fun acc -> function | (id, r) when r == rel -> id :: acc | _ -> acc) [] (NodeMap.find id g.agraph.nodes).family let get_ancestors g id = get_related_ids g PARENT id let get_cnode_and_sort g ids = let layout_n = (get_layout g).c_nodes in sort_nodes g.layout_params.lr_layout (List.map (fun id -> id, NodeMap.find id layout_n) ids) let get_related g rel id = get_cnode_and_sort g begin match rel with | `PARENT -> get_related_ids g PARENT id | `CHILD -> get_related_ids g CHILD id | `SIBLINGS -> list_uniq (List.concat (List.map (get_related_ids g CHILD) (get_related_ids g PARENT id))) end let get_node g id = let n = NodeMap.find id (get_layout g).c_nodes in id, n (* keyboard nav *) let get_parents g id = get_related g `PARENT id let get_children g id = get_related g `CHILD id let get_siblings g id = get_related g `SIBLINGS id monotone-viz-1.0.2.orig/agraph.mli0000644000000000000000000000164110573632162013757 0ustar open Viz_types type layout = Viz_types.cgraph type layout_params = { box_w : float ; box_h : float ; char_width : float ; lr_layout : bool ; dot_program : string ; } type t type done_cb = [`LAYOUT_DONE | `LAYOUT_ERROR of string] -> unit val make : agraph -> query -> layout_params -> unit; pop : unit -> unit; ..> -> done_cb -> t (* spawn dot *) exception Not_yet val get_layout : t -> layout val abort_layout : t -> unit val get_query : t -> query val get_ids : t -> string list val mem : t -> string -> bool val get_ancestors : t -> string -> string list val get_node : t -> string -> string * c_node (* query window *) val get_parents : t -> string -> (string * c_node) list (* keyboard nav *) val get_children : t -> string -> (string * c_node) list (* keyboard nav *) val get_siblings : t -> string -> (string * c_node) list (* keyboard nav *) monotone-viz-1.0.2.orig/unidiff.ml0000644000000000000000000001570710573632162014000 0ustar open Viz_misc (** returns a list of [(num, start, stop)] triplets with the line number, start and end position of each line. *) let lines_coords text = let len = String.length text in let last = ref 0 in let num = ref 0 in let l = ref Q.empty in for i = 0 to len - 1 do if text.[i] = '\n' then begin l := Q.push !l (!num, !last, i - !last) ; last := i + 1 ; incr num end done ; Q.to_list (Q.push !l (!num, !last, len - !last)) type tag_data = HEADER of int | HUNK of int | ADDITION of int | REMOVAL of int | FILE of string * int let is_prefix p t offset = Viz_misc.string_is_prefix p ~offset t (** parse diff data and detect hunk headers, modified text, etc. @return [(start, tag_data list)] with start is the line number of the first hunk. *) let analyze_diff_output text = let coords = lines_coords text in let rec skip_junk = function | (n, s1, _) :: ((_, s2, _) :: _ as tl) as l -> if is_prefix "---" text s1 && is_prefix "+++" text s2 then (n, l) else skip_junk tl | _ -> raise Not_found in let (start, rest) = skip_junk coords in (start, Q.list_fold (fun q (n, s, len) -> if is_prefix "--- " text s then begin let filename = let s = String.sub text (s + 4) (len - 4) in try String.sub s 0 (String.rindex s '\t') with Not_found -> s in Q.push_list q [ HEADER n ; FILE (filename, n) ] end else if is_prefix "+++ " text s then Q.push q (HEADER n) else if is_prefix "@@ " text s then Q.push q (HUNK n) else if is_prefix "-" text s then Q.push q (REMOVAL n) else if is_prefix "+" text s then Q.push q (ADDITION n) else q) rest) let make_combo_box coords ~packing = let files = List.fold_right (fun arg acc -> match arg with | FILE (f, _) -> f :: acc | _ -> acc) coords [] in let box = GPack.hbox ~packing () in let (cb, _) as text_combo = GEdit.combo_box_text ~strings:("All files" :: files) ~packing:box#pack () in cb#set_active 0 ; text_combo let rec find_line_num i = function | FILE (_, n) :: _ when i = 0 -> n | FILE _ :: tl -> find_line_num (i - 1) tl | _ :: tl -> find_line_num i tl | [] -> raise Not_found let save_dialog parent text = let s = GWindow.file_chooser_dialog ~action:`SAVE ~parent ~destroy_with_parent:true ~icon:(Lazy.force Icon.monotone) ~title:"Save monotone diff output" () in s#add_button_stock `CANCEL `CANCEL ; s#add_select_button_stock `SAVE `SAVE ; s#set_default_response `SAVE ; ignore (s#connect#after#close s#misc#hide) ; ignore (s#connect#response (function | `CANCEL | `DELETE_EVENT -> s#misc#hide () | `SAVE -> let f = some s#filename in s#misc#hide () ; try 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)) ; s let view_diff ctrl (junk_end, tags_coords) text orig_text = let window = GWindow.dialog ~no_separator:true ~title:"Monotone diff output" ~screen:ctrl#get_toplevel#screen ~type_hint:`NORMAL () in window#add_button_stock `SAVE `SAVE ; window#add_button_stock `CLOSE `CLOSE ; window#set_default_response `CLOSE ; let s = lazy (save_dialog window orig_text) in ignore (window#connect#after#close window#destroy) ; ignore (window#connect#response (function | `CLOSE | `DELETE_EVENT -> window#destroy () | `SAVE -> (Lazy.force s)#present () )) ; let buffer = GText.buffer ~text () in begin let junk_tag = buffer#create_tag ~name:"junk" [ `FOREGROUND "dark blue" ] in let header_tag = buffer#create_tag ~name:"header" [ `FOREGROUND "white" ; `BACKGROUND "dark gray" ] in let hunk_tag = buffer#create_tag ~name:"hunk" [ `BACKGROUND "#F0F090" ] in let modif_tag = buffer#create_tag ~name:"modif" [ `FOREGROUND "red" ; `WEIGHT `BOLD ] in buffer#apply_tag junk_tag ~start:buffer#start_iter ~stop:(buffer#get_iter (`LINE junk_end)) ; let apply_tag_on_line n tag = let start = buffer#get_iter (`LINE n) in buffer#apply_tag tag ~start ~stop:start#forward_to_line_end in List.iter (function | HEADER n -> apply_tag_on_line n header_tag | HUNK n -> apply_tag_on_line n hunk_tag | ADDITION n | REMOVAL n -> apply_tag_on_line n modif_tag | FILE _ -> ()) tags_coords end ; let vbox = window#vbox in let ((cb, _) : _ GEdit.text_combo) = make_combo_box tags_coords vbox#pack in let sw = GBin.scrolled_window ~packing:(vbox#pack ~expand:true) () in let v = GText.view ~buffer ~cursor_visible:false ~editable:false ~width:675 ~height:300 ~packing:sw#add () in v#misc#modify_font_by_name "Monospace" ; v#misc#grab_focus () ; ignore (cb#connect#changed (fun () -> let act = cb#active in if act = 0 then ignore (v#scroll_to_iter ~use_align:true ~xalign:0. ~yalign:0. buffer#start_iter) else if act > 0 then let n = find_line_num (act - 1) tags_coords in ignore (v#scroll_to_iter ~use_align:true ~xalign:0. ~yalign:0. (buffer#get_iter (`LINE n))) )) ; window#misc#show () let replacement_char = '\x7f' (* DEL *) let careful_convert_ascii o = let s = String.copy o in for i = 0 to String.length s - 1 do if int_of_char s.[i] >= 0x80 then s.[i] <- replacement_char done ; s let careful_convert_utf8 o = let s = String.copy o in let len = String.length s in let pos = ref 0 in while !pos < len do let prev_pos = !pos in try ignore (Glib.Utf8.to_unichar_validated s ~pos) with | Glib.Convert.Error (Glib.Convert.ILLEGAL_SEQUENCE, _) -> pos := prev_pos ; s.[!pos] <- replacement_char ; incr pos | Glib.Convert.Error (Glib.Convert.PARTIAL_INPUT, _) -> String.fill s prev_pos (len - prev_pos) replacement_char ; pos := len done ; s let utf8ize = let (is_utf8, _) = Glib.Convert.get_charset () in if not is_utf8 then fun s -> try Glib.Convert.locale_to_utf8 s with Glib.Convert.Error _ -> careful_convert_ascii s else fun s -> if Glib.Utf8.validate s then s else careful_convert_utf8 s let view ctrl text = try let display_text = utf8ize text in view_diff ctrl (analyze_diff_output display_text) display_text text with Not_found -> let d = GWindow.message_dialog ~message:"No changes" ~message_type:`INFO ~buttons:GWindow.Buttons.close ~parent:ctrl#get_toplevel ~destroy_with_parent:true ~title:"Monotone diff output" () in ignore (d#connect#close d#misc#hide) ; ignore (d#connect#response (fun _ -> d#misc#hide ())) ; d#show () let show ctrl old_id new_id = match ctrl#get_mtn with | None -> () | Some mtn -> try Monotone.run_monotone_diff mtn (ctrl#status "monotone") (fun res -> match res with | `OUTPUT d -> view ctrl d | `SUB_PROC_ERROR msg -> ctrl#error_notice msg) (old_id, new_id) with Viz_types.Error msg -> ctrl#error_notice msg monotone-viz-1.0.2.orig/unidiff.mli0000644000000000000000000000005610573632162014140 0ustar val show : #App.t -> string -> string -> unit monotone-viz-1.0.2.orig/gnomecanvas_hack.c0000644000000000000000000000524210573632162015446 0ustar #include #include #ifdef G_OS_UNIX #include #include static GObjectSetPropertyFunc orig_gnome_canvas_text_set_property; static void my_gnome_canvas_text_set_property (GObject *object, guint param_id, const GValue *value, GParamSpec *pspec) { static const char fmap_key[] = "monotone-viz-PangoFT2FontMap"; GnomeCanvasItem *item; GnomeCanvasText *text; PangoFontMap *fmap; item = GNOME_CANVAS_ITEM (object); text = GNOME_CANVAS_TEXT (object); if (!text->layout && item->canvas->aa) { PangoLanguage *language; PangoContext *gtk_context, *context; fmap = g_object_get_data (G_OBJECT (item->canvas), fmap_key); if (fmap == NULL) { GtkWidget *c_w; GdkScreen *screen; gint pixels, mm; double dpi_x, dpi_y; c_w = GTK_WIDGET (item->canvas); screen = gtk_widget_has_screen (c_w) ? gtk_widget_get_screen (c_w) : gdk_screen_get_default(); pixels = gdk_screen_get_width (screen); mm = gdk_screen_get_width_mm (screen); dpi_x = (((double) pixels * 25.4) / (double) mm); pixels = gdk_screen_get_height (screen); mm = gdk_screen_get_height_mm (screen); dpi_y = (((double) pixels * 25.4) / (double) mm); fmap = pango_ft2_font_map_new (); pango_ft2_font_map_set_resolution (PANGO_FT2_FONT_MAP (fmap), dpi_x, dpi_y); g_object_set_data_full (G_OBJECT (item->canvas), fmap_key, fmap, g_object_unref); } gtk_context = gtk_widget_get_pango_context (GTK_WIDGET (item->canvas)); context = pango_ft2_font_map_create_context (PANGO_FT2_FONT_MAP (fmap)); language = pango_context_get_language (gtk_context); pango_context_set_language (context, language); pango_context_set_base_dir (context, pango_context_get_base_dir (gtk_context)); pango_context_set_font_description (context, pango_context_get_font_description (gtk_context)); text->layout = pango_layout_new (context); g_object_unref (G_OBJECT (context)); } return orig_gnome_canvas_text_set_property (object, param_id, value, pspec); } CAMLprim value ml_fix_libgnomecanvas_pango (value text_obj) { static GnomeCanvasTextClass *ct_class; GObjectClass *go_class; if (ct_class) return Val_unit; ct_class = g_type_class_ref (GNOME_TYPE_CANVAS_TEXT); go_class = G_OBJECT_CLASS (ct_class); orig_gnome_canvas_text_set_property = go_class->set_property; go_class->set_property = my_gnome_canvas_text_set_property; return Val_unit; } #else CAMLprim value ml_fix_libgnomecanvas_pango (value text_obj) { return Val_unit; } #endif monotone-viz-1.0.2.orig/view.ml0000644000000000000000000012441410616155674013330 0ustar open Viz_misc open Viz_types open Revision open Ui let ( ++ ) x f = f x module Info_Display = struct type t = { revision_label : GMisc.label ; empty_label : string ; revision_c_type : GtkStock.id GTree.column ; revision_c_file : string GTree.column ; revision_model : GTree.tree_store ; revision_view : GTree.view ; cert_c_name : string GTree.column ; cert_c_value : string GTree.column ; cert_c_signer : string GTree.column ; cert_c_sig : sig_verif GTree.column ; cert_model : GTree.list_store ; cert_view : GTree.view ; mutable current_row : Gtk.tree_path option ; } let sig_verif_conv = let warning = GtkStock.convert_id `DIALOG_WARNING in let error = GtkStock.convert_id `DIALOG_ERROR in { Gobject.kind = `STRING ; Gobject.proj = (fun _ -> assert false) ; Gobject.inj = (function | SIG_OK -> `STRING None | SIG_UNKNOWN -> `STRING (Some warning) | SIG_BAD -> `STRING (Some error) ) } let initial_height = 175 let proper_id_select label ev = if GdkEvent.Button.button ev = 1 && GdkEvent.get_type ev = `TWO_BUTTON_PRESS then begin let txt = label#text in let nl = try String.index txt '\n' with Not_found -> 0 in if string_is_prefix "Revision: " txt && string_is_prefix "Manifest: " ~offset:(nl+1) txt then begin if label#cursor_position <= nl then label#select_region 10 nl else label#select_region (nl + 1 + 10) (-1) ; true end else false end else false let make ~packing = let pane = GPack.paned `HORIZONTAL ~packing () in let box = GPack.vbox ~spacing:4 ~height:initial_height ~packing:(pane#pack1 ~resize:true ~shrink:true) () in let label = GMisc.label ~xalign:0. ~packing:box#pack () in label#set_use_markup true ; label#set_selectable true ; let empty_label = Printf.sprintf "%50s" " " in label#set_label empty_label ; ignore (GtkSignal.connect ~sgn:GtkBase.Widget.Signals.Event.button_press ~callback:(proper_id_select label) label#as_widget) ; let rev_columns = new GTree.column_list in let c_type = rev_columns#add GtkStock.conv in let c_file = rev_columns#add Gobject.Data.string in let revision_model = GTree.tree_store rev_columns in let revision_view = let view = GTree.view ~width:250 ~height:initial_height ~model:revision_model ~headers_visible:false ~packing:(wrap_in_scroll_window (pane#pack2 ~shrink:true)) () in let column = GTree.view_column () in let r = GTree.cell_renderer_pixbuf [ `STOCK_SIZE `MENU ] in column#pack r ; column#add_attribute r "stock-id" c_type ; ignore (view#append_column column) ; let column = GTree.view_column () in let r = GTree.cell_renderer_text [] in column#pack r ; column#add_attribute r "text" c_file ; ignore (view#append_column column) ; view#set_expander_column (Some column) ; view in let cert_columns = new GTree.column_list in let c_name = cert_columns#add Gobject.Data.string in let c_value = cert_columns#add Gobject.Data.string in let c_signer = cert_columns#add Gobject.Data.string in let c_sig = cert_columns#add sig_verif_conv in let cert_model = GTree.list_store cert_columns in cert_model#set_sort_func 0 (fun model row_a row_b -> let a = model#get ~row:row_a ~column:c_name in let b = model#get ~row:row_b ~column:c_name in let c_a = a = "Changelog:" in let c_b = b = "Changelog:" in if c_a && c_b then 0 else if c_a then 1 else if c_b then -1 else compare a b) ; cert_model#set_sort_column_id 0 `ASCENDING ; let cert_view = let view = GTree.view ~packing:(wrap_in_scroll_window (box#pack ~expand:true)) () in begin let column = GTree.view_column ~title:"S" () in let r = GTree.cell_renderer_pixbuf [ `STOCK_SIZE `MENU ; `YALIGN 0. ] in column#pack r ; column#add_attribute r "stock-id" c_sig ; ignore (view#append_column column) end ; begin let column = GTree.view_column ~title:"Cert Name" () in let r = GTree.cell_renderer_text [ `WEIGHT `BOLD ; `XALIGN 1.; `YALIGN 0. ] in column#pack r ; column#add_attribute r "markup" c_name ; ignore (view#append_column column) end ; begin let column = GTree.view_column ~title:"Cert Value" () in let r = GTree.cell_renderer_text [] in column#pack r ; column#add_attribute r "text" c_value ; column#set_resizable true ; ignore (view#append_column column) end ; begin let column = GTree.view_column ~title:"Signed by" () in let r = GTree.cell_renderer_text [ `YALIGN 0. ] in column#pack r ; column#add_attribute r "text" c_signer ; column#set_resizable true ; ignore (view#append_column column) end ; view in { revision_label = label ; empty_label = empty_label ; revision_c_type = c_type ; revision_c_file = c_file ; revision_model = revision_model ; revision_view = revision_view ; cert_c_name = c_name ; cert_c_value = c_value ; cert_c_signer = c_signer ; cert_c_sig = c_sig ; cert_model = cert_model ; cert_view = cert_view ; current_row = None ; } let setup info ctrl = (* setup the signal for the popup menu *) ignore (info.cert_view#event#connect#button_press (fun ev -> let button = GdkEvent.Button.button ev in if button = 3 then begin begin let x = int_of_float (GdkEvent.Button.x ev) in let y = int_of_float (GdkEvent.Button.y ev) in match info.cert_view#get_path_at_pos ~x ~y with | Some (path, _, _, _) -> info.current_row <- Some path | None -> info.current_row <- None end ; ctrl#cert_popup button end ; false)) let clear i = i.current_row <- None ; i.revision_label#set_label i.empty_label ; i.revision_model#clear () ; i.cert_model#clear () let stock_of_delta_type = function | PATCH _ -> None | ADD_FILE _ | ADD_DIR _ -> Some `ADD | DELETE _ -> Some `REMOVE | RENAME _ -> Some `CONVERT | ATTR_SET _ -> Some `PROPERTIES | ATTR_CLEAR _ -> Some `CLEAR let text_of_delta_type = function | PATCH (f, "", _) | PATCH (f, _, "") -> "" | PATCH (f, _, _) | ADD_FILE (f, _) | DELETE f -> f | ADD_DIR f -> f ^ "/" | RENAME (o, n) -> Printf.sprintf "%s -> %s" o n | ATTR_CLEAR (attr, f) | ATTR_SET (attr, f, _) -> Printf.sprintf "%s on %s" attr f let display_info i data = (* Set the revision id and manifest id labels *) i.revision_label#set_label (Printf.sprintf "Revision: %s\nManifest: %s" data.revision_id data.manifest_id) ; (* Fill the revision set view *) begin i.revision_view#set_model None ; let m = i.revision_model in m#clear () ; List.iter (fun (old_revision, change_set) -> let parent as row = m#append () in m#set ~row ~column:i.revision_c_file ("on " ^ old_revision) ; List.iter (fun change -> let text = text_of_delta_type change in (* monotone uses UTF-8 internaly *) if valid_utf8 text && text <> "" then let row = m#append ~parent () in may (m#set ~row ~column:i.revision_c_type) (stock_of_delta_type change) ; m#set ~row ~column:i.revision_c_file text) change_set) data.revision_set ; i.revision_view#set_model (Some i.revision_model#coerce) ; i.revision_view#expand_all () end ; (* Fill the certs view *) begin i.cert_view#set_model None ; let m = i.cert_model in m#clear () ; List.iter (fun c -> let row = m#append () in let c_disp = String.capitalize c.c_name ^ ":" in m#set ~row ~column:i.cert_c_name c_disp ; (* cert values are either binary or valid utf8 *) let c_value_disp = if valid_utf8 c.c_value then c.c_value else "" in m#set ~row ~column:i.cert_c_value c_value_disp ; m#set ~row ~column:i.cert_c_signer c.c_signer_id ; m#set ~row ~column:i.cert_c_sig c.c_signature) data.certs ; i.cert_view#set_model (Some i.cert_model#coerce) end let failed_node_data = { revision_id = "???" ; manifest_id = "???" ; revision_set = [] ; certs = [] ; } let filter_certs ignored_certs data = { data with certs = List.filter (fun c -> not (List.mem c.c_name ignored_certs)) data.certs } let fetch_and_display_data info ctrl id = match ctrl#get_mtn with | None -> () | Some mtn -> let data = try Monotone.get_certs_and_revision mtn id with | Viz_types.Error msg -> ctrl#error_notice msg ; failed_node_data in display_info info (filter_certs ctrl#get_prefs.Viz_style.ignored_certs data) let get_current_cert_value info = maybe (fun path -> info.cert_model#get ~row:(info.cert_model#get_iter path) ~column:info.cert_c_value) info.current_row end module Complete = struct let is_date = let re = Str.regexp "[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]" in fun id -> Str.string_partial_match re id 0 let several_completions parent (t, ids) = let txt = Buffer.create 128 in Printf.bprintf txt "Several possible completions for %s :\n\n" (Glib.Markup.escape_text t) ; List.iter (fun id -> Printf.bprintf txt " %s\n" id) ids ; Printf.bprintf txt "" ; let m = GWindow.message_dialog ~message:(Buffer.contents txt) ~use_markup:true ~message_type:`INFO ~buttons:GWindow.Buttons.close ~parent ~destroy_with_parent:true ~title:"Monotone-viz - Date completion" () in ignore (m#connect#response (fun _ -> m#destroy ())) ; m#show () exception None_ exception Many of (string * string list) let complete_date ctrl domain t = if is_date t then t else match ctrl#get_mtn with | None -> raise None_ | Some mtn -> match Monotone.select mtn t with | [] -> raise None_ | [ id ] -> begin match Monotone.cert_value mtn id "date" with | t :: _ -> t | [] -> raise None_ end | ids -> raise (Many (t, ids)) end module Branch_selector = struct type t = { store : GTree.tree_store ; branch_column : string GTree.column ; count_column : int GTree.column ; in_view_column : bool GTree.column ; vis_column : bool GTree.column ; w : [`CANCEL|`DELETE_EVENT|`VIEW] GWindow.dialog ; view : GTree.view ; select_buttons : GButton.button * GButton.button ; toggle_renderer : GTree.cell_renderer_toggle ; radio_buttons : GButton.radio_button array ; entries : GEdit.entry array ; propagate_checkb : GButton.toggle_button ; mutable selected_b : int ; mutable limit_kind : int ; } let make parent = (* The model containing branch names *) let cl = new GTree.column_list in let branch_column = cl#add Gobject.Data.string in let count_column = cl#add Gobject.Data.int in let in_view_column = cl#add Gobject.Data.boolean in let vis_column = cl#add Gobject.Data.boolean in let model = GTree.tree_store cl in (* The dialog, created now, only shown when one presses the button *) let w = GWindow.dialog ~parent ~destroy_with_parent:true ~border_width:8 ~no_separator:true ~title:"Ancestry graph view specification" () in w#add_button_stock `CANCEL `CANCEL ; w#add_button_stock (`STOCK "mviz-view") `VIEW ; w#set_response_sensitive `VIEW false ; let packing = w#vbox#pack in (* The treeview of branches *) let view, select_buttons = let packing = Ui.category "Branches" (packing ~expand:true) in let select_buttons = let al = GBin.alignment ~xalign:1. ~xscale:0.333 ~packing () in let hb = GPack.hbox ~homogeneous:true ~packing:al#add () in let add_button label = GButton.button ~packing:(hb#pack ~from:`END) ~label () in let b1 = add_button "select none" in let b2 = add_button "select all" in (b1, b2) in let view = GTree.view ~model ~height:200 ~packing:(Ui.wrap_in_scroll_window (packing ~expand:true)) () in view, select_buttons in view#selection#set_mode `NONE ; let toggle_renderer = let vc = GTree.view_column ~title:"view" () in let r = GTree.cell_renderer_toggle [] in vc#pack r ; vc#add_attribute r "active" in_view_column ; vc#add_attribute r "visible" vis_column ; ignore (view#append_column vc) ; r in begin let vc = GTree.view_column ~title:"Branch" () in let r = GTree.cell_renderer_text [] in vc#pack r ; vc#add_attribute r "text" branch_column ; ignore (view#append_column vc) ; view#set_expander_column (Some vc) end ; begin let vc = GTree.view_column ~title:"Count" () in let r = GTree.cell_renderer_text [`XALIGN 1.] in vc#pack r ; vc#add_attribute r "text" count_column ; vc#add_attribute r "visible" vis_column ; ignore (view#append_column vc) end ; (* The radio buttons for the date limit *) let b1, b2, entry_from, entry_to = let packing = Ui.category "Date limit" packing in let tooltips = GData.tooltips () in let date_entry_tooltip_text = "Specify a date (YYYY-MM-DD), a tag or a revision id" in let tbl = GPack.table ~columns:2 ~rows:3 ~row_spacings:2 ~col_spacings:4 ~packing () in let b1 = let packing = tbl#attach ~left:0 ~top:0 in GButton.radio_button ~label:"_No limit" ~use_mnemonic:true ~active:true ~packing () in let group = b1#group in let button = GButton.radio_button ~group ~label:"_Interval limit" ~use_mnemonic:true ~packing:(tbl#attach ~left:0 ~top:1) () in let hb = GPack.hbox ~packing:(tbl#attach ~left:1 ~top:1 ~expand:`X) () in let packing = hb#pack ~padding:4 in ignore (button#connect#toggled (fun () -> hb#misc#set_sensitive button#active)) ; hb#misc#set_sensitive false ; Ui.add_label "from " packing ; let e1 = GEdit.entry ~packing () in tooltips#set_tip ~text:date_entry_tooltip_text e1#coerce ; Ui.add_label " to " packing ; let e2 = GEdit.entry ~packing ~activates_default:true () in tooltips#set_tip ~text:date_entry_tooltip_text e2#coerce ; ignore (e1#connect#activate (fun () -> e2#misc#grab_focus ())) ; (b1, button, e1, e2) in (* The check button to select all propagate nodes or not *) let checkb = let packing = Ui.category "Options" packing in GButton.check_button ~label:"Display all propagate nodes" ~active:false ~packing () in { store = model ; branch_column = branch_column ; count_column = count_column ; in_view_column = in_view_column ; vis_column = vis_column ; view = view ; select_buttons = select_buttons ; toggle_renderer = toggle_renderer ; w = w ; radio_buttons = [| b1 ; b2 |] ; entries = [| entry_from ; entry_to |] ; propagate_checkb = checkb ; selected_b = 0 ; limit_kind = 0 } let expand_rows s = (* expand some rows a bit *) let rec loop depth parent = if depth <= 2 then begin let n = s.store#iter_n_children parent in for i = 0 to n - 1 do let child = s.store#iter_children ~nth:i parent in let path = s.store#get_path child in s.view#expand_row path ; loop (depth + 1) (Some child) done end in loop 0 None ; s.store#foreach (fun path row -> let v = s.store#get ~row ~column:s.in_view_column in if v then Viz_gmisc.tree_view_expand_to_path (Gobject.try_cast s.view#as_widget s.view#misc#get_type) path ; false) let scroll s = (* make sure that a selected row is visible *) match let v_path = ref None in s.store#foreach (fun path row -> let v = s.store#get ~row ~column:s.in_view_column in if v then v_path := Some path ; v) ; !v_path with | None -> () | Some path -> s.view#scroll_to_cell path (s.view#get_column 0) let get_query_domain s = let acc = ref [] in s.store#foreach (fun path row -> let v = s.store#get ~row ~column:s.in_view_column in if v then begin let b = s.store#get ~row ~column:s.branch_column in acc := b :: !acc end ; false) ; !acc let make_query_limit_interval ctrl domain s_from s_to = let t_from = Complete.complete_date ctrl domain s_from in let t_to = Complete.complete_date ctrl domain s_to in if t_from = "" && t_to = "" then QUERY_NO_LIMIT else QUERY_BETWEEN (t_from, t_to) let make_query ctrl ?id s = try let query_domain = get_query_domain s in let query_limit = match s.limit_kind with | 0 -> QUERY_NO_LIMIT | _ -> make_query_limit_interval ctrl query_domain s.entries.(0)#text s.entries.(1)#text in let query_propagate = s.propagate_checkb#active in Some { query = { dom = query_domain ; lim = query_limit ; all_propagates = query_propagate }; preselect = id } with | Complete.None_ -> None | Complete.Many compl -> Complete.several_completions s.w compl ; None let adjust_view_button_sensitivity s = s.w#set_response_sensitive `VIEW (s.selected_b > 0) let setup s ctrl = Array.iteri (fun i (b : GButton.radio_button) -> ignore (b#connect#toggled (fun () -> if b#active then s.limit_kind <- i))) s.radio_buttons ; begin let sel_none_b, sel_all_b = s.select_buttons in ignore (sel_none_b#connect#clicked (fun () -> s.selected_b <- 0 ; s.store#foreach (fun path row -> s.store#set ~row ~column:s.in_view_column false ; false) ; adjust_view_button_sensitivity s)) ; ignore (sel_all_b#connect#clicked (fun () -> let nb_b = ref 0 in s.store#foreach (fun path row -> s.store#set ~row ~column:s.in_view_column true ; incr nb_b ; false) ; s.selected_b <- !nb_b ; adjust_view_button_sensitivity s)) ; end ; ignore (s.toggle_renderer#connect#toggled (fun path -> let column = s.in_view_column in let row = s.store#get_iter path in let v = s.store#get ~row ~column in if v then s.selected_b <- s.selected_b - 1 else s.selected_b <- s.selected_b + 1 ; s.store#set ~row ~column (not v) ; if s.selected_b <= 1 then adjust_view_button_sensitivity s)) ; ignore (s.w#connect#after#close s.w#misc#hide) ; ignore (s.w#event#connect#delete (fun _ -> s.w#misc#hide () ; true)) ; ignore (s.w#connect#response (function | `CANCEL | `DELETE_EVENT -> s.w#misc#hide () | `VIEW -> may (fun q -> s.w#misc#hide () ; ctrl#query q) (make_query ctrl s))) module Trie = struct type 'a t = | N of 'a * 'a t StringMap.t | B of 'a t StringMap.t let empty = B StringMap.empty let rec insert t k v = match k, t with | [], N (_, m) | [], B m -> N (v, m) | h :: tl, B m -> let st = try StringMap.find h m with Not_found -> empty in B (StringMap.add h (insert st tl v) m) | h :: tl, N (x, m) -> let st = try StringMap.find h m with Not_found -> empty in N (x, StringMap.add h (insert st tl v) m) end let at_least_two m = try ignore (StringMap.fold (fun _ _ n -> if n >= 1 then raise Exit ; n + 1) m 0) ; false with Exit -> true let fill_store_from_trie s t = let rec loop kl parent t = let m, parent = match t with | Trie.N ((v, n), m) -> let row = s.store#append ?parent () in s.store#set ~row ~column:s.branch_column v ; s.store#set ~row ~column:s.count_column n ; s.store#set ~row ~column:s.vis_column true ; m, Some row | Trie.B m when kl <> [] && at_least_two m -> let row = s.store#append ?parent () in let v = String.concat "." (List.rev ("" :: kl)) in s.store#set ~row ~column:s.branch_column v ; m, Some row | Trie.B m -> m, parent in StringMap.iter (fun k st -> loop (k :: kl) parent st) m in loop [] None t let tree_of_branches s br = assert (s.store#get_iter_first = None) ; (* branch names are theoretically unstructured but in practice . is used as delimiter. (NDQF) *) List.map (fun ((b, _) as v) -> string_split '.' b, v) br ++ List.fold_left (fun acc (bl, v) -> Trie.insert acc bl v) Trie.empty ++ fill_store_from_trie s let populate = tree_of_branches let clear s = s.w#misc#hide () ; s.store#clear () ; s.selected_b <- 0 ; adjust_view_button_sensitivity s ; s.radio_buttons.(0)#set_active true ; (* should update s.limit_kind *) Array.iter (fun e -> e#set_text "") s.entries type state = Viz_types.query_domain * int * string array let get_state s = let domain = get_query_domain s in let limit_kind = s.limit_kind in let entries_text = Array.map (fun e -> e#text) s.entries in (domain, limit_kind, entries_text) let set_state s ctrl ?id state = s.w#misc#hide () ; let (domain, limit_kind, entries_text) = state in let in_domain v = List.mem v domain in s.selected_b <- 0 ; s.store#foreach (fun path row -> let b = s.store#get ~row ~column:s.branch_column in let v = s.store#get ~row ~column:s.in_view_column in let n = in_domain b in if n <> v then s.store#set ~row ~column:s.in_view_column n ; if n then s.selected_b <- s.selected_b + 1 ; false) ; adjust_view_button_sensitivity s ; s.radio_buttons.(limit_kind)#set_active true ; Array.iteri (fun i e -> e#set_text entries_text.(i)) s.entries ; may ctrl#query (make_query ctrl ?id s) let string_of_date d = let b = String.create 10 in let l = Viz_gmisc.Date.strftime d "%Y-%m-%d" b in assert (l = 10) ; b let two_months_ago () = let d = Viz_gmisc.Date.current_time () in Viz_gmisc.Date.subtract_months d 2 ; string_of_date d let set_branch s ctrl ?id br = s.selected_b <- 0 ; s.store#foreach (fun path row -> let b = s.store#get ~row ~column:s.branch_column in let v = s.store#get ~row ~column:s.in_view_column in let sel = b = br in if v <> sel then s.store#set ~row ~column:s.in_view_column sel ; if sel then s.selected_b <- 1 ; false) ; adjust_view_button_sensitivity s ; begin match id with | None -> s.radio_buttons.(1)#set_active true ; s.entries.(0)#set_text (two_months_ago ()) ; s.entries.(1)#set_text "" | Some id -> match Monotone.cert_value (some ctrl#get_mtn) id "date" with | [] -> s.radio_buttons.(0)#set_active true | d :: _ -> s.radio_buttons.(1)#set_active true ; let p o l = int_of_string (String.sub d o l) in let d = p 8 2 in let m = p 5 2 in let y = p 0 4 in let d_from = let date = Viz_gmisc.Date.make_dmy d m y in Viz_gmisc.Date.subtract_months date 2 ; string_of_date date in let d_to = let date = Viz_gmisc.Date.make_dmy d m y in Viz_gmisc.Date.add_months date 2 ; string_of_date date in s.entries.(0)#set_text d_from ; s.entries.(1)#set_text d_to end ; may ctrl#query (make_query ctrl ?id s) let present_dialog s = expand_rows s ; scroll s ; s.w#set_default_response `VIEW ; s.w#present () end module KeyNav = struct type t = { mutable previous_selected_node : (string * Viz_types.c_node) option ; mutable keyboard_nav_siblings : (string * Viz_types.c_node) list ; } let make () = { previous_selected_node = None ; keyboard_nav_siblings = [] } let top_down_dir = [ GdkKeysyms._Up, `PARENT ; GdkKeysyms._Down, `CHILD ; GdkKeysyms._Left, `PREV ; GdkKeysyms._Right, `NEXT ; GdkKeysyms._BackSpace, `LAST ; ] let left_right_dir = [ GdkKeysyms._Up, `NEXT ; GdkKeysyms._Down, `PREV ; GdkKeysyms._Left, `PARENT ; GdkKeysyms._Right, `CHILD ; GdkKeysyms._BackSpace, `LAST ; ] let nav_dir lr_layout k = try List.assoc (GdkEvent.Key.keyval k) (if lr_layout then left_right_dir else top_down_dir) with Not_found -> `NONE let navigate_is_sibling k id = List.exists (fun (i, _) -> i = id) k.keyboard_nav_siblings let on_same_branch mtn id = let b_target = Monotone.cert_value mtn id "branch" in fun (id, _) -> let b_node = Monotone.cert_value mtn id "branch" in List.exists (fun b -> List.mem b b_target) b_node let navigate_choose k ctrl current_id direction = match k.keyboard_nav_siblings with | [] -> None | [ n ] -> Some n | sx -> let rec locate = function | (id, x) :: ((_, y) as n) :: _ when id = current_id && x != y -> Some n | _ :: tl -> locate tl | [] -> None in match direction with | `NEXT -> locate sx | `PREV -> locate (List.rev sx) | `PARENT | `CHILD -> match List.filter (on_same_branch (some ctrl#get_mtn) current_id) sx with | [] -> Some (List.hd sx) | h :: _ -> Some h let navigate k ctrl key = match ctrl#get_selected_node with | None -> None | Some id -> match nav_dir ctrl#get_prefs.Viz_style.lr_layout key with | `NONE -> None | `LAST -> may (fun (id, _) -> if not (navigate_is_sibling k id) then k.keyboard_nav_siblings <- []) k.previous_selected_node ; k.previous_selected_node | (`NEXT | `PREV) as d when k.keyboard_nav_siblings <> [] -> navigate_choose k ctrl id d | #Viz_types.direction as d -> match ctrl#get_agraph with | None -> None | Some graph -> let cnodes = match d with | `PARENT -> Agraph.get_parents graph id | `CHILD -> Agraph.get_children graph id | `NEXT | `PREV -> Agraph.get_siblings graph id in k.keyboard_nav_siblings <- cnodes ; navigate_choose k ctrl id d let select k id previous_id = k.previous_selected_node <- previous_id ; if not (navigate_is_sibling k id) then k.keyboard_nav_siblings <- [] let clear k = k.previous_selected_node <- None ; k.keyboard_nav_siblings <- [] end let is_neighbor n = match n.c_kind with | NEIGHBOUR_IN | NEIGHBOUR_OUT -> true | _ -> false module Canvas = struct external pango_fix : unit -> unit = "ml_fix_libgnomecanvas_pango" let _ = pango_fix () type t = { canvas : GnoCanvas.canvas ; mutable ppu : float ; mutable branch_items : GnoCanvas.group option ; mutable text_items : GnoCanvas.text list ; selected_marker : GnoCanvas.rect ; mutable background_rendering : Glib.Idle.id option ; mutable drag_active : bool ; mutable selected_node : (string * Viz_types.c_node) option ; keynav : KeyNav.t } let make ~aa ~packing = let sw = GBin.scrolled_window ~width:700 ~height:400 ~packing () in let canvas = GnoCanvas.canvas ~aa ~packing:sw#add () in let selection_rect = GnoCanvas.rect ~fill_color:"tomato" canvas#root in selection_rect#hide () ; { canvas = canvas ; ppu = 1. ; branch_items = None ; text_items = [] ; selected_marker = selection_rect ; background_rendering = None ; drag_active = false ; selected_node = None ; keynav = KeyNav.make () } let dnd_targets = [| { Gtk.target = "text/uri-list" ; Gtk.flags = [] ; Gtk.info = 0 } ; { Gtk.target = "text/plain" ; Gtk.flags = [] ; Gtk.info = 1 } ; |] let file_of_drop_data data = try let f = List.find (fun f -> Viz_misc.string_is_prefix "file://" f) (Str.split (Str.regexp "\r\n") data) in Some (Viz_misc.string_slice ~s:7 f) with Not_found -> None let drag_setup c ctrl = let canvas = c.canvas in canvas#drag#dest_set ~actions:[`COPY] [ dnd_targets.(0) ] ; ignore (canvas#drag#connect#data_received (fun ctx ~x ~y sel ~info ~time -> if info = 0 then (* a file dropped from a file manager *) may (ctrl#open_db ?id:None ?branch:None) (file_of_drop_data sel#data))) ; let setup_drag () = canvas#drag#source_set ~modi:[`BUTTON1] ~actions:[`COPY] [ dnd_targets.(1) ] in setup_drag () ; (* OK, this is a bit complicated: GTK+ supports DnD at the widget level but here I want DnD for a GnomeCanvasItem (a node in the ancestry graph). So the GnomeCanvas is set up as a DragSource. In the button press event handler of the canvas item, the drag_active field is set to true. In a event handler of the canvas widget for button press (connected with after so that it runs after the canvas item ones), I check drag_active: if false, that means the click was outside a node and I call gtk_drag_source_unset(). In the button release handler, I reset drag_active to false and re-setup the canvas as a drag source. *) ignore (canvas#event#connect#after#button_press (fun ev -> if GdkEvent.Button.button ev = 1 && not c.drag_active then canvas#drag#source_unset () ; false)) ; ignore (canvas#event#connect#button_release (fun ev -> if GdkEvent.Button.button ev = 1 then begin if c.drag_active then c.drag_active <- false else setup_drag () end ; false)) ; ignore (canvas#drag#connect#data_get (fun ctx sel_ctx ~info ~time -> match c.selected_node with | Some (id, _) when info = 1 -> sel_ctx#return id | _ -> ())) let setup c ctrl = drag_setup c ctrl ; let clipboard = GData.clipboard Gdk.Atom.primary in ignore (c.canvas#event#connect#button_press (fun ev -> (* Grab the focus when one clicks on the canvas *) c.canvas#misc#grab_focus () ; if GdkEvent.Button.button ev = 2 then may ctrl#find clipboard#text ; false)) let get_string_font_descr ctrl = ctrl#get_prefs.Viz_style.font let get_pango_font_descr ctrl = Pango.Font.from_string (get_string_font_descr ctrl) let get_font_size font = let s = float (Pango.Font.get_size (Pango.Font.from_string font)) /. float Pango.scale in if Viz_misc.debug "font" then Printf.eprintf "### font: '%s' font_size: %f\n%!" font s ; s let get_font_metrics c ctrl = let desc = get_pango_font_descr ctrl in c.canvas#misc#pango_context#get_metrics ~desc () let zoom c ctrl dir () = begin match dir with | `IN -> c.ppu <- c.ppu *. sqrt 2. | `OUT -> c.ppu <- c.ppu /. sqrt 2. end ; c.canvas#set_pixels_per_unit c.ppu ; let font_size = get_font_size (get_string_font_descr ctrl) in if debug "zoom" then Printf.eprintf "### zoom: ppu = %f, font_size = %f\n%!" c.ppu (c.ppu *. font_size) ; let new_size = c.ppu *. font_size in List.iter (fun t -> if new_size >= 3.0 then begin t#set [ `SIZE_POINTS new_size ] ; t#show () end else (* disable label when zooming out a lot: it's unreadable anyway *) t#hide ()) c.text_items let display_selection_marker c ctrl sel = let (id, node_data) = sel in KeyNav.select c.keynav id c.selected_node ; c.selected_node <- Some sel ; let x1 = node_data.n_x -. node_data.n_w /. 2. -. 5. in let y1 = node_data.n_y -. node_data.n_h /. 2. -. 5. in let x2 = node_data.n_x +. node_data.n_w /. 2. +. 5. in let y2 = node_data.n_y +. node_data.n_h /. 2. +. 5. in let marker = c.selected_marker in marker#set [ `X1 x1; `X2 x2; `Y1 y1; `Y2 y2 ] ; marker#lower_to_bottom () ; marker#show () ; ctrl#display_certs id let clear c ctrl = may (fun g -> g#destroy ()) c.branch_items ; c.branch_items <- None ; c.text_items <- [] ; c.selected_marker#hide () ; c.selected_node <- None ; KeyNav.clear c.keynav ; may (fun id -> Glib.Idle.remove id ; c.background_rendering <- None ; (ctrl#status "canvas")#progress_end ()) c.background_rendering let id_width = 8 let id_size c ctrl = let metrics = get_font_metrics c ctrl in let char_width = GPango.to_pixels metrics#approx_char_width in let ascent = GPango.to_pixels metrics#ascent in let descent = GPango.to_pixels metrics#descent in let (w, h, cw) as s = ((id_width + 4) * char_width, (ascent + descent) * 2, char_width) in if Viz_misc.debug "font" then Printf.eprintf "### font: width = %d, height = %d, char_width = %d\n%!" w h cw ; s let scroll view view_width target target_width = let a = target -. target_width /. 2. -. 10. in let b = target +. target_width /. 2. +. 10. in int_of_float begin if a < view then a (* scroll *) else if b < view +. view_width then view (* don't move *) else b -. view_width (* scroll in other direction *) end (* it does not really "center", it just brings the node into the view *) let center_on c ctrl ((_, n) as sel) = let c_x, c_y = c.canvas#w2c ~wx:n.n_x ~wy:n.n_y in let x = let a = c.canvas#hadjustment in scroll a#value a#page_size (float c_x) n.n_w in let y = let a = c.canvas#vadjustment in scroll a#value a#page_size (float c_y) n.n_h in c.canvas#scroll_to ~x ~y ; display_selection_marker c ctrl sel let default_node_props = [ `OUTLINE_COLOR "black" ; `WIDTH_PIXELS 2 ], [ `FILL_COLOR "black" ] let border = 10. let update_graph c ctrl preselect_id = let canvas = c.canvas in let graph = some ctrl#get_agraph in let layout = Agraph.get_layout graph in let mtn = some ctrl#get_mtn in let pr = ctrl#status "canvas" in let prefs = ctrl#get_prefs in let lr_layout = prefs.Viz_style.lr_layout in begin (* setup the canvas coordinates and initial position *) canvas#set_pixels_per_unit c.ppu ; let (x1, y1, x2, y2) = layout.bb in canvas#set_scroll_region ~x1:(x1 -. border) ~y1:(y1 -. border) ~x2:(x2 +. border) ~y2:(y2 +. border) ; if lr_layout then begin (* scroll to the right of the graph (most recent revision) *) let page_size = canvas#vadjustment#page_size in let x = int_of_float x2 in let y = int_of_float ((y1 +. y2 -. page_size) /. 2.) in canvas#scroll_to ~x ~y end else begin (* scroll to the bottom of the graph (most recent revision) *) let page_size = canvas#hadjustment#page_size in let x = int_of_float ((x1 +. x2 -. page_size) /. 2.) in let y = int_of_float y2 in canvas#scroll_to ~x ~y end end ; begin (* work around a bug in libgnomecanvas (?) where the arrows of the scrollbars don't do anything. *) let set_page_incr (adj : GData.adjustment) = adj#set_bounds ~step_incr:(adj#page_increment /. 8.) () in set_page_incr canvas#hadjustment ; set_page_incr canvas#vadjustment end ; let main_group = GnoCanvas.group ~x:0. ~y:0. canvas#root in let edges_group = GnoCanvas.group ~x:0. ~y:0. main_group in let nodes_group = GnoCanvas.group ~x:0. ~y:0. main_group in let font = prefs.Viz_style.font in let font_size = get_font_size font in let match_style = Viz_style.match_style prefs graph mtn in let node_item id node () = let g = GnoCanvas.group ~x:node.n_x ~y:node.n_y nodes_group in let (rect_props, text_props) = match_style id default_node_props in let rect = let x = node.n_w /. 2. in let y = node.n_h /. 2. in let props = if is_neighbor node then `DASH (0., [| 5.; 5. |]) :: rect_props else rect_props in if node.c_kind = MERGE then (* annoyingly, dot outputs circle-shaped nodes with different width and height *) let r = max x y in GnoCanvas.ellipse ~x1:(~-. r) ~y1:(~-. r) ~x2:r ~y2:r ~props g else GnoCanvas.rect ~x1:(~-. x) ~y1:(~-. y) ~x2:x ~y2:y ~props g in if node.c_kind = DISAPPROVE then rect#affine_relative [| 0.5 ; 0.5 ; 0.5 ; -0.5 ; 0. ; 0. |] ; let text = match node.c_kind with | TAGGED t -> t | REGULAR -> String.sub id 0 id_width | _ when is_neighbor node -> String.sub id 0 id_width | _ -> "" in if text <> "" then begin let scaled_font_size = font_size *. c.ppu in let t = GnoCanvas.text ~text ~font ~props:([ `SIZE_POINTS scaled_font_size ] @ text_props) g in if scaled_font_size <= 3. then t#hide () ; c.text_items <- t :: c.text_items end ; ignore (g#connect#event (function | `BUTTON_PRESS b -> begin match GdkEvent.Button.button b with | 1 -> display_selection_marker c ctrl (id, node) ; c.drag_active <- true ; true | 3 -> ctrl#view_popup (id, 3) ; true | _ -> false end | `TWO_BUTTON_PRESS b when is_neighbor node && GdkEvent.Button.button b = 1 -> begin match Monotone.cert_value mtn id "branch" with | other_branch :: _ -> ctrl#switch_branch (other_branch, id) | [] -> () end ; true | _ -> false)) ; pr#progress 1 in let edge_item edge s () = let color = match s.edge_kind with SAME_BRANCH -> "black" | BRANCHING | BRANCHING_NEIGH -> "orange" | DISAPPROVED -> "red" | SPANNING -> "darkgrey" in let bpath = GnomeCanvas.PathDef.new_path () in begin GnomeCanvas.PathDef.moveto bpath s.controlp.(0) s.controlp.(1) ; let i = ref 2 in while !i < Array.length s.controlp do GnomeCanvas.PathDef.curveto bpath s.controlp.(!i ) s.controlp.(!i+1) s.controlp.(!i+2) s.controlp.(!i+3) s.controlp.(!i+4) s.controlp.(!i+5) ; i := !i+6 done ; let last_x = s.controlp.(!i-2) in let last_y = s.controlp.(!i-1) in let vx = (s.endp.(0) -. last_x) /. (2. *. sqrt 3.) in let vy = (s.endp.(1) -. last_y) /. (2. *. sqrt 3.) in GnomeCanvas.PathDef.moveto bpath s.endp.(0) s.endp.(1) ; GnomeCanvas.PathDef.lineto bpath (last_x -. vy) (last_y +. vx) ; GnomeCanvas.PathDef.lineto bpath (last_x +. vy) (last_y -. vx) ; GnomeCanvas.PathDef.closepath bpath end ; ignore (GnoCanvas.bpath ~bpath ~props:[ `OUTLINE_COLOR color ; `FILL_COLOR color ; `WIDTH_PIXELS 2 ] edges_group) ; pr#progress 1 in main_group#grab_focus () ; ignore (main_group#connect#event (function | `KEY_PRESS k when c.selected_node <> None -> may (center_on c ctrl) (KeyNav.navigate c.keynav ctrl k) ; true | _ -> false)) ; c.branch_items <- Some main_group ; let q, count = let presel_node = maybe (Agraph.get_node graph) preselect_id in let enqueue v (q, count) = (v :: q, count + 1) in let acc = ([], 0) in let acc = let prio n = match presel_node with | None when lr_layout -> n.n_x | None -> n.n_y | Some (_, p) when lr_layout -> ~-. (abs_float (n.n_x -. p.n_x)) | Some (_, p) -> ~-. (abs_float (n.n_y -. p.n_y)) in NodeMap.fold (fun id n acc -> enqueue (prio n, node_item id n) acc) layout.c_nodes acc in let q, count = let prio spl = let len = Array.length spl.controlp in match presel_node with | None when lr_layout -> spl.controlp.(len - 2) | None -> spl.controlp.(len - 1) | Some (_, p) when lr_layout -> ~-. (abs_float (spl.controlp.(len - 2) -. p.n_x)) | Some (_, p) -> ~-. (abs_float (spl.controlp.(len - 1) -. p.n_y)) in EdgeMap.fold (fun edge spl acc -> enqueue (prio spl, edge_item edge spl) acc) layout.c_edges acc in let q = List.sort (fun ((p1 : float), _) (p2, _) -> compare p2 p1) q in ref q, count in let id = Glib.Idle.add (fun () -> try for i = 1 to 10 do match !q with | [] -> raise Exit | (_, action) :: tl -> q := tl ; action () done ; true with Exit -> c.background_rendering <- None ; pr#progress_end () ; ctrl#update_end ; false | exn -> Printf.eprintf "Uncaught exception: '%s'\n%!" (Printexc.to_string exn) ; true) in may (fun id -> ignore (Glib.Idle.add (fun () -> ctrl#center_on_by_id id ; false))) preselect_id ; c.background_rendering <- Some id ; pr#progress_start "Drawing ancestry graph ..." count ; ctrl#update_begin end module Find = struct type t = { mutable last_find : string * (string * Viz_types.c_node) list ; find_entry : GEdit.entry ; } let make ~packing = let entry = GEdit.entry ~packing () in begin let tooltips = GData.tooltips () in tooltips#set_tip ~text:"Find a node using a monotone selector" entry#coerce end ; add_label ~text:"Find:" ~packing ; { last_find = "", [] ; find_entry = entry } let setup fb ctrl = ignore (fb.find_entry#connect#activate (fun () -> ctrl#find fb.find_entry#text)) let clear find = find.find_entry#set_text "" ; find.last_find <- "", [] let order lr_layout (_, n1) (_, n2) = if lr_layout then compare n1.n_x n2.n_x else compare n1.n_y n2.n_y let filter_in_agraph ctrl ids = match ctrl#get_agraph with | None -> [] | Some g -> ids ++ List.filter (Agraph.mem g) ++ List.map (Agraph.get_node g) ++ List.sort (order ctrl#get_prefs.Viz_style.lr_layout) let locate find ctrl q = match find.last_find with | (last_q, n :: t) when last_q = q -> find.last_find <- (last_q, t) ; ctrl#center_on n | _ -> let ids = Monotone.select (some ctrl#get_mtn) q in let candidates = filter_in_agraph ctrl ids in match candidates with | [] -> find.last_find <- (q, []) | n :: t -> find.last_find <- (q, t) ; ctrl#center_on n let focus_find_entry find = find.find_entry#misc#grab_focus () end type t = { info : Info_Display.t ; selector : Branch_selector.t ; canvas : Canvas.t ; find : Find.t ; } let make ~aa ~parent ~pack_find_entry ~pack_canvas = (* Branch selection *) let selector = Branch_selector.make parent in let find_box = Find.make ~packing:pack_find_entry in let view_pane = GPack.paned `VERTICAL ~packing:pack_canvas () in (* Canvas *) let canvas = Canvas.make ~aa ~packing:(view_pane#pack1 ~resize:true ~shrink:true) in (* Info pane *) let info_display = Info_Display.make ~packing:(view_pane#pack2 ~shrink:true) in { info = info_display ; selector = selector ; canvas = canvas ; find = find_box } let setup v ctrl = Info_Display.setup v.info ctrl ; Branch_selector.setup v.selector ctrl ; Canvas.setup v.canvas ctrl ; Find.setup v.find ctrl let clear v ctrl = Info_Display.clear v.info ; Canvas.clear v.canvas ctrl ; Find.clear v.find let close_db v ctrl = Branch_selector.clear v.selector let open_db v ctrl = Branch_selector.populate v.selector (Ui.with_grab (fun () -> let mtn = some ctrl#get_mtn in let b = Monotone.branches mtn and c = Monotone.run_monotone_count_branches mtn in List.map (fun b -> b, c b) b)) let update v ctrl id = Canvas.update_graph v.canvas ctrl id let get_selected_node v = maybe fst v.canvas.Canvas.selected_node monotone-viz-1.0.2.orig/view.mli0000644000000000000000000000235110573632162013466 0ustar module Info_Display : sig type t val fetch_and_display_data : t -> #App.t -> string -> unit val get_current_cert_value : t -> string option end module Branch_selector : sig type t type state val get_state : t -> state val set_state : t -> #App.t -> ?id:string -> state -> unit val set_branch : t -> #App.t -> ?id:string -> string -> unit val present_dialog : t -> unit end module Canvas : sig type t val zoom : t -> #App.t -> [< `IN | `OUT ] -> unit -> unit val id_size : t -> #App.t -> int * int * int val center_on : t -> #App.t -> string * Viz_types.c_node -> unit end module Find : sig type t val locate : t -> #App.t -> string -> unit val focus_find_entry : t -> unit end type t = { info : Info_Display.t; selector : Branch_selector.t; canvas : Canvas.t; find : Find.t; } val make : aa:bool -> parent:#GWindow.window_skel -> pack_find_entry:(GObj.widget -> unit) -> pack_canvas:(GObj.widget -> unit) -> t val setup : t -> #App.t -> unit val clear : t -> #App.t -> unit val close_db : t -> #App.t -> unit val open_db : t -> #App.t -> unit val update : t -> #App.t -> string option -> unit val get_selected_node : t -> string option monotone-viz-1.0.2.orig/query.ml0000644000000000000000000001722610573632162013517 0ustar open Viz_misc open Viz_types module Selector = struct let make_selectors g sel = let br = (Agraph.get_query g).dom in List.map (fun b -> Printf.sprintf "b:%s/%s" (Monotone.escape_selector b) sel) br let running_select = ref None let abort () = match !running_select with | Some (mtn, id) -> List.iter (Automate.abort mtn) id ; running_select := None | _ -> () let has_date_limit g = (Agraph.get_query g).lim <> QUERY_NO_LIMIT let filter_present g = function | `IDS ids when has_date_limit g -> `IDS (List.filter (Agraph.mem g) ids) | x -> x let select mtn g sel cont = let ids = Monotone.select_async mtn (fun r -> running_select := None ; cont (filter_present g r)) (make_selectors g sel) in running_select := Some (mtn, ids) end let revision_contains pat = function | [ _, changes ] -> List.exists (function | Revision.PATCH (f, _, _) | Revision.ADD_FILE (f, _) | Revision.ADD_DIR f | Revision.DELETE f | Revision.ATTR_CLEAR (_, f) | Revision.ATTR_SET (_, f, _) -> Gpattern.match_string pat f | Revision.RENAME (f1, f2) -> Gpattern.match_string pat f1 || Gpattern.match_string pat f2) changes | _ -> (* return false for merges *) false let filter_by_revision_content (ctrl : (unit -> 'a) -> 'a; ..>; ..>) mtn revision_content ids = (ctrl#status "search")#with_status "Searching the monotone database ..." (fun () -> let pat = Gpattern.make revision_content in Ui.fold_in_loop (fun acc id -> let r = Monotone.get_revision mtn id in if revision_contains pat r.revision_set then id :: acc else acc) [] ids) let select_by_revision_content ctrl mtn revision_content g = filter_by_revision_content ctrl mtn revision_content (Agraph.get_ids g) let expand_results mtn ids = let fetch_first_cert id = let get_cert = Monotone.cert_value mtn id in fun c -> match get_cert c with | h :: _ -> h | [] -> "" in List.map (fun id -> let date = fetch_first_cert id "date" in let author = fetch_first_cert id "author" in id, date, author) ids let do_query ~selector ~revision_content ctrl results_cb = let no_results () = results_cb (`IDS []) in let results_ids mtn ids = results_cb (`IDS (expand_results mtn ids)) in match ctrl#get_mtn, ctrl#get_agraph with | Some mtn, Some g when selector <> "" -> Selector.select mtn g selector (function | `IDS ids when revision_content <> "" -> results_ids mtn (filter_by_revision_content ctrl mtn revision_content ids) | `IDS ids -> results_ids mtn ids | `SUB_PROC_ERROR _ as err -> results_cb err) | Some mtn, Some g when revision_content <> "" -> results_ids mtn (select_by_revision_content ctrl mtn revision_content g) | _ -> no_results () let category title ?expand (vbox : #GPack.box) = let base_label = Printf.sprintf "%s" (Glib.Markup.escape_text title) in let lab = GMisc.label ~markup:base_label ~xalign:0. ~packing:vbox#pack () in let set_label nb = if nb = 0 then lab#set_label base_label else lab#set_label (Printf.sprintf "%s (%d matches)" base_label nb) in let al = GBin.alignment ~border_width:8 ~packing:(vbox#pack ?expand) () in al#misc#set_property "left-padding" (`INT 16) ; (al#add, set_label) let setup_query_builder vbox = let (packing, _) = category "Query" vbox in let packing = (GPack.vbox ~packing ())#pack in let hbox = GPack.hbox ~packing () in let _ = GMisc.label ~text:"Monotone selector: " ~packing:hbox#pack () in let e_selector = GEdit.entry ~packing:(hbox#pack ~expand:true) () in let hbox = GPack.hbox ~packing () in let _ = GMisc.label ~text:"Revision concerns file: " ~packing:hbox#pack () in let e_revision = GEdit.entry ~packing:(hbox#pack ~expand:true) () in (e_selector, e_revision) type model = { model : GTree.list_store ; col_id : string GTree.column ; col_date : string GTree.column ; col_author : string GTree.column ; } let make_model () = let cols = new GTree.column_list in let col_id = cols#add Gobject.Data.string in let col_date = cols#add Gobject.Data.string in let col_author = cols#add Gobject.Data.string in let store = GTree.list_store cols in store#set_sort_column_id col_date.GTree.index `DESCENDING ; { model = store ; col_id = col_id ; col_date = col_date ; col_author = col_author } let clear_model m = m.model#clear () let setup_results_view vbox = let (packing, set_label) = category "Results" ~expand:true vbox in let { model = model } as m = make_model () in let packing = Ui.wrap_in_scroll_window packing in let v = GTree.view ~model ~packing ~height:100 () in let add_string_renderer ?(props=[]) title col = let vc = GTree.view_column ~title () in let r = GTree.cell_renderer_text props in vc#pack r ; vc#add_attribute r "text" col ; vc#set_sort_column_id col.GTree.index ; ignore (v#append_column vc) in add_string_renderer "Id" ~props:[`FAMILY "Monospace"] m.col_id ; add_string_renderer "Date" m.col_date ; add_string_renderer "Author" m.col_author ; m, v, set_label let update_results m r = clear_model m ; m.model#set_sort_column_id (-2) `DESCENDING ; List.iter (fun (id, date, author) -> let row = m.model#append () in m.model#set ~row ~column:m.col_id id ; m.model#set ~row ~column:m.col_date date ; m.model#set ~row ~column:m.col_author author) r ; m.model#set_sort_column_id m.col_date.GTree.index `DESCENDING type t = { window : [`CLOSE|`CLEAR|`DELETE_EVENT|`QUERY] GWindow.dialog ; id_store : model ; entries : GEdit.entry list ; set_label : int -> unit ; } let make ctrl = let w = GWindow.dialog ~title:"Monotone-viz Query" ~screen:ctrl#get_toplevel#screen ~icon:(Lazy.force Icon.monotone) ~type_hint:`NORMAL ~border_width:8 () in let (e1, e2) = setup_query_builder w#vbox in let (m, rv, set_label) = setup_results_view w#vbox in w#add_button_stock `CLOSE `CLOSE ; w#add_button_stock `CLEAR `CLEAR ; w#add_button_stock (`STOCK "mviz-query") `QUERY ; w#set_default_response `QUERY ; ignore (w#connect#after#close w#misc#hide) ; ignore (w#event#connect#delete (fun _ -> w#misc#hide () ; true)) ; ignore (e1#connect#activate (fun () -> w#response `QUERY)) ; ignore (e2#connect#activate (fun () -> w#response `QUERY)) ; ignore (w#connect#response (function | `CLOSE | `DELETE_EVENT -> w#misc#hide () | `CLEAR -> clear_model m ; set_label 0 | `QUERY -> w#set_response_sensitive `QUERY false ; let busy = Ui.Busy.make w in Ui.Busy.start busy ; do_query ~selector:e1#text ~revision_content:e2#text ctrl (fun r -> begin match r with | `IDS results -> update_results m results ; set_label (List.length results) | `SUB_PROC_ERROR msg -> Ui.error_notice ~parent:w msg end ; Ui.Busy.stop busy ; w#set_response_sensitive `QUERY true))) ; ignore (rv#connect#row_activated (fun path view_col -> let id = let row = m.model#get_iter path in m.model#get ~row ~column:m.col_id in ctrl#center_on_by_id id)) ; { window = w ; id_store = m ; entries = [ e1 ; e2 ] ; set_label = set_label } let clear q = Selector.abort () ; clear_model q.id_store ; q.set_label 0 ; List.iter (fun e -> e#set_text "") q.entries ; q.window#set_response_sensitive `QUERY false let activate q = q.window#set_response_sensitive `QUERY true let show q = q.window#present () monotone-viz-1.0.2.orig/query.mli0000644000000000000000000000015210573632162013656 0ustar type t val make : #App.t -> t val clear : t -> unit val activate : t -> unit val show : t -> unit monotone-viz-1.0.2.orig/app.mli0000644000000000000000000000344210622142706013271 0ustar class type status = object method push : string -> unit method pop : unit -> unit method progress_start : string -> int -> unit method progress : int -> unit method progress_end : unit -> unit method with_status : string -> (unit -> 'a) -> 'a end class type t = object method get_mtn : Monotone.t option method get_agraph : Agraph.t option method get_prefs : Viz_style.prefs method get_toplevel : GWindow.window method set_prefs : Viz_style.prefs -> unit method open_db : ?id:string -> ?branch:string -> string -> unit method close_db : unit -> unit method finalize : unit -> unit method display_certs : string -> unit method focus_find_entry : unit -> unit method get_current_cert_value : string option method reload : unit -> unit method zoom_in : unit -> unit method zoom_out : unit -> unit method re_layout : unit -> unit method redraw : unit -> unit method query : Viz_types.select_info -> unit method get_selected_node : string option method find : string -> unit method switch_branch : string * string -> unit method update_begin : unit method update_end : unit method center_on :string * Viz_types.c_node -> unit method center_on_by_id : string -> unit method view_popup : string * int -> unit method cert_popup : int -> unit method show_open : unit -> unit method show_view : unit -> unit method show_search : unit -> unit method show_prefs : unit -> unit method show_diff : string -> string -> unit method status : string -> status method error_notice : string -> unit end val make : GWindow.window -> aa:bool -> prefs:Viz_style.prefs -> t monotone-viz-1.0.2.orig/app.ml0000644000000000000000000001611010622142715013114 0ustar class type status = object method push : string -> unit method pop : unit -> unit method progress_start : string -> int -> unit method progress : int -> unit method progress_end : unit -> unit method with_status : string -> (unit -> 'a) -> 'a end class type t = object method get_mtn : Monotone.t option method get_agraph : Agraph.t option method get_prefs : Viz_style.prefs method get_toplevel : GWindow.window method set_prefs : Viz_style.prefs -> unit method open_db : ?id:string -> ?branch:string -> string -> unit method close_db : unit -> unit method finalize : unit -> unit method display_certs : string -> unit method focus_find_entry : unit -> unit method get_current_cert_value : string option method reload : unit -> unit method zoom_in : unit -> unit method zoom_out : unit -> unit method re_layout : unit -> unit method redraw : unit -> unit method query : Viz_types.select_info -> unit method get_selected_node : string option method find : string -> unit method switch_branch : string * string -> unit method update_begin : unit method update_end : unit method center_on :string * Viz_types.c_node -> unit method center_on_by_id : string -> unit method view_popup : string * int -> unit method cert_popup : int -> unit method show_open : unit -> unit method show_view : unit -> unit method show_search : unit -> unit method show_prefs : unit -> unit method show_diff : string -> string -> unit method status : string -> status method error_notice : string -> unit end open Viz_misc class ctrl w ~prefs ~manager ~status ~view : t = let busy = Ui.Busy.make w in object (self) val mutable mtn = None val mutable agraph = None val mutable prefs = prefs val mutable query = None val mutable open_d = None method private get_query = match query with | Some q -> q | None -> let q = Query.make self in query <- Some q ; q method private get_open_d = match open_d with | Some d -> d | None -> let d = Ui.Open.make self in open_d <- Some d ; d method get_mtn = mtn method get_agraph = agraph method get_prefs = prefs method get_toplevel = w method set_prefs new_prefs = let old_prefs = prefs in prefs <- new_prefs ; Ui.Prefs.update_prefs self old_prefs new_prefs method open_db ?id ?branch fname = self#close_db () ; let m_mtn = Monotone.make prefs.Viz_style.monotone_path fname in mtn <- Some m_mtn ; View.open_db view self ; Ui.open_db manager self ; match branch with | Some b -> View.Branch_selector.set_branch view.View.selector self ?id b | None -> View.Branch_selector.present_dialog view.View.selector method close_db () = self#clear ; may Monotone.exit mtn ; mtn <- None ; may Agraph.abort_layout agraph ; agraph <- None ; View.close_db view self ; Ui.close_db manager self method finalize () = may Monotone.exit mtn method display_certs id = Ui.Busy.start busy ; View.Info_Display.fetch_and_display_data view.View.info self id ; Ui.Busy.stop busy method focus_find_entry () = View.Find.focus_find_entry view.View.find method get_current_cert_value = View.Info_Display.get_current_cert_value view.View.info method reload () = let s = view.View.selector in let fname = maybe Automate.get_dbfname mtn in let id = self#get_selected_node in let state = View.Branch_selector.get_state s in self#close_db () ; may self#open_db fname ; View.Branch_selector.set_state s self ?id state method zoom_in = View.Canvas.zoom view.View.canvas self `IN method zoom_out = View.Canvas.zoom view.View.canvas self `OUT method re_layout () = may (fun g -> self#query { Viz_types.query = Agraph.get_query g ; Viz_types.preselect = self#get_selected_node }) agraph method private clear = Ui.Busy.stop busy ; View.clear view self ; Ui.clear manager ; may Query.clear query method redraw () = self#clear ; View.update view self None method query query = may Agraph.abort_layout agraph ; agraph <- None ; self#clear ; may (fun mtn -> Ui.Busy.start busy ; let g1 = (self#status "agraph")#with_status "Building ancestry graph" (fun () -> Ui.with_grab (fun () -> Monotone.agraph mtn query.Viz_types.query)) in let g2 = Agraph.make g1 query.Viz_types.query self#layout_params (self#status "dot") (function | `LAYOUT_ERROR msg -> Ui.Busy.stop busy ; self#error_notice msg | `LAYOUT_DONE -> View.update view self query.Viz_types.preselect) in agraph <- Some g2) mtn method private layout_params = let (w, h, cw) = View.Canvas.id_size view.View.canvas self in { Agraph.char_width = float cw ; Agraph.box_w = float w ; Agraph.box_h = float h ; Agraph.lr_layout = prefs.Viz_style.lr_layout ; Agraph.dot_program = prefs.Viz_style.dot_path } method get_selected_node = View.get_selected_node view method find id = View.Find.locate view.View.find self id method switch_branch (branch, id) = View.Branch_selector.set_branch view.View.selector self ~id branch method update_begin = Ui.update_begin manager ; may Query.activate query ; method update_end = Ui.Busy.stop busy method center_on n = View.Canvas.center_on view.View.canvas self n method center_on_by_id id = match agraph with | None -> () | Some g -> self#center_on (Agraph.get_node g id) method view_popup (popup_id, button) = Ui.popup manager self ~popup_id button method cert_popup button = Ui.popup_cert manager button method show_open () = may self#open_db (Ui.Open.show self#get_open_d) method show_view () = View.Branch_selector.present_dialog view.View.selector method show_search () = Query.show self#get_query method show_prefs = Ui.Prefs.show self method show_diff id1 id2 = Unidiff.show self id1 id2 method status = status method error_notice msg = Ui.error_notice ~parent:w msg initializer View.setup view self ; Ui.setup manager self end let make w ~aa ~prefs = let b = GPack.vbox ~packing:w#add () in let manager, menubar, toolbar = Ui.make () in b#pack menubar ; let hb = GPack.hbox ~packing:b#pack () in hb#pack ~expand:true toolbar ; let status = new Ui.status_bar ~packing:(b#pack ~from:`END) in let status = Viz_misc.make_cache status in let view = View.make ~aa ~parent:w ~pack_find_entry:(hb#pack ~from:`END) ~pack_canvas:(b#pack ~expand:true) in new ctrl w ~prefs ~manager ~status ~view monotone-viz-1.0.2.orig/main.ml0000644000000000000000000001033010573632162013263 0ustar open Viz_misc type mtn_options = | MTNopt_none | MTNopt_db of string | MTNopt_branch of string * string | MTNopt_full of string * string * string let find_MTN_dir base = let rec up p = let d = Filename.dirname p in if d = p then raise Not_found ; let m = Filename.concat d base in if Sys.file_exists m then m else up d in if Sys.file_exists base then base else up (Sys.getcwd ()) let find_MTN_dir () = try find_MTN_dir "_MTN" with Not_found -> find_MTN_dir "MT" let parse_MTN_options mtn_file = let stanzas = try with_file_in (fun ic -> Basic_io_lexer.parse (Lexing.from_channel ic)) (mtn_file "options") with Not_found | Sys_error _ -> [] in List.map (fun (k, v) -> k, Basic_io_lexer.string_of_elem v) (List.flatten stanzas) let parse_MTN_revision mtn_file = let format = try with_file_in (fun ic -> int_of_string (input_line ic)) (mtn_file "format") with Sys_error _ -> (* format file does not exist apparently *) 1 in let rev_file = mtn_file "revision" in match format with | 1 -> with_file_in input_line rev_file | 2 -> with_file_in (fun ic -> match Revision.revision_set (Lexing.from_channel ic) with | _, { Revision.old_revision = r } :: _ -> r | _ -> failwith "could not determine revision id from _MTN/revision") rev_file | _ -> failwith "unknown workspace format" let parse_MTN_workspace () = let mtn_file = let mtn_dir = Lazy.lazy_from_fun find_MTN_dir in fun f -> Filename.concat (Lazy.force mtn_dir) f in match parse_MTN_options mtn_file with | [] -> MTNopt_none | options -> match may_assoc "database" options with | None -> MTNopt_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 -> begin try let revision = parse_MTN_revision mtn_file in MTNopt_full (db, branch, revision) with _ -> MTNopt_branch (db, branch) end | _ -> MTNopt_db db with Glib.Convert.Error _ -> MTNopt_none let parse_options args = match args with | [] -> parse_MTN_workspace () | db :: [] | db :: "" :: _ -> MTNopt_db db | db :: branch_raw :: rest -> try let branch = Glib.Convert.locale_to_utf8 branch_raw in match rest with | [] | "" :: _ -> MTNopt_branch (db, branch) | revision :: _ -> MTNopt_full (db, branch, revision) with Glib.Convert.Error _ -> MTNopt_db db let print_version () = Printf.printf "monotone-viz %s (base revision: %s)\n" Version.version Version.revision ; Printf.printf "Copyright (C) 2004-2006 Olivier Andrieu \n" ; exit 0 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" ; "--version", Arg.Unit print_version, "print version number and exit" ; ] in let usg_msg = Printf.sprintf "usage: %s [options] [db [branch [revision]]]" (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)) let exn_handler ctrl = function | exn -> ctrl#error_notice begin match exn with | Viz_types.Error msg -> msg | exn -> Printf.sprintf "Uncaught exception: %s" (Printexc.to_string exn) end let main = let w = GWindow.window ~title:"Monotone-viz" ~icon:(Lazy.force Icon.monotone) () in ignore (w#connect#destroy GMain.quit) ; let (aa, mtn_options) = parse_cli () in let prefs = Viz_style.load () in let ctrl = App.make w ~aa ~prefs in GtkSignal.user_handler := exn_handler ctrl ; ignore (Glib.Idle.add (fun () -> begin try match mtn_options with | MTNopt_none -> ctrl#show_open () | MTNopt_db fname -> ctrl#open_db fname | MTNopt_branch (fname, branch) -> ctrl#open_db ~branch fname | MTNopt_full (fname, branch, id) -> ctrl#open_db ~id ~branch fname with exn -> exn_handler ctrl exn end ; false)) ; w#show () ; GMain.main () ; (* just close the db, without updating the widgets *) ctrl#finalize () monotone-viz-1.0.2.orig/glib/0000755000000000000000000000000011353375135012726 5ustar monotone-viz-1.0.2.orig/glib/gspawn.ml0000644000000000000000000000564110573632162014564 0ustar type error = | FORK (* fork failed due to lack of memory *) | READ (* read or select on pipes failed *) | CHDIR (* changing to working dir failed *) | ACCES (* execv() returned EACCES *) | PERM (* execv() returned EPERM *) | TOOBIG (* execv() returned E2BIG *) | NOEXEC (* execv() returned ENOEXEC *) | NAMETOOLONG (* "" "" ENAMETOOLONG *) | NOENT (* "" "" ENOENT *) | NOMEM (* "" "" ENOMEM *) | NOTDIR (* "" "" ENOTDIR *) | LOOP (* "" "" ELOOP *) | TXTBUSY (* "" "" ETXTBUSY *) | IO (* "" "" EIO *) | NFILE (* "" "" ENFILE *) | MFILE (* "" "" EMFLE *) | INVAL (* "" "" EINVAL *) | ISDIR (* "" "" EISDIR *) | LIBBAD (* "" "" ELIBBAD *) | FAILED (* other fatal failure *) exception Error of error * string external _init : unit -> unit = "ml_g_spawn_init" let init = Callback.register_exception "g_spawn_error" (Error (FAILED, "")) ; _init () type real_spawn_flags = [ `LEAVE_DESCRIPTORS_OPEN | `DO_NOT_REAP_CHILD | `SEARCH_PATH | `STDOUT_TO_DEV_NULL | `STDERR_TO_DEV_NULL | `CHILD_INHERITS_STDIN | `FILE_AND_ARGV_ZERO ] type spawn_flags = [ real_spawn_flags | `PIPE_STDIN | `PIPE_STDOUT | `PIPE_STDERR ] type pid type child = { pid : pid option ; standard_input : int option ; standard_output : int option ; standard_error : int option } external int_of_pid : pid -> int = "ml_int_of_pid" external _async_with_pipes : ?working_directory:string -> ?environment:string list -> ?child_setup:(unit -> unit) -> flags:spawn_flags list -> pipes:int -> string list -> child = "ml_g_spawn_async_with_pipes_bc" "ml_g_spawn_async_with_pipes" let async_with_pipes ?working_directory ?environment ?child_setup ~flags args = let rec conv_flags acc pipes = function | `PIPE_STDIN :: l -> conv_flags acc (pipes lor 0x1) l | `PIPE_STDOUT :: l -> conv_flags acc (pipes lor 0x2) l | `PIPE_STDERR :: l -> conv_flags acc (pipes lor 0x4) l | (#real_spawn_flags as f) :: l -> conv_flags (f :: acc) pipes l | [] -> acc, pipes in let flags, pipes = conv_flags [] 0 flags in _async_with_pipes ?working_directory ?environment ?child_setup ~flags ~pipes args external close_pid : pid -> unit = "ml_g_spawn_close_pid" type status = | EXITSTATUS of int | TERMSIG of int | STOPSIG of int external sync : ?working_directory:string -> ?environment:string list -> ?child_setup:(unit -> unit) -> flags:spawn_flags list -> string list -> status * string * string = "ml_g_spawn_sync" external command_line_sync : string -> status * string * string = "ml_g_spawn_command_line_sync" external command_line_async : string -> unit = "ml_g_spawn_command_line_async" type source_id external add_child_watch : ?prio:int -> pid -> (int -> unit) -> source_id = "ml_g_add_child_watch_full" external remove_watch : source_id -> unit = "ml_g_source_remove" monotone-viz-1.0.2.orig/glib/gspawn.mli0000644000000000000000000000505110573632162014730 0ustar type error = | FORK (** fork failed due to lack of memory *) | READ (** read or select on pipes failed *) | CHDIR (** changing to working dir failed *) | ACCES (** [execv()] returned EACCES *) | PERM (** [execv()] returned EPERM *) | TOOBIG (** [execv()] returned E2BIG *) | NOEXEC (** [execv()] returned ENOEXEC *) | NAMETOOLONG (** [execv()] returned ENAMETOOLONG *) | NOENT (** [execv()] returned ENOENT *) | NOMEM (** [execv()] returned ENOMEM *) | NOTDIR (** [execv()] returned ENOTDIR *) | LOOP (** [execv()] returned ELOOP *) | TXTBUSY (** [execv()] returned ETXTBUSY *) | IO (** [execv()] returned EIO *) | NFILE (** [execv()] returned ENFILE *) | MFILE (** [execv()] returned EMFLE *) | INVAL (** [execv()] returned EINVAL *) | ISDIR (** [execv()] returned EISDIR *) | LIBBAD (** [execv()] returned ELIBBAD *) | FAILED (** other fatal failure *) exception Error of error * string val init : unit type spawn_flags = [ `CHILD_INHERITS_STDIN | `DO_NOT_REAP_CHILD | `FILE_AND_ARGV_ZERO | `LEAVE_DESCRIPTORS_OPEN | `SEARCH_PATH | `STDERR_TO_DEV_NULL | `STDOUT_TO_DEV_NULL | `PIPE_STDIN | `PIPE_STDOUT | `PIPE_STDERR ] type pid external int_of_pid : pid -> int = "ml_int_of_pid" (** @raise Failure on Windows *) type child = { pid : pid option; standard_input : int option; standard_output : int option; standard_error : int option; } val async_with_pipes : ?working_directory:string -> ?environment:string list -> ?child_setup:(unit -> unit) -> flags:spawn_flags list -> string list -> child (** @raise Error if the spawn fails @raise Invalid_argument if some [flags] are incompatible *) type status = | EXITSTATUS of int | TERMSIG of int | STOPSIG of int external sync : ?working_directory:string -> ?environment:string list -> ?child_setup:(unit -> unit) -> flags:spawn_flags list -> string list -> status * string * string = "ml_g_spawn_sync" (** @raise Error if the spawn fails *) external close_pid : pid -> unit = "ml_g_spawn_close_pid" external command_line_sync : string -> status * string * string = "ml_g_spawn_command_line_sync" (** @raise Error if the spawn fails *) external command_line_async : string -> unit = "ml_g_spawn_command_line_async" (** @raise Error if the spawn fails *) type source_id external add_child_watch : ?prio:int -> pid -> (int -> unit) -> source_id = "ml_g_add_child_watch_full" external remove_watch : source_id -> unit = "ml_g_source_remove" monotone-viz-1.0.2.orig/glib/giochannel.ml0000644000000000000000000000503711156432503015366 0ustar type error = | FBIG | INVAL | IO | ISDIR | NOSPC | NXIO | OVERFLOW | PIPE | FAILED exception Error of error * string external _init : unit -> unit = "ml_g_io_channel_init_exn" let init = Callback.register_exception "g_io_channel_error" (Error (FAILED, "")) ; _init () type t external unix_new : int -> t = "_ml_g_io_channel_unix_new" external unix_get_fd : t -> int = "ml_g_io_channel_unix_get_fd" external new_fd : int -> t = "ml_g_io_channel_new_fd" external new_file : string -> string -> t = "ml_g_io_channel_new_file" external read_chars : t -> ?off:int -> ?len:int -> string -> [ `NORMAL of int | `AGAIN | `EOF] = "_ml_g_io_channel_read_chars" external write_chars : t -> ?bytes_written:int ref -> ?off:int -> ?len:int -> string -> [ `NORMAL of int | `AGAIN] = "ml_g_io_channel_write_chars" external flush : t -> [ `NORMAL | `AGAIN] = "ml_g_io_channel_flush" external seek_position : t -> int64 -> [ `CUR | `END | `SET ] -> [ `NORMAL of int | `AGAIN | `EOF] = "ml_g_io_channel_seek_position" external shutdown : t -> bool -> unit = "ml_g_io_channel_shutdown" type condition = [ `ERR | `HUP | `IN | `NVAL | `OUT | `PRI ] type source_id external add_watch : ?prio:int -> t -> condition list -> (condition list -> bool) -> source_id = "_ml_g_io_add_watch" external remove_watch : source_id -> unit = "_ml_g_source_remove" external get_buffer_size : t -> int = "ml_g_io_channel_get_buffer_size" external set_buffer_size : t -> int -> unit = "ml_g_io_channel_set_buffer_size" external get_buffer_condition : t -> [ `IN | `OUT ] list = "ml_g_io_channel_get_buffer_condition" type rw_flags = [ `APPEND | `NONBLOCK ] type ro_flags = [ `IS_READABLE | `IS_SEEKABLE | `IS_WRITEABLE ] external get_flags : t -> [ro_flags | rw_flags] list = "ml_g_io_channel_get_flags" external set_flags : t -> rw_flags list -> unit = "ml_g_io_channel_set_flags" let set_flags_noerr c fl = try set_flags c fl with Error _ -> () external get_line_term : t -> string option = "ml_g_io_channel_get_line_term" external set_line_term : t -> string option -> unit = "ml_g_io_channel_set_line_term" external get_buffered : t -> bool = "ml_g_io_channel_get_buffered" external set_buffered : t -> bool -> unit = "ml_g_io_channel_set_buffered" external get_encoding : t -> string option = "ml_g_io_channel_get_encoding" external set_encoding : t -> string option -> unit = "ml_g_io_channel_set_encoding" external get_close_on_unref : t -> bool = "ml_g_io_channel_get_close_on_unref" external set_close_on_unref : t -> bool -> unit = "ml_g_io_channel_set_close_on_unref" monotone-viz-1.0.2.orig/glib/giochannel.mli0000644000000000000000000000525511156432503015541 0ustar type error = FBIG | INVAL | IO | ISDIR | NOSPC | NXIO | OVERFLOW | PIPE | FAILED exception Error of error * string val init : unit type t external unix_new : int -> t = "_ml_g_io_channel_unix_new" external unix_get_fd : t -> int = "ml_g_io_channel_unix_get_fd" external new_fd : int -> t = "ml_g_io_channel_new_fd" external new_file : string -> string -> t = "ml_g_io_channel_new_file" external read_chars : t -> ?off:int -> ?len:int -> string -> [ `NORMAL of int | `AGAIN | `EOF] = "_ml_g_io_channel_read_chars" (** @raise Error . @raise Glib.Convert.Error .*) external write_chars : t -> ?bytes_written:int ref -> ?off:int -> ?len:int -> string -> [ `NORMAL of int | `AGAIN] = "ml_g_io_channel_write_chars" (** @raise Error . @raise Glib.Convert.Error .*) external flush : t -> [ `NORMAL | `AGAIN] = "ml_g_io_channel_flush" (** @raise Error . @raise Glib.Convert.Error .*) external seek_position : t -> int64 -> [ `CUR | `END | `SET ] -> [ `NORMAL of int | `AGAIN | `EOF] = "ml_g_io_channel_seek_position" (** @raise Error . @raise Glib.Convert.Error .*) external shutdown : t -> bool -> unit = "ml_g_io_channel_shutdown" (** @raise Error . @raise Glib.Convert.Error .*) type condition = [ `ERR | `HUP | `IN | `NVAL | `OUT | `PRI ] type source_id external add_watch : ?prio:int -> t -> condition list -> (condition list -> bool) -> source_id = "_ml_g_io_add_watch" external remove_watch : source_id -> unit = "_ml_g_source_remove" (** @raise Not_found .*) external get_buffer_size : t -> int = "ml_g_io_channel_get_buffer_size" external set_buffer_size : t -> int -> unit = "ml_g_io_channel_set_buffer_size" external get_buffer_condition : t -> [ `IN | `OUT ] list = "ml_g_io_channel_get_buffer_condition" type rw_flags = [ `APPEND | `NONBLOCK ] type ro_flags = [ `IS_READABLE | `IS_SEEKABLE | `IS_WRITEABLE ] external get_flags : t -> [ro_flags | rw_flags] list = "ml_g_io_channel_get_flags" external set_flags : t -> rw_flags list -> unit = "ml_g_io_channel_set_flags" val set_flags_noerr : t -> rw_flags list -> unit external get_line_term : t -> string option = "ml_g_io_channel_get_line_term" external set_line_term : t -> string option -> unit = "ml_g_io_channel_set_line_term" external get_buffered : t -> bool = "ml_g_io_channel_get_buffered" external set_buffered : t -> bool -> unit = "ml_g_io_channel_set_buffered" external get_encoding : t -> string option = "ml_g_io_channel_get_encoding" external set_encoding : t -> string option -> unit = "ml_g_io_channel_set_encoding" external get_close_on_unref : t -> bool = "ml_g_io_channel_get_close_on_unref" external set_close_on_unref : t -> bool -> unit = "ml_g_io_channel_set_close_on_unref" monotone-viz-1.0.2.orig/glib/viz_gmisc.ml0000644000000000000000000000127310573632162015254 0ustar (* not present in lablgtk 2.4.0 *) external get_home_dir : unit -> string = "_ml_g_get_home_dir" external invisible_new : unit -> [Gtk.widget|`invisible] Gtk.obj = "_ml_gtk_invisible_new" external tree_view_expand_to_path : Gtk.tree_view Gtk.obj -> Gtk.tree_path -> unit = "_ml_gtk_tree_view_expand_to_path" module Date = struct type t external make_dmy : int -> int -> int -> t = "_ml_g_date_set_dmy" external current_time : unit -> t = "_ml_g_date_current_time" external strftime : t -> string -> string -> int = "_ml_g_date_strftime" external add_months : t -> int -> unit = "_ml_g_date_add_months" external subtract_months : t -> int -> unit = "_ml_g_date_subtract_months" end monotone-viz-1.0.2.orig/glib/gpattern.ml0000644000000000000000000000021210573632162015076 0ustar type t external make : string -> t = "ml_g_pattern_spec_new" external match_string : t -> string -> bool = "ml_g_pattern_match" monotone-viz-1.0.2.orig/glib/ocaml-gspawn.c0000644000000000000000000001625610733320567015474 0ustar #include #ifdef G_OS_UNIX # include #endif #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #define Val_none Val_unit CAMLprim value ml_g_spawn_init (value unit) { ml_register_exn_map (G_SPAWN_ERROR, "g_spawn_error"); return Val_unit; } #include "gspawn_tags.h" #include "gspawn_tags.c" static Make_Flags_val(Spawn_flags_val) static gchar ** convert_stringv (value argv) { gchar **res; guint i, len; value l; for (l = argv, len = 0; l != Val_emptylist; l = Field(l, 1)) len++; res = g_new (gchar *, len + 1); for (i = 0; i < len; i++) { res[i] = g_strdup (String_val (Field (argv, 0))); argv = Field (argv, 1); } res[len] = NULL; return res; } static void ml_g_spawn_child_setup (gpointer user_data) { value *closure = user_data; callback_exn (*closure, Val_unit); } static value wrap_pid (GPid pid) { #if defined (G_OS_UNIX) return Val_int (pid); #elif defined (G_OS_WIN32) return Val_pointer (pid); #else # error "unsupported OS" #endif } #define copy_caml_string(v) g_strdup (String_val (v)) #define PIPE_IN (1 << (0 + 1)) #define PIPE_OUT (1 << (1 + 1)) #define PIPE_ERR (1 << (2 + 1)) CAMLprim value ml_g_spawn_async_with_pipes (value o_working_directory, value o_envp, value o_child_setup, value v_flags, value v_pipes, value v_argv) { GError *error = NULL; gchar *working_directory; gchar **argv; gchar **envp; GSpawnFlags flags; value child_setup; GPid pid, *child_pid; gint s_in, *p_in, s_out, *p_out, s_err, *p_err; flags = Flags_Spawn_flags_val (v_flags); if ( (v_pipes & PIPE_IN && flags & G_SPAWN_CHILD_INHERITS_STDIN) || (v_pipes & PIPE_OUT && flags & G_SPAWN_STDOUT_TO_DEV_NULL) || (v_pipes & PIPE_ERR && flags & G_SPAWN_STDERR_TO_DEV_NULL)) invalid_argument ("Gspawn.async_with_pipes: incompatible flags arguments"); working_directory = Option_val (o_working_directory, copy_caml_string, NULL); argv = convert_stringv (v_argv); envp = Option_val (o_envp, convert_stringv, NULL); p_in = v_pipes & PIPE_IN ? &s_in : NULL; p_out = v_pipes & PIPE_OUT ? &s_out : NULL; p_err = v_pipes & PIPE_ERR ? &s_err : NULL; child_setup = Option_val (o_child_setup, ID, 0); child_pid = flags & G_SPAWN_DO_NOT_REAP_CHILD ? &pid : NULL; g_spawn_async_with_pipes (working_directory, argv, envp, flags, child_setup ? ml_g_spawn_child_setup : NULL, &child_setup, child_pid, p_in, p_out, p_err, &error); g_free (working_directory); g_strfreev (argv); g_strfreev (envp); if (error) ml_raise_gerror (error); { CAMLparam0(); CAMLlocal5(res, v_pid, v_in, v_out, v_err); v_pid = child_pid ? ml_some (wrap_pid (pid)) : Val_none; v_in = p_in ? ml_some (Val_int (s_in)) : Val_none; v_out = p_out ? ml_some (Val_int (s_out)) : Val_none; v_err = p_err ? ml_some (Val_int (s_err)) : Val_none; res = alloc_small (4, 0); Field (res, 0) = v_pid; Field (res, 1) = v_in; Field (res, 2) = v_out; Field (res, 3) = v_err; CAMLreturn (res); } } ML_bc6 (ml_g_spawn_async_with_pipes) static value convert_exit_status (int status) { value r; #ifdef G_OS_UNIX if (WIFEXITED(status)) { r = alloc_small (1, 0); Field (r, 0) = Val_long (WEXITSTATUS(status)); } else if (WIFSIGNALED(status)) { r = alloc_small (1, 1); Field (r, 0) = Val_long (WTERMSIG(status)); } else if (WIFSTOPPED(status)) { r = alloc_small (1, 2); Field (r, 0) = Val_long (WSTOPSIG(status)); } else invalid_argument ("Gspawn.sync: don't know how to convert the exit status"); #else r = alloc_small (1, 0); Field (r, 0) = Val_long (status); #endif return r; } static value convert_sync_status (int exit_status, gchar *standard_output, gchar *standard_error) { CAMLparam0(); CAMLlocal4(res, status, out, err); status = convert_exit_status (exit_status); out = copy_string (standard_output ? standard_output : ""); g_free (standard_output); err = copy_string (standard_error ? standard_error : ""); g_free (standard_error); res = alloc_small (3, 0); Field (res, 0) = status; Field (res, 1) = out; Field (res, 2) = err; CAMLreturn (res); } CAMLprim value ml_g_spawn_sync (value o_working_directory, value o_envp, value o_child_setup, value v_flags, value v_argv) { GError *error = NULL; gchar *working_directory; gchar **argv; gchar **envp; GSpawnFlags flags; value child_setup; gchar *standard_output; gchar *standard_error; gint exit_status; flags = Flags_Spawn_flags_val (v_flags); working_directory = Option_val (o_working_directory, copy_caml_string, NULL); argv = convert_stringv (v_argv); envp = Option_val (o_envp, convert_stringv, NULL); child_setup = Option_val (o_child_setup, ID, 0); standard_output = NULL; standard_error = NULL; caml_enter_blocking_section (); g_spawn_sync (working_directory, argv, envp, flags, child_setup ? ml_g_spawn_child_setup : NULL, &child_setup, &standard_output, &standard_error, &exit_status, &error); caml_leave_blocking_section (); g_free (working_directory); g_strfreev (argv); g_strfreev (envp); if (error) ml_raise_gerror (error); return convert_sync_status (exit_status, standard_output, standard_error); } CAMLprim value ml_g_spawn_command_line_sync (value cmd) { GError *error = NULL; gchar *command; gchar *standard_output; gchar *standard_error; gint exit_status; standard_output = NULL; standard_error = NULL; command = copy_caml_string (cmd); caml_enter_blocking_section (); g_spawn_command_line_sync (command, &standard_output, &standard_error, &exit_status, &error); caml_leave_blocking_section (); g_free (command); if (error) ml_raise_gerror (error); return convert_sync_status (exit_status, standard_output, standard_error); } CAMLprim value ml_g_spawn_command_line_async (value cmd) { GError *error = NULL; gchar *command; command = copy_caml_string (cmd); caml_enter_blocking_section (); g_spawn_command_line_async (command, &error); caml_leave_blocking_section (); g_free (command); if (error) ml_raise_gerror (error); return Val_unit; } #if defined (G_OS_UNIX) # define GPid_val(v) (GPid)Int_val(v) #elif defined (G_OS_WIN32) # define GPid_val(v) (GPid)Pointer_val(v) #else # error "unsupported OS" #endif CAMLprim value ml_int_of_pid (value pid) { #ifndef G_OS_UNIX return Val_int (0); #else return pid; #endif } ML_1(g_spawn_close_pid, GPid_val, Unit) static void ml_g_child_watch_func (GPid pid, gint status, gpointer data) { value *closure = data; callback_exn (*closure, Val_int (status)); } CAMLprim value ml_g_add_child_watch_full (value o_prio, value pid, value callback) { guint id; id = g_child_watch_add_full (Option_val (o_prio, Int_val, G_PRIORITY_DEFAULT), GPid_val (pid), ml_g_child_watch_func, ml_global_root_new (callback), ml_global_root_destroy); return Val_long (id); } monotone-viz-1.0.2.orig/glib/ocaml-giochannel.c0000644000000000000000000002211711156432503016267 0ustar #include #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "glib_tags.h" CAMLprim value ml_g_io_channel_init_exn (value unit) { ml_register_exn_map (G_IO_CHANNEL_ERROR, "g_io_channel_error"); return Val_unit; } #define Val_none Val_unit static value ml_pair (value a, value b) { CAMLparam2(a, b); value t; t = alloc_small (2, 0); Field (t, 0) = a; Field (t, 1) = b; CAMLreturn (t); } static value caml_copy_string_len (const gchar *s, gsize len) { value v; v = caml_alloc_string (len); memcpy (String_val (v), s, len); return v; } /* io_status : tags */ #include "giochannel_tags.h" #include "giochannel_tags.c" /* Make_Val_final_pointer (GIOChannel, Ignore, g_io_channel_unref, 20) */ extern value Val_GIOChannel (GIOChannel *); #define GIOChannel_val(v) (GIOChannel *)Pointer_val(v) CAMLprim value _ml_g_io_channel_unix_new (value fd) { return Val_GIOChannel (g_io_channel_unix_new (Int_val (fd))); } /* ML_1(g_io_channel_unix_new, Int_val, Val_GIOChannel) */ ML_1(g_io_channel_unix_get_fd, GIOChannel_val, Val_int) CAMLprim value ml_g_io_channel_new_fd (value fd) { GIOChannel *c; #ifdef G_OS_WIN32 c = g_io_channel_win32_new_fd (Int_val (fd)); #else c = g_io_channel_unix_new (Int_val (fd)); #endif return Val_GIOChannel (c); } CAMLprim value ml_g_io_channel_new_file (value v_fname, value v_mode) { GError *error = NULL; GIOChannel *c; gchar *fname, *mode; fname = g_strdup (String_val (v_fname)); mode = g_strdup (String_val (v_mode)); enter_blocking_section (); c = g_io_channel_new_file (fname, mode, &error); leave_blocking_section (); g_free (fname); g_free (mode); if (error) ml_raise_gerror (error); return Val_GIOChannel (c); } static value wrap_status_and_value (GIOStatus status, GError *err, gboolean has_ret_val, value ret_val) { g_assert (err == NULL || status == G_IO_STATUS_ERROR); switch (status) { case G_IO_STATUS_ERROR: if (err == NULL) err = g_error_new_literal (G_IO_CHANNEL_ERROR, G_IO_CHANNEL_ERROR_FAILED, "invalid arguments"); ml_raise_gerror (err); break; case G_IO_STATUS_NORMAL: if (has_ret_val) return ml_pair (MLTAG_NORMAL, ret_val); else return MLTAG_NORMAL; case G_IO_STATUS_EOF: return MLTAG_EOF; case G_IO_STATUS_AGAIN: return MLTAG_AGAIN; } g_assert_not_reached (); return Val_unit; } static inline gboolean check_substring (value s, gsize off, gsize len) { gsize str_len = string_length (s); return off <= str_len && off + len <= str_len; } #ifdef G_OS_UNIX # define IO_CHANNEL_BUF_SIZE PIPE_BUF #else # define IO_CHANNEL_BUF_SIZE 4096 #endif CAMLprim value _ml_g_io_channel_read_chars (value c, value o_off, value o_len, value s) { CAMLparam1(s); GError *err = NULL; GIOStatus status; GIOChannel *chan; gchar buff[IO_CHANNEL_BUF_SIZE]; gsize bytes_read; gsize off, len; gboolean has_ret_val; off = Option_val (o_off, Long_val, 0); len = Option_val (o_len, Long_val, string_length (s) - off); if (! check_substring (s, off, len)) invalid_argument ("invalid substring"); if (len > IO_CHANNEL_BUF_SIZE) len = IO_CHANNEL_BUF_SIZE; chan = GIOChannel_val (c); enter_blocking_section (); status = g_io_channel_read_chars (chan, buff, len, &bytes_read, &err); leave_blocking_section (); if (bytes_read > 0) memcpy (String_val (s) + off, buff, bytes_read); has_ret_val = status == G_IO_STATUS_NORMAL; CAMLreturn (wrap_status_and_value (status, err, has_ret_val, Val_long (bytes_read))); } CAMLprim value ml_g_io_channel_write_chars (value c, value written_ref, value o_off, value o_len, value s) { CAMLparam2(c, written_ref); GError *err = NULL; GIOStatus status; GIOChannel *chan; gchar buff[IO_CHANNEL_BUF_SIZE]; gsize bytes_written; gsize off, len; off = Option_val (o_off, Long_val, 0); len = Option_val (o_len, Long_val, string_length (s) - off); if (! check_substring (s, off, len)) invalid_argument ("invalid substring"); if (len > IO_CHANNEL_BUF_SIZE) len = IO_CHANNEL_BUF_SIZE; chan = GIOChannel_val (c); memcpy (buff, String_val (s) + off, len); enter_blocking_section (); status = g_io_channel_write_chars (chan, buff, len, &bytes_written, &err); leave_blocking_section (); if (Is_block (written_ref)) Field (Field (written_ref, 0), 0) = Val_long (bytes_written); CAMLreturn (wrap_status_and_value (status, err, TRUE, Val_long (bytes_written))); } CAMLprim value ml_g_io_channel_flush (value c) { GError *err = NULL; GIOStatus status; GIOChannel *chan; chan = GIOChannel_val (c); enter_blocking_section (); status = g_io_channel_flush (chan, &err); leave_blocking_section (); return wrap_status_and_value (status, err, FALSE, Val_unit); } CAMLprim value ml_g_io_channel_seek_position (value c, value off, value pos) { GError *err = NULL; GIOStatus status; GIOChannel *chan; gint64 offset; chan = GIOChannel_val (c); offset = Int64_val (off); enter_blocking_section (); status = g_io_channel_seek_position (chan, offset, Seek_type_val (pos), &err); leave_blocking_section (); return wrap_status_and_value (status, err, FALSE, Val_unit); } CAMLprim value ml_g_io_channel_shutdown (value c, value flush) { GError *err = NULL; GIOStatus status; GIOChannel *chan; chan = GIOChannel_val (c); enter_blocking_section (); status = g_io_channel_shutdown (GIOChannel_val(c), Bool_val (flush), &err); leave_blocking_section (); if (status == G_IO_STATUS_ERROR || err != NULL) return wrap_status_and_value (status, err, FALSE, Val_unit); else return Val_unit; } static gboolean ml_GIOFunc (GIOChannel *source, GIOCondition condition, gpointer data) { value res, v_condition, *closure = data; v_condition = ml_lookup_flags_getter (ml_table_io_condition, condition); res = callback_exn (*closure, v_condition); if (Is_exception_result (res)) { g_warning ("GIOFunc callback raised an exception"); return FALSE; } return Bool_val (res); } static Make_Flags_val(Io_condition_val) CAMLprim value _ml_g_io_add_watch (value prio, value c, value conditions, value callback) { guint id; id = g_io_add_watch_full (GIOChannel_val (c), Option_val (prio, Int_val, G_PRIORITY_DEFAULT), Flags_Io_condition_val (conditions), ml_GIOFunc, ml_global_root_new (callback), ml_global_root_destroy); return Val_int (id); } CAMLprim value _ml_g_source_remove (value id) { if (! g_source_remove (Int_val(id))) raise_not_found (); return Val_unit; } ML_1 (g_io_channel_get_buffer_size, GIOChannel_val, Val_long) ML_2 (g_io_channel_set_buffer_size, GIOChannel_val, Long_val, Unit) #define copy_GIOCondition(f) ml_lookup_flags_getter (ml_table_io_condition, f) ML_1 (g_io_channel_get_buffer_condition, GIOChannel_val, copy_GIOCondition) #define copy_GIOFlags(f) ml_lookup_flags_getter (ml_table_io_flags, f) ML_1 (g_io_channel_get_flags, GIOChannel_val, copy_GIOFlags) static Make_Flags_val (Io_flags_val) CAMLprim value ml_g_io_channel_set_flags (value c, value flags) { GError *err = NULL; GIOStatus status; status = g_io_channel_set_flags (GIOChannel_val (c), Flags_Io_flags_val (flags), &err); if (status == G_IO_STATUS_ERROR) ml_raise_gerror (err); g_assert (status == G_IO_STATUS_NORMAL); return Val_unit; } CAMLprim value ml_g_io_channel_get_line_term (value c) { G_CONST_RETURN gchar *line_term; gint length; line_term = g_io_channel_get_line_term (GIOChannel_val (c), &length); if (line_term == NULL) return Val_none; else return ml_some (caml_copy_string_len (line_term, length)); } CAMLprim value ml_g_io_channel_set_line_term (value c, value term) { gchar *line_term; gint length; if (Is_block (term)) { value t = Field (term, 0); line_term = String_val (t); length = string_length (t); } else { line_term = NULL; length = 0; } g_io_channel_set_line_term (GIOChannel_val (c), line_term, length); return Val_unit; } ML_1 (g_io_channel_get_buffered, GIOChannel_val, Val_bool) ML_2 (g_io_channel_set_buffered, GIOChannel_val, Bool_val, Unit) CAMLprim value ml_g_io_channel_get_encoding (value c) { G_CONST_RETURN gchar *encoding; encoding = g_io_channel_get_encoding (GIOChannel_val (c)); if (encoding == NULL) return Val_none; else return ml_some (copy_string (encoding)); } CAMLprim value ml_g_io_channel_set_encoding (value c, value enc) { GError *err = NULL; GIOStatus status; gchar *encoding; encoding = String_option_val (enc); status = g_io_channel_set_encoding (GIOChannel_val (c), encoding, &err); if (status == G_IO_STATUS_ERROR) { if (err != NULL) ml_raise_gerror (err); else invalid_argument ("GIOChannel.set_encoding"); } g_assert (status == G_IO_STATUS_NORMAL); return Val_unit; } ML_1 (g_io_channel_get_close_on_unref, GIOChannel_val, Val_bool) ML_2 (g_io_channel_set_close_on_unref, GIOChannel_val, Bool_val, Unit) monotone-viz-1.0.2.orig/glib/ocaml-misc.c0000644000000000000000000000125610573632162015121 0ustar #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gtk.h" CAMLprim value _ml_g_get_home_dir (value unit) { G_CONST_RETURN gchar *dir = g_get_home_dir (); return copy_string (dir ? dir : ""); } CAMLprim value _ml_gtk_invisible_new (value unit) { return Val_GtkWidget_sink (gtk_invisible_new ()); } #define GtkTreeView_val(val) check_cast(GTK_TREE_VIEW,val) #define GtkTreePath_val(val) ((GtkTreePath*)Pointer_val(val)) CAMLprim value _ml_gtk_tree_view_expand_to_path (value view, value path) { gtk_tree_view_expand_to_path (GtkTreeView_val (view), GtkTreePath_val (path)); return Val_unit; } monotone-viz-1.0.2.orig/glib/ocaml-gdate.c0000644000000000000000000000235310573632162015251 0ustar #include #include CAMLprim value _ml_g_date_current_time (value unit) { GDate date, *p; GTimeVal current; value v; g_get_current_time (¤t); g_date_clear (&date, 1); g_date_set_time (&date, current.tv_sec); v = caml_alloc_small (sizeof (GDate) / sizeof (value), Abstract_tag); p = (GDate *) v; *p = date; return v; } CAMLprim value _ml_g_date_set_dmy (value d, value m, value y) { GDate date, *p; value v; g_date_clear (&date, 1); g_date_set_dmy (&date, Int_val(d), Int_val(m), Int_val(y)); v = caml_alloc_small (sizeof (GDate) / sizeof (value), Abstract_tag); p = (GDate *) v; *p = date; return v; } #define GDate_val(v) (GDate *) (v) CAMLprim value _ml_g_date_strftime (value d, value fmt, value buff) { GDate *date = (GDate *)(d); gsize n; n = g_date_strftime (String_val(buff), caml_string_length(buff) + 1, String_val(fmt), date); return Val_int (n); } CAMLprim value _ml_g_date_add_months (value d, value n) { GDate *date = GDate_val (d); g_date_add_months (date, Int_val(n)); return Val_unit; } CAMLprim value _ml_g_date_subtract_months (value d, value n) { GDate *date = GDate_val (d); g_date_subtract_months (date, Int_val(n)); return Val_unit; } monotone-viz-1.0.2.orig/glib/ocaml-gpattern.c0000644000000000000000000000200110573632162015777 0ustar #include #define CAML_NAME_SPACE #include #include "wrappers.h" #include "ml_glib.h" #define GPatternSpec_val(v) (* (GPatternSpec **) Data_custom_val(v)) static void ml_g_pattern_spec_finalize (value v) { GPatternSpec *s = GPatternSpec_val(v); g_pattern_spec_free (s); } static value ml_wrap_g_pattern_spec (GPatternSpec *s) { static const struct custom_operations g_pattern_spec_ops = { "GPatternSpec", ml_g_pattern_spec_finalize, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default }; GPatternSpec **p; value v; v = caml_alloc_custom ((struct custom_operations *) &g_pattern_spec_ops, sizeof (GPatternSpec *), 1, 100); p = Data_custom_val(v); *p = s; return v; } ML_1 (g_pattern_spec_new, String_val, ml_wrap_g_pattern_spec) CAMLprim value ml_g_pattern_match (value p, value s) { return Val_bool (g_pattern_match (GPatternSpec_val (p), caml_string_length (s), String_val (s), NULL)); } monotone-viz-1.0.2.orig/glib/gspawn_tags.var0000644000000000000000000000031610573632162015754 0ustar type spawn_flags = "G_SPAWN_" [ `LEAVE_DESCRIPTORS_OPEN | `DO_NOT_REAP_CHILD | `SEARCH_PATH | `STDOUT_TO_DEV_NULL | `STDERR_TO_DEV_NULL | `CHILD_INHERITS_STDIN | `FILE_AND_ARGV_ZERO ] monotone-viz-1.0.2.orig/glib/giochannel_tags.var0000644000000000000000000000036110573632162016564 0ustar type noconv io_status = "G_IO_STATUS_" [ `ERROR | `NORMAL | `EOF | `AGAIN ] type seek_type = "G_SEEK_" [ `CUR | `SET | `END ] type io_flags = "G_IO_FLAG_" [ `APPEND | `NONBLOCK | `IS_READABLE | `IS_WRITEABLE | `IS_SEEKABLE ]