Below is the file 'main.ml' from this revision. You can also download the file.

open Viz_misc

type mtn_options =
  | MTNopt_none
  | MTNopt_db of string
  | MTNopt_branch of string * string
  | MTNopt_full of string * string * string

let unquote s =
  if s.[0] = '"'
  then
    let len = String.length s in
    Revision_lexer.string
      (Buffer.create len)
      (Lexing.from_string (String.sub s 1 (len - 1)))
  else s

let find_MTN_dir base =
  let rec up = function
    | "/" -> raise Not_found
    | p ->
	let d = Filename.dirname p in
	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 lines =
    try with_file_in input_lines (mtn_file "options")
    with Not_found | Sys_error _ -> [] in
  try
    List.fold_right
      (fun s acc ->
	match string_split ~max_elem:2 ' ' s with
	| [a; b] -> (a, unquote b) :: acc
	| _ -> acc)
      lines []
  with Failure _ -> []

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_parser.revision_set
	      Revision_lexer.lex
	      (Lexing.from_channel ic)
	  with
	  | _, { Revision_types.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-2005 Olivier Andrieu <oandrieu@nerim.net>\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
  | Sqlite3.Error ((Sqlite3.BUSY | Sqlite3.LOCKED), _) ->
      ()
  | 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 ()