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

open Viz_misc

type mt_options =
  | MTopt_none
  | MTopt_db of string
  | MTopt_branch of string * string
  | MTopt_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_MT_dir () =
  let rec up = function
    | "/" -> raise Not_found
    | p ->
	let d = Filename.dirname p in
	let m = Filename.concat d "MT" in
	if Sys.file_exists m
	then m
	else up d in
  if Sys.file_exists "MT"
  then "MT"
  else up (Sys.getcwd ())

let parse_MT_options () =
  let mt_file =
    let mt_dir = Lazy.lazy_from_fun find_MT_dir in
    fun f -> Filename.concat (Lazy.force mt_dir) f in
  match
    try with_file_in input_lines (mt_file "options")
    with Not_found | Sys_error _ -> [] with
  | [] -> MTopt_none
  | lines ->
      let options =
	try
	  List.fold_right
	    (fun s acc ->
	      match string_split ~max_elem:2 ' ' s with
	      | [a; b] -> (a, unquote b) :: acc
	      | _ -> acc)
	    lines []
	with Failure _ -> [] in
      match may_assoc "database" options with
      | None -> MTopt_none
      | Some db_raw ->
	  try
	    let db = Glib.Convert.filename_from_utf8 db_raw in
	    match may_assoc "branch" options with
	    | Some branch when Glib.Utf8.validate branch ->
		begin
		  try
		    let revision = with_file_in input_line (mt_file "revision") in
		    MTopt_full (db, branch, revision)
		  with Sys_error _ ->
		    MTopt_branch (db, branch)
		end
	    | _ ->
		MTopt_db db
	  with Glib.Convert.Error _ ->
	    MTopt_none

let parse_options args =
  match args with
  | [] ->
      parse_MT_options ()
  | db :: [] | db :: "" :: _ ->
      MTopt_db db
  | db :: branch_raw :: rest ->
      try
	let branch = Glib.Convert.locale_to_utf8 branch_raw in
	match rest with
	| [] | "" :: _ ->
	    MTopt_branch (db, branch)
	| revision :: _ ->
	    MTopt_full (db, branch, revision)
      with Glib.Convert.Error _ ->
	MTopt_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.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, mt_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 mt_options with
	     | MTopt_none ->
		 ctrl#show_open ()
	     | MTopt_db fname ->
		 ctrl#open_db fname
	     | MTopt_branch (fname, branch) ->
		 ctrl#open_db ~branch fname
	     | MTopt_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 ()