helm/matita/matitamake.ml

   1 (* Copyright (C) 2005, HELM Team.
   2  *
   3  * This file is part of HELM, an Hypertextual, Electronic
   4  * Library of Mathematics, developed at the Computer Science
   5  * Department, University of Bologna, Italy.
   6  *
   7  * HELM is free software; you can redistribute it and/or
   8  * modify it under the terms of the GNU General Public License
   9  * as published by the Free Software Foundation; either version 2
  10  * of the License, or (at your option) any later version.
  11  *
  12  * HELM is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with HELM; if not, write to the Free Software
  19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  20  * MA  02111-1307, USA.
  21  *
  22  * For details, see the HELM World-Wide-Web page,
  23  * http://helm.cs.unibo.it/
  24  *)
  25
  26 module MK = MatitamakeLib ;;
  27
  28 let _ =
  29   MatitaInit.load_config_only ();
  30   MK.initialize ()
  31 ;;
  32
  33 let usage = ref (fun () -> ())
  34
  35 let dev_of_name name =
  36   match MK.development_for_name name with
  37   | None ->
  38       prerr_endline ("Unable to find a development called " ^ name);
  39       exit 1
  40   | Some d -> d
  41 ;;
  42
  43 let dev_for_dir dir =
  44   match MK.development_for_dir dir with
  45   | None ->
  46       prerr_endline ("Unable to find a development holding directory: " ^ dir);
  47       exit 1
  48   | Some d -> d
  49 ;;
  50
  51 let init_dev_doc = "
  52 \tParameters: name (the name of the development, required)
  53 \tDescription: tells matitamake that a new development radicated
  54 \t\tin the current working directory should be handled."
  55 ;;
  56
  57 let init_dev args =
  58   if List.length args <> 1 then !usage ();
  59   match MK.initialize_development (List.hd args) (Unix.getcwd ()) with
  60   | None -> exit 2
  61   | Some _ -> exit 0
  62 ;;
  63
  64 let list_dev_doc = "
  65 \tParameters:
  66 \tDescription: lists the known developments and their roots."
  67 ;;
  68
  69 let list_dev args =
  70   if List.length args <> 0 then !usage ();
  71   match MK.list_known_developments () with
  72   | [] -> print_string "No developments found.\n"; exit 0
  73   | l ->
  74       List.iter
  75         (fun (name, root) ->
  76           print_string (Printf.sprintf "%-10s\trooted in %s\n" name root))
  77         l;
  78       exit 0
  79 ;;
  80
  81 let destroy_dev_doc = "
  82 \tParameters: name (the name of the development to destroy, required)
  83 \tDescription: deletes a development (only from matitamake metadat, no
  84 \t\t.ma files will be deleted)."
  85
  86 let destroy_dev args =
  87   if List.length args <> 1 then !usage ();
  88   let name = (List.hd args) in
  89   let dev = dev_of_name name in
  90   MK.destroy_development dev;
  91   exit 0
  92 ;;
  93
  94 let clean_dev_doc = "
  95 \tParameters: name (the name of the development to destroy, optional)
  96 \t\tIf omitted the development that holds the current working
  97 \t\tdirectory is used (if any).
  98 \tDescription: clean the develpoment."
  99
 100 let clean_dev args =
 101   let dev =
 102     match args with
 103     | [] -> dev_for_dir (Unix.getcwd ())
 104     | [name] -> dev_of_name name
 105     | _ -> !usage (); exit 1
 106   in
 107   match MK.clean_development dev with
 108   | true -> exit 0
 109   | false -> exit 1
 110 ;;
 111
 112 let build_dev_doc = "
 113 \tParameters: name (the name of the development to build, required)
 114 \tDescription: completely builds the develpoment."
 115
 116 let build_dev args =
 117   if List.length args <> 1 then !usage ();
 118   let name = (List.hd args) in
 119   let dev = dev_of_name name in
 120   match MK.build_development dev with
 121   | true -> exit 0
 122   | false -> exit 1
 123 ;;
 124
 125 let target args =
 126   if List.length args < 1 then !usage ();
 127   let dev = dev_for_dir (Unix.getcwd ()) in
 128   List.iter
 129     (fun t ->
 130       ignore(MK.build_development ~target:t dev))
 131     args
 132 ;;
 133
 134 let params = [
 135   "-init", init_dev, init_dev_doc;
 136   "-clean", clean_dev, clean_dev_doc;
 137   "-list", list_dev, list_dev_doc;
 138   "-destroy", destroy_dev, destroy_dev_doc;
 139   "-build", build_dev, build_dev_doc;
 140   "-h", (fun _ -> !usage()), "print this help screen";
 141   "-help", (fun _ -> !usage()), "print this help screen";
 142 ]
 143 ;;
 144
 145 usage := fun () ->
 146   let p = prerr_endline in
 147   p "\nusage:";
 148   p "\tmatitamake(.opt) [command [options]]\n";
 149   p "\tmatitamake(.opt) [target]\n";
 150   p "commands:";
 151   List.iter (fun (n,_,d) -> p (Printf.sprintf "    %-10s%s" n d)) params;
 152   p "\nIf target is omitted a 'all' will be used as the default.";
 153   p "With -build you can build a development wherever it is.";
 154   p "If you specify a target it implicitly refers to the development that";
 155   p "holds the current working directory (if any).\n";
 156   exit 1
 157 ;;
 158
 159 let parse args =
 160   match args with
 161   | [] -> target ["all"]
 162   | s::tl ->
 163       try
 164         let _,f,_ = List.find (fun (n,_,_) -> n = s) params in
 165         f tl
 166       with Not_found -> if s.[0] = '-' then !usage () else target args
 167
 168 let _ =
 169   parse (List.tl (Array.to_list Sys.argv))
 170