|
@@ -0,0 +1,317 @@
|
|
|
+(******************************************************************************)
|
|
|
+(* Copyright © Joly Clément, 2016 *)
|
|
|
+(* *)
|
|
|
+(* leowzukw@oclaunch.eu.org *)
|
|
|
+(* *)
|
|
|
+(* Ce logiciel est un programme informatique servant à exécuter *)
|
|
|
+(* automatiquement des programmes à l'ouverture du terminal. *)
|
|
|
+(* *)
|
|
|
+(* Ce logiciel est régi par la licence CeCILL soumise au droit français et *)
|
|
|
+(* respectant les principes de diffusion des logiciels libres. Vous pouvez *)
|
|
|
+(* utiliser, modifier et/ou redistribuer ce programme sous les conditions *)
|
|
|
+(* de la licence CeCILL telle que diffusée par le CEA, le CNRS et l'INRIA *)
|
|
|
+(* sur le site "http://www.cecill.info". *)
|
|
|
+(* *)
|
|
|
+(* En contrepartie de l'accessibilité au code source et des droits de copie, *)
|
|
|
+(* de modification et de redistribution accordés par cette licence, il n'est *)
|
|
|
+(* offert aux utilisateurs qu'une garantie limitée. Pour les mêmes raisons, *)
|
|
|
+(* seule une responsabilité restreinte pèse sur l'auteur du programme, le *)
|
|
|
+(* titulaire des droits patrimoniaux et les concédants successifs. *)
|
|
|
+(* *)
|
|
|
+(* A cet égard l'attention de l'utilisateur est attirée sur les risques *)
|
|
|
+(* associés au chargement, à l'utilisation, à la modification et/ou au *)
|
|
|
+(* développement et à la reproduction du logiciel par l'utilisateur étant *)
|
|
|
+(* donné sa spécificité de logiciel libre, qui peut le rendre complexe à *)
|
|
|
+(* manipuler et qui le réserve donc à des développeurs et des professionnels *)
|
|
|
+(* avertis possédant des connaissances informatiques approfondies. Les *)
|
|
|
+(* utilisateurs sont donc invités à charger et tester l'adéquation du *)
|
|
|
+(* logiciel à leurs besoins dans des conditions permettant d'assurer la *)
|
|
|
+(* sécurité de leurs systèmes et ou de leurs données et, plus généralement, *)
|
|
|
+(* à l'utiliser et l'exploiter dans les mêmes conditions de sécurité. *)
|
|
|
+(* *)
|
|
|
+(* Le fait que vous puissiez accéder à cet en-tête signifie que vous avez *)
|
|
|
+(* pris connaissance de la licence CeCILL, et que vous en avez accepté les *)
|
|
|
+(* termes. *)
|
|
|
+(******************************************************************************)
|
|
|
+
|
|
|
+open Core.Std;;
|
|
|
+
|
|
|
+(* Rc files means configuration file. It consist in a list of **entries**, with
|
|
|
+ * settings and common tags. Each entry has a command to be run (used to
|
|
|
+ * identify the entry in tmp file), an id (based on the position in rc file, may
|
|
|
+ * change), a description (the command plus things that tags may add), a number
|
|
|
+ * of launch (stored in tmp file) and tags, which change default behavior *)
|
|
|
+
|
|
|
+(* A “basic” rc file is used to interface with the content actualy written to
|
|
|
+ * the drive, and it’s then transforme to create the rc file used almost
|
|
|
+ * everywhere.
|
|
|
+ * “Basic” may used qualify anything referring to a low-level object *)
|
|
|
+type basic_tag = {
|
|
|
+ name : string;
|
|
|
+ arguments : string sexp_list
|
|
|
+} [@@deriving sexp]
|
|
|
+;;
|
|
|
+type basic_entry = {
|
|
|
+ command : string;
|
|
|
+ tags : basic_tag list
|
|
|
+} [@@deriving sexp]
|
|
|
+;;
|
|
|
+type basic_rc = {
|
|
|
+ entries : basic_entry list;
|
|
|
+ common_tags : basic_tag list;
|
|
|
+ settings : string list;
|
|
|
+} [@@deriving sexp]
|
|
|
+;;
|
|
|
+
|
|
|
+(* Template for the rc_file *)
|
|
|
+let basic_template =
|
|
|
+ "((entries())(common_tags())(settings()))"
|
|
|
+;;
|
|
|
+
|
|
|
+(* Header added once wrtten to disk *)
|
|
|
+let rc_header =
|
|
|
+ "\
|
|
|
+ ;; You probably do NOT need to edit this file manualy.\n\
|
|
|
+ ;; Anyway, you may find help at https://s.oclaunch.eu.org/rc\
|
|
|
+ "
|
|
|
+;;
|
|
|
+
|
|
|
+(* XXX Module exposing functions hidden by the mli file for tests *)
|
|
|
+module Test : sig
|
|
|
+ type basic_rc_t
|
|
|
+ val basic_rc_of_sexp : Sexp.t -> basic_rc_t
|
|
|
+ val basic_template : string
|
|
|
+end
|
|
|
+= struct
|
|
|
+ type basic_rc_t = basic_rc
|
|
|
+ let basic_rc_of_sexp = basic_rc_of_sexp
|
|
|
+ let basic_template = basic_template
|
|
|
+end;;
|
|
|
+
|
|
|
+(* Message to display on first use, i.e. on initialisation of rc file *)
|
|
|
+let welcome_msg =
|
|
|
+ sprintf
|
|
|
+ "Nice to meet you! Here is some tips to get started with OcLaunch.\n\
|
|
|
+ Use 'help' subcommand to get help (it works both after the name of the \
|
|
|
+ software and with another subcommand). For instance run\n\
|
|
|
+ `oclaunch help add`\n\
|
|
|
+ For further help, see https://oclaunch.eu.org. Report any bug at %s\
|
|
|
+ \n\
|
|
|
+ \n\
|
|
|
+ Feedback is welcome at feedback@oclaunch.eu.org.\n\
|
|
|
+ To get remind for new stable versions, subscribe to our low-traffic mailing \
|
|
|
+ list: announce@oclaunch.eu.org. \
|
|
|
+ More here: https://s.oclaunch.eu.org/ml\n\
|
|
|
+ See you soon! To keep in touch: https://s.oclaunch.eu.org/kt\n"
|
|
|
+ Bug.url
|
|
|
+;;
|
|
|
+
|
|
|
+let create_basic name =
|
|
|
+ sprintf "Initializing empty configuration file in %s.\n\
|
|
|
+ You may import your rc file from an older version with\n\
|
|
|
+ `oclaunch import`\
|
|
|
+ " name
|
|
|
+ |> Messages.warning;
|
|
|
+ Messages.tips welcome_msg;
|
|
|
+ Licencing.print ~cecill:false;
|
|
|
+ Out_channel.write_all name basic_template
|
|
|
+;;
|
|
|
+
|
|
|
+let rec get_basic rc_name =
|
|
|
+ match Sys.file_exists rc_name with
|
|
|
+ | `No -> create_basic rc_name; get_basic rc_name
|
|
|
+ | `Unknown -> failwith "Error reading configuration file";
|
|
|
+ | `Yes -> try Sexp.load_sexp rc_name |> basic_rc_of_sexp
|
|
|
+ with exn ->
|
|
|
+ Messages.warning "Problem reading rc file";
|
|
|
+ sprintf
|
|
|
+ "Remove file '%s' to get a fresh rc file next time you call oclaunch"
|
|
|
+ rc_name
|
|
|
+ |> Messages.tips;
|
|
|
+ raise exn
|
|
|
+;;
|
|
|
+
|
|
|
+(* From objects to types *)
|
|
|
+let tag_of_object tag = failwith "Not implemented";;
|
|
|
+let setting_of_object setting = failwith "Not implemented";;
|
|
|
+let entry_of_object entry =
|
|
|
+ {
|
|
|
+ command = entry#command;
|
|
|
+ tags = List.map ~f:tag_of_object entry#tags
|
|
|
+ }
|
|
|
+;;
|
|
|
+
|
|
|
+(* Now transformed objects *)
|
|
|
+
|
|
|
+(* Tags may be extend by plugins *)
|
|
|
+class tag name arg = object (self:'self)
|
|
|
+ val name : string = name
|
|
|
+ val arguments : string list = arg
|
|
|
+
|
|
|
+ method name = name
|
|
|
+ method arguments = arg
|
|
|
+
|
|
|
+ method equal (other:'self) =
|
|
|
+ (String.equal self#name other#name)
|
|
|
+ && (List.equal ~equal:String.equal self#arguments other#arguments)
|
|
|
+end;;
|
|
|
+
|
|
|
+class entry ?(tags=[]) command = object (self:'self)
|
|
|
+ val command : string = command
|
|
|
+ val tags : tag list = tags
|
|
|
+
|
|
|
+ method command = command
|
|
|
+ method tags = tags
|
|
|
+
|
|
|
+ method change_command new_command = {< command = new_command >}
|
|
|
+ method change_tags new_tags = {< tags = new_tags >}
|
|
|
+
|
|
|
+ (* Two entries are equal iff they have the same command and tags *)
|
|
|
+ method equal (other:'self) =
|
|
|
+ (String.equal self#command other#command)
|
|
|
+ && (List.equal self#tags other#tags
|
|
|
+ ~equal:(fun atag btag -> atag#equal btag))
|
|
|
+end;;
|
|
|
+
|
|
|
+(* XXX Pseudo comparator *)
|
|
|
+let equal one another =
|
|
|
+ one#equal another
|
|
|
+;;
|
|
|
+
|
|
|
+(* Types of objects, exposed *)
|
|
|
+type setting = < key : string; value : string >;;
|
|
|
+type t = <
|
|
|
+ add_common_tags : tag list -> t;
|
|
|
+ add_entries : entry list -> t;
|
|
|
+ add_settings : setting list -> t;
|
|
|
+ change_entries : entry list -> t;
|
|
|
+ change_entry : int -> f:(entry -> entry) -> t;
|
|
|
+ change_name : string -> t;
|
|
|
+ common_tags : tag list;
|
|
|
+ entries : entry list;
|
|
|
+ entry : n:int -> entry option;
|
|
|
+ filter_map_common_tags : f:(tag -> tag option) -> t;
|
|
|
+ filter_map_entries : f:(int -> entry -> entry option) -> t;
|
|
|
+ filter_map_settings : f:(setting -> setting option) -> t;
|
|
|
+ get_name : string;
|
|
|
+ map_common_tags : f:(tag -> tag) -> t;
|
|
|
+ map_entries : f:(int -> entry -> entry) -> t;
|
|
|
+ map_settings : f:(setting -> setting) -> t;
|
|
|
+ read_common_tags : f:(tag -> unit) -> unit;
|
|
|
+ read_settings : f:(setting -> unit) -> unit;
|
|
|
+ remove_entry : int -> t;
|
|
|
+ settings : setting list;
|
|
|
+ write : unit
|
|
|
+>;;
|
|
|
+
|
|
|
+let object_of_tag tag = failwith "Not implemented"
|
|
|
+(* object
|
|
|
+ val name = tag.name;
|
|
|
+ val argument
|
|
|
+ end *)
|
|
|
+;;
|
|
|
+let object_of_tag_list =
|
|
|
+ List.map ~f:object_of_tag
|
|
|
+;;
|
|
|
+let object_of_entry object_common_tags entry =
|
|
|
+ new entry ~tags:((object_of_tag_list entry.tags) @ object_common_tags) entry.command
|
|
|
+;;
|
|
|
+let object_of_setting setting = failwith "Not implemented";;
|
|
|
+
|
|
|
+let init ?(rc=(!Const.rc_file)) () =
|
|
|
+ let basic_rc = get_basic (Lazy.force rc) in
|
|
|
+ let common_tags = object_of_tag_list basic_rc.common_tags in
|
|
|
+ object (self)
|
|
|
+ val entries = List.map ~f:(object_of_entry common_tags) basic_rc.entries
|
|
|
+ val common_tags = common_tags
|
|
|
+ val settings = List.map ~f:object_of_setting basic_rc.settings
|
|
|
+
|
|
|
+ method entries = entries
|
|
|
+ method common_tags = common_tags
|
|
|
+ method settings = settings
|
|
|
+
|
|
|
+ (* Change entry list *)
|
|
|
+ method change_entries new_entries = {< entries = new_entries >}
|
|
|
+
|
|
|
+ (* Get entry number n *)
|
|
|
+ method entry ~n = List.nth entries n
|
|
|
+
|
|
|
+ method add_entries new_entries =
|
|
|
+ {< entries = new_entries @ entries >}
|
|
|
+ method add_common_tags tags =
|
|
|
+ {< common_tags = tags @ common_tags >}
|
|
|
+ method add_settings new_settings =
|
|
|
+ {< settings = new_settings @ settings >}
|
|
|
+
|
|
|
+ method filter_map_entries ~f =
|
|
|
+ {< entries = List.filter_mapi entries ~f >}
|
|
|
+ method filter_map_common_tags ~f =
|
|
|
+ {< common_tags = List.filter_map common_tags ~f >}
|
|
|
+ method filter_map_settings ~f =
|
|
|
+ {< settings = List.filter_map settings ~f >}
|
|
|
+
|
|
|
+ method map_entries ~f =
|
|
|
+ {< entries = List.mapi entries ~f >}
|
|
|
+ method map_common_tags ~f =
|
|
|
+ {< common_tags = List.map common_tags ~f >}
|
|
|
+ method map_settings ~f =
|
|
|
+ {< settings = List.map settings ~f >}
|
|
|
+
|
|
|
+ method read_common_tags ~f =
|
|
|
+ List.iter common_tags ~f
|
|
|
+ method read_settings ~f =
|
|
|
+ List.iter settings ~f
|
|
|
+
|
|
|
+ (* Shorthand *)
|
|
|
+ method change_entry n ~f =
|
|
|
+ self#map_entries ~f:(fun i e -> if i=n then f e else e)
|
|
|
+ method remove_entry n =
|
|
|
+ self#filter_map_entries ~f:(fun i e -> if i=n then None else Some e)
|
|
|
+
|
|
|
+ (* Name of rc file when written to disk *)
|
|
|
+ val name = Lazy.force rc
|
|
|
+ method get_name = name
|
|
|
+ method change_name new_name = {< name = new_name >}
|
|
|
+ method write =
|
|
|
+ let body =
|
|
|
+ {
|
|
|
+ entries = List.map entries ~f:entry_of_object;
|
|
|
+ common_tags = List.map common_tags ~f:tag_of_object;
|
|
|
+ settings = List.map settings ~f:setting_of_object
|
|
|
+ } |> sexp_of_basic_rc
|
|
|
+ |> Sexp.to_string_hum
|
|
|
+ in
|
|
|
+ let data = String.concat [ rc_header ; "\n\n\n" ; body ; "\n" ] in
|
|
|
+ Out_channel.write_all name ~data
|
|
|
+ (** Write rc file at instantiation. Entries should be changed in group, to
|
|
|
+ * avoid multiple writing. Although, there is some cache done by out_channels,
|
|
|
+ * this is not very dangerous *)
|
|
|
+ initializer self#write
|
|
|
+ end;;
|
|
|
+
|
|
|
+let create_setting () = failwith "Not implemented"
|
|
|
+(*
|
|
|
+ (* Tools to create new tag *)
|
|
|
+ class enpty_tag = object
|
|
|
+ val
|
|
|
+*)
|
|
|
+
|
|
|
+let change_setting () = failwith "Not implemented"
|
|
|
+
|
|
|
+(* Empty entry *)
|
|
|
+let empty_entry () =
|
|
|
+ new entry ~tags:[] ""
|
|
|
+;;
|
|
|
+
|
|
|
+(* Import from older version *)
|
|
|
+let import ~from ~to_file =
|
|
|
+ let imported_rc : t = init ~rc:to_file () in
|
|
|
+ let to_import : File_com.t = File_com.init_rc ~rc:from () in
|
|
|
+ to_import.progs |> List.map ~f:(new entry)
|
|
|
+ |> imported_rc#change_entries
|
|
|
+ |> fun rc -> rc#write;
|
|
|
+ Messages.ok "Import successful!";
|
|
|
+ sprintf "from: %s; to: %s" (Lazy.force from) (Lazy.force to_file)
|
|
|
+ |> Messages.tips
|
|
|
+;;
|
|
|
+
|