X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2Focaml%2Fregistry%2Fhelm_registry.mli;fp=helm%2Focaml%2Fregistry%2Fhelm_registry.mli;h=0000000000000000000000000000000000000000;hp=1f40b5453fa0e352b859e352b41b4b9426d53c23;hb=1696761e4b8576e8ed81caa905fd108717019226;hpb=5325734bc2e4927ed7ec146e35a6f0f2b49f50c1 diff --git a/helm/ocaml/registry/helm_registry.mli b/helm/ocaml/registry/helm_registry.mli deleted file mode 100644 index 1f40b5453..000000000 --- a/helm/ocaml/registry/helm_registry.mli +++ /dev/null @@ -1,193 +0,0 @@ -(* Copyright (C) 2004, HELM Team. - * - * This file is part of HELM, an Hypertextual, Electronic - * Library of Mathematics, developed at the Computer Science - * Department, University of Bologna, Italy. - * - * HELM 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. - * - * HELM 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 HELM; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, - * MA 02111-1307, USA. - * - * For details, see the HELM World-Wide-Web page, - * http://helm.cs.unibo.it/ - *) - -(** Configuration repository for HELM applications. - * - * ++ Keys format ++ - * - * key ::= path - * path ::= component ( '.' component )* - * component ::= ( lowercase_alpha | num | '_' )+ - * # with the only exception that sequences of '_' longer than 1 aren't valid - * # components - * - * Suggested usage .: - * e.g. gTopLevel.prooffile, http_getter.port, ... - * - * ++ Configuration file example ++ - * - * gTopLevel.prooffile = "/home/zack/prooffile" - * http_getter.port = "58080" - * - * ++ Environment variable override ++ - * - * each key has an associated environment variable name. At runtime (i.e. when - * "get" requests are performed) a variable with this name will be looked for, - * if it's defined it will override the value present (or absent) in the - * registry. - * Environment variables are _not_ considered when saving the configuration to - * a configuration file (via "save_to" function below) . - * - * Mapping between keys and environment variables is as follows: - * - the whole key is uppercased - * - each "." is converted to "__" - * E.g.: my.foo_ish.application -> MY__FOO_ISH__APPLICATION - * - * ++ Variable interpolation ++ - * - * Interpolation is supported with the following syntax: - * - * foo.bar = "quux" - * foo.baz = $(foo.bar)/baz - *) - - (** raised when a looked up key can't be found - * @param key looked up key *) -exception Key_not_found of string - - (** raised when a cyclic definitions is found, e.g. after - * Helm_registry.set "a" "$b" - * Helm_registry.set "b" "$a" - * @param msg brief description of the definition cycle *) -exception Cyclic_definition of string - - (** raised when a looked up key doesn't have the required type - * @param expected_type - * @param value - * @param msg *) -exception Type_error of string * string * string - - (** raised when a malformed key is encountered - * @param key malformed key *) -exception Malformed_key of string - - (** raised when an error is encountered while parsing a configuration file - * @param fname file name - * @param line line number - * @param col column number - * @param msg error description - *) -exception Parse_error of string * int * int * string - - (** raised when a given pair fails validity test(s) - * @param pair pair - * @param descr description of the failed test *) -exception Invalid_value of (string * string) * string - -(** {2 Generic untyped interface} - * Using the functions below this module could be used as a repository of - * key/value pairs *) - - (** lookup key in registry with environment variable override *) -val get: string -> string -val set: key:string -> value:string -> unit - - (** remove a key from the current environment, next get over this key will - * raise Key_not_found until the key will be redefined *) -val unset: string -> unit - -(** {2 Typed interface} - * Three basic types are supported: strings, int and strings list. Strings - * correspond literally to what is written inside double quotes; int to the - * parsing of an integer number from ; strings list to the splitting at blanks - * of it (heading and trailing blanks are removed before splitting) *) - -val get_string: string -> string (* alias for bare "get" above *) -val get_int: string -> int -val get_float: string -> float -val get_bool: string -> bool -val get_string_list: string -> string list - - (* alias for bare "set" above *) -val set_string: key:string -> value:string -> unit -val set_int: key:string -> value:int -> unit -val set_float: key:string -> value:float -> unit -val set_bool: key:string -> value:bool -> unit -val set_string_list: key:string -> value:string list -> unit - -(** {3 Optional values interface} - * Functions below took as first argument respectively a "getter" and a "setter" - * function. A getter is one of the get_* function above, a setter is one of the - * set_* function above. Returned value is a get (set) function typed as the - * given getter (setter) whith optional values. None is returned for missing - * keys and None can be assigned to a key removing it from the registry. - * - * Sample usage: - * - * match Helm_registry.get_opt Helm_registry.get_int "foo.bar" with - * | Some i -> ... - * | None -> ... - *) - -val get_opt: - (string -> 'a) (* getter *) -> - string -> 'a option -val set_opt: - (key:string -> value:'a -> unit) (* setter *) -> - key:string -> value:'a option -> unit -val get_opt_default: (* as get_opt with an additional default value *) - (string -> 'a) -> 'a -> string -> 'a - -(** {2 Validators} - * Each key may have zero or more associated validators, that are predicates - * "this value is valid for this key". Each time a value is set, all validators - * associated to the corresponding key are executed, if at least one of them - * fails, Invalid_value exception will be raised *) - -type validator_id - - (** register a new validator for a given key - * @param key key to which validator applies - * @param validator a function applying to a value returning true if that - * value is valid, false otherwise - * @param descr validator description, for the final user when a validation - * attempt fails - * @return validator_id should be used to remove the validator later on *) -val add_validator: - key:string -> validator:(string -> bool) -> descr:string -> - validator_id -(* val remove_validator: validator_id -> unit *) - -(** {2 Persistent configuration} - * Validators aren't saved. load_from/save_to sequences don't preserve comments - *) - - (** @param fname file to which save current configuration - * If xmllint is available then it will be used for pretty printing fname, - * otherwise fname will be in the usual pxp ugly format *) -val save_to: string -> unit - - (** @param fname file from which load new configuration. If it's an absolute - * file name "path" argument is ignored. - * Otherwise given file name is looked up in each directory member of the - * given path. Each matching file is loaded overriding previous settings. If - * no path is given a default path composed of just the current working - * directory is used. - *) -val load_from: ?path:string list -> string -> unit - -(* DEBUGGING *) -(* val dump: unit -> unit *) -