Chris@0: /* This file is part of ClioPatria. Chris@0: Chris@0: Author: Chris@0: HTTP: http://e-culture.multimedian.nl/ Chris@0: GITWEB: http://gollem.science.uva.nl/git/ClioPatria.git Chris@0: GIT: git://gollem.science.uva.nl/home/git/ClioPatria.git Chris@0: GIT: http://gollem.science.uva.nl/home/git/ClioPatria.git Chris@0: Copyright: 2007, E-Culture/MultimediaN Chris@0: Chris@0: ClioPatria is free software: you can redistribute it and/or modify Chris@0: it under the terms of the GNU General Public License as published by Chris@0: the Free Software Foundation, either version 2 of the License, or Chris@0: (at your option) any later version. Chris@0: Chris@0: ClioPatria is distributed in the hope that it will be useful, Chris@0: but WITHOUT ANY WARRANTY; without even the implied warranty of Chris@0: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Chris@0: GNU General Public License for more details. Chris@0: Chris@0: You should have received a copy of the GNU General Public License Chris@0: along with ClioPatria. If not, see . Chris@0: */ Chris@0: Chris@0: :- module(settings, Chris@0: [ setting/4, % :Name, +Type, +Default, +Comment, +Src Chris@0: setting/2, % :Name, ?Value Chris@0: set_setting/2, % :Name, +Value Chris@0: restore_setting/1, % :Name Chris@0: load_settings/1, % +File Chris@0: load_settings/2, % +File, +Options Chris@0: save_settings/0, Chris@0: save_settings/1, % +File Chris@0: current_setting/1, % Module:Name Chris@0: setting_property/2, % ?Setting, ?Property Chris@0: list_settings/0, Chris@0: Chris@0: convert_setting_text/3 % +Type, +Text, -Value Chris@0: ]). Chris@0: :- use_module(library(error)). Chris@0: :- use_module(library(broadcast)). Chris@0: :- use_module(library(debug)). Chris@0: :- use_module(library(option)). Chris@0: Chris@0: /** Setting management Chris@0: Chris@0: This library allows management of configuration settings for Prolog Chris@0: applications. Applications define settings in one or multiple files Chris@0: using the directive setting/4 as illustrated below: Chris@0: Chris@0: == Chris@0: :- use_module(library(setting)). Chris@0: Chris@0: :- setting(version, atom, '1.0', 'Current version'). Chris@0: :- setting(timeout, number, 20, 'Timeout in seconds'). Chris@0: == Chris@0: Chris@0: The directive is subject to term_expansion/2, which guarantees proper Chris@0: synchronisation of the database if source-files are reloaded. This Chris@0: implies it is *not* possible to call setting/4 as a predicate. Chris@0: Chris@0: Settings are local to a module. This implies they are defined in a Chris@0: two-level namespace. Managing settings per module greatly simplifies Chris@0: assembling large applications from multiple modules that configuration Chris@0: through settings. This settings management library ensures proper Chris@0: access, loading and saving of settings. Chris@0: Chris@0: @see library(config) distributed with XPCE provides an alternative Chris@0: aimed at graphical applications. Chris@0: @author Jan Wielemaker Chris@0: */ Chris@0: Chris@0: :- dynamic Chris@0: value/3, % Name, Module, Value Chris@0: local_file/1. % Path Chris@0: Chris@0: :- multifile Chris@0: current_setting/6. % Name, Module, Type, Default, Comment, Source Chris@0: Chris@0: :- module_transparent Chris@0: setting(:, +, +, +), Chris@0: setting(:, ?), Chris@0: set_setting(:, +), Chris@0: current_setting(:), Chris@0: restore_setting(:). Chris@0: Chris@0: %% setting(Name, Type, Default, Comment) is det. Chris@0: % Chris@0: % Define a setting. Name denotes the name of the setting, Type its Chris@0: % type. Default is the value before it is modified. Default refer Chris@0: % to environment variables and use arithmetic expressions as Chris@0: % defined by eval_default/4. Chris@0: % Chris@0: % @param Name Name of the setting (an atom) Chris@0: % @param Type Type for setting. One of =any= or a type defined Chris@0: % by must_be/2. Chris@0: % @param Default Default value for the setting. Chris@0: % @param Comment Atom containing a (short) descriptive note. Chris@0: Chris@0: Chris@0: setting(_Name, _Type, _Default, _Comment) :- Chris@0: throw(error(context_error(only_in_directive), _)). Chris@0: Chris@0: :- multifile Chris@0: user:term_expansion/2. Chris@0: Chris@0: user:term_expansion((:- setting(QName, Type, Default, Comment)), Chris@0: Expanded) :- Chris@0: prolog_load_context(module, M0), Chris@0: strip_module(M0:QName, Module, Name), Chris@0: must_be(atom, Name), Chris@0: to_atom(Comment, CommentAtom), Chris@0: eval_default(Default, Module, Type, Value), Chris@0: check_type(Type, Value), Chris@0: ( current_setting(Name, Module, _, _, _, OldLoc) Chris@0: -> format(string(Message), Chris@0: 'Already defined at: ~w', [OldLoc]), Chris@0: throw(error(permission_error(redefine, setting, Name), Chris@0: context(Message, _))) Chris@0: ; source_location(File, Line) Chris@0: -> Expanded = settings:current_setting(Name, Module, Type, Default, Chris@0: CommentAtom, File:Line) Chris@0: ). Chris@0: Chris@0: to_atom(Atom, Atom) :- Chris@0: atom(Atom), !. Chris@0: to_atom(String, Atom) :- Chris@0: format(atom(Atom), '~s', String). Chris@0: Chris@0: %% setting(:Name, ?Value) is nondet. Chris@0: % Chris@0: % True if Name is a currently defined setting with Value. Chris@0: % Chris@0: % @error existence_error(setting, Name) Chris@0: Chris@0: setting(QName, Value) :- Chris@0: strip_module(QName, Module, Name), Chris@0: ( ground(Name) Chris@0: -> ( value(Name, Module, Value0) Chris@0: -> Value = Value0 Chris@0: ; current_setting(Name, Module, Type, Default, _, _) Chris@0: -> eval_default(Default, Module, Type, Value) Chris@0: ; existence_error(setting, Module:Name) Chris@0: ) Chris@0: ; current_setting(Name, Module, _, _, _, _), Chris@0: setting(Module:Name, Value) Chris@0: ). Chris@0: Chris@0: Chris@0: %% eval_default(+Default, +Module, +Type, -Value) is det. Chris@0: % Chris@0: % Convert the settings default value. The notation allows for some Chris@0: % `function-style' notations to make the library more generic: Chris@0: % Chris@0: % * env(Name) Chris@0: % Get value from the given environment variable. The value Chris@0: % is handed to convert_setting_text/3 to convert the Chris@0: % textual representation into a Prolog term. Raises an Chris@0: % existence_error of the variable is not defined. Chris@0: % Chris@0: % * env(Name, Default) Chris@0: % As env(Name), but uses the value Default if the variable Chris@0: % is not defined. Chris@0: % Chris@0: % * setting(Name) Chris@0: % Ask the value of another setting. Chris@0: % Chris@0: % * Expression Chris@0: % If Type is numeric, evaluate the expression. env(Var) Chris@0: % evaluates to the value of an environment variable. Chris@0: % If Type is =atom=, concatenate A+B+.... Elements of the Chris@0: % expression can be env(Name). Chris@0: Chris@0: :- dynamic Chris@0: setting_cache/3. Chris@0: :- volatile Chris@0: setting_cache/3. Chris@0: Chris@0: :- multifile Chris@0: eval_default/3. % +Default, +Type, -Value Chris@0: Chris@0: eval_default(Default, _, Type, Value) :- Chris@0: eval_default(Default, Type, Val), !, Chris@0: Value = Val. Chris@0: eval_default(Default, _, _, Value) :- Chris@0: atomic(Default), !, Chris@0: Value = Default. Chris@0: eval_default(Default, _, Type, Value) :- Chris@0: setting_cache(Default, Type, Val), !, Chris@0: Value = Val. Chris@0: eval_default(env(Name), _, Type, Value) :- !, Chris@0: ( getenv(Name, TextValue) Chris@0: -> convert_setting_text(Type, TextValue, Val), Chris@0: assert(setting_cache(env(Name), Type, Val)), Chris@0: Value = Val Chris@0: ; existence_error(environment_variable, Name) Chris@0: ). Chris@0: eval_default(env(Name, Default), _, Type, Value) :- !, Chris@0: ( getenv(Name, TextValue) Chris@0: -> convert_setting_text(Type, TextValue, Val) Chris@0: ; Value = Default Chris@0: ), Chris@0: assert(setting_cache(env(Name), Type, Val)), Chris@0: Value = Val. Chris@0: eval_default(setting(Name), Module, Type, Value) :- !, Chris@0: strip_module(Module:Name, M, N), Chris@0: setting(M:N, Value), Chris@0: must_be(Type, Value). Chris@0: eval_default(Expr, _, Type, Value) :- Chris@0: numeric_type(Type, Basic), !, Chris@0: Val0 is Expr, Chris@0: ( Basic == float Chris@0: -> Val is float(Val0) Chris@0: ; Basic = integer Chris@0: -> Val is round(Val0) Chris@0: ; Val = Val0 Chris@0: ), Chris@0: assert(setting_cache(Expr, Type, Val)), Chris@0: Value = Val. Chris@0: eval_default(A+B, Module, atom, Value) :- !, Chris@0: phrase(expr_to_list(A+B, Module), L), Chris@0: concat_atom(L, Val), Chris@0: assert(setting_cache(A+B, atom, Val)), Chris@0: Value = Val. Chris@0: eval_default(List, Module, list(Type), Value) :- !, Chris@0: eval_list_default(List, Module, Type, Val), Chris@0: assert(setting_cache(List, list(Type), Val)), Chris@0: Value = Val. Chris@0: eval_default(Default, _, _, Default). Chris@0: Chris@0: Chris@0: %% eval_list_default(+List, +Module, +ElementType, -DefaultList) Chris@0: % Chris@0: % Evaluate the default for a list of values. Chris@0: Chris@0: eval_list_default([], _, _, []). Chris@0: eval_list_default([H0|T0], Module, Type, [H|T]) :- Chris@0: eval_default(H0, Module, Type, H), Chris@0: eval_list_default(T0, Module, Type, T). Chris@0: Chris@0: %% expr_to_list(+Expression, +Module)// is det. Chris@0: % Chris@0: % Process the components to create an atom. Atom concatenation is Chris@0: % expressed as A+B. Components may refer to envrionment variables. Chris@0: Chris@0: expr_to_list(A+B, Module) --> !, Chris@0: expr_to_list(A, Module), Chris@0: expr_to_list(B, Module). Chris@0: expr_to_list(env(Name), _) --> !, Chris@0: ( { getenv(Name, Text) } Chris@0: -> [Text] Chris@0: ; { existence_error(environment_variable, Name) } Chris@0: ). Chris@0: expr_to_list(env(Name, Default), _) --> !, Chris@0: ( { getenv(Name, Text) } Chris@0: -> [Text] Chris@0: ; [Default] Chris@0: ). Chris@0: expr_to_list(setting(Name), Module) --> !, Chris@0: { strip_module(Module:Name, M, N), Chris@0: setting(M:N, Value) Chris@0: }, Chris@0: [ Value ]. Chris@0: expr_to_list(A, _) --> Chris@0: [A]. Chris@0: Chris@0: %% env(+Name:atom, -Value:number) is det. Chris@0: %% env(+Name:atom, +Default:number, -Value:number) is det Chris@0: % Chris@0: % Evaluate environment variables on behalf of arithmetic Chris@0: % expressions. Chris@0: Chris@0: :- arithmetic_function(env/1). Chris@0: :- arithmetic_function(env/2). Chris@0: Chris@0: env(Name, Value) :- Chris@0: ( getenv(Name, Text) Chris@0: -> convert_setting_text(number, Text, Value) Chris@0: ; existence_error(environment_variable, Name) Chris@0: ). Chris@0: env(Name, Default, Value) :- Chris@0: ( getenv(Name, Text) Chris@0: -> convert_setting_text(number, Text, Value) Chris@0: ; Value = Default Chris@0: ). Chris@0: Chris@0: Chris@0: %% numeric_type(+Type, -BaseType) Chris@0: % Chris@0: % True if Type is a numeric type and BaseType is the associated Chris@0: % basic Prolog type. BaseType is one of =integer=, =float= or Chris@0: % =number=. Chris@0: Chris@0: numeric_type(integer, integer). Chris@0: numeric_type(nonneg, integer). Chris@0: numeric_type(float, float). Chris@0: numeric_type(between(L,_), Type) :- Chris@0: ( integer(L) -> Type = integer ; Type = float ). Chris@0: Chris@0: Chris@0: %% set_setting(:Name, +Value) is det. Chris@0: % Chris@0: % Change a setting. Performs existence and type-checking for the Chris@0: % setting. If the effective value of the setting is changed it Chris@0: % broadcasts the event below. Chris@0: % Chris@0: % settings(changed(Module:Name, Old, New)) Chris@0: % Chris@0: % @error existence_error(setting, Name) Chris@0: % @error type_error(Type, Value) Chris@0: Chris@0: set_setting(QName, Value) :- Chris@0: strip_module(QName, Module, Name), Chris@0: must_be(atom, Name), Chris@0: ( current_setting(Name, Module, Type, Default0, _Comment, _Src), Chris@0: eval_default(Default0, Module, Type, Default) Chris@0: -> ( Value == Default Chris@0: -> retract_setting(Module:Name) Chris@0: ; value(Name, Module, Value) Chris@0: -> true Chris@0: ; check_type(Type, Value) Chris@0: -> setting(Module:Name, Old), Chris@0: retract_setting(Module:Name), Chris@0: assert_setting(Module:Name, Value), Chris@0: broadcast(settings(changed(Module:Name, Old, Value))) Chris@0: ) Chris@0: ; existence_error(setting, Name) Chris@0: ). Chris@0: Chris@0: retract_setting(Module:Name) :- Chris@0: retractall(value(Name, Module, _)). Chris@0: Chris@0: assert_setting(Module:Name, Value) :- Chris@0: assert(value(Name, Module, Value)). Chris@0: Chris@0: %% restore_setting(:Name) is det. Chris@0: % Chris@0: % Restore the value of setting Name to its default. Broadcast a Chris@0: % change like set_setting/2 if the current value is not the Chris@0: % default. Chris@0: Chris@0: restore_setting(QName) :- Chris@0: strip_module(QName, Module, Name), Chris@0: must_be(atom, Name), Chris@0: ( value(Name, Module, Old) Chris@0: -> retract_setting(Module:Name), Chris@0: setting(Module:Name, Value), Chris@0: ( Old \== Value Chris@0: -> broadcast(settings(changed(Module:Name, Old, Value))) Chris@0: ; true Chris@0: ) Chris@0: ; true Chris@0: ). Chris@0: Chris@0: Chris@0: /******************************* Chris@0: * TYPES * Chris@0: *******************************/ Chris@0: Chris@0: %% check_type(+Type, +Term) Chris@0: % Chris@0: % Type checking for settings. Currently simply forwarded to Chris@0: % must_be/2. Chris@0: Chris@0: check_type(Type, Term) :- Chris@0: must_be(Type, Term). Chris@0: Chris@0: Chris@0: /******************************* Chris@0: * FILE * Chris@0: *******************************/ Chris@0: Chris@0: %% load_settings(File) is det. Chris@0: %% load_settings(File, +Options) is det. Chris@0: % Chris@0: % Load local settings from File. Succeeds if File does not exist, Chris@0: % setting the default save-file to File. Options are: Chris@0: % Chris@0: % * undefined(+Action) Chris@0: % Define how to handle settings that are not defined. When Chris@0: % =error=, an error is printed and the setting is ignored. Chris@0: % when =load=, the setting is loaded anyway, waiting for a Chris@0: % definition. Chris@0: Chris@0: load_settings(File) :- Chris@0: load_settings(File, []). Chris@0: Chris@0: load_settings(File, Options) :- Chris@0: absolute_file_name(File, Path, Chris@0: [ access(read), Chris@0: file_errors(fail) Chris@0: ]), !, Chris@0: assert(local_file(Path)), Chris@0: open(Path, read, In, [encoding(utf8)]), Chris@0: read_setting(In, T0), Chris@0: call_cleanup(load_settings(T0, In, Options), close(In)). Chris@0: load_settings(File, _) :- Chris@0: absolute_file_name(File, Path, Chris@0: [ access(write), Chris@0: file_errors(fail) Chris@0: ]), !, Chris@0: assert(local_file(Path)). Chris@0: load_settings(_, _). Chris@0: Chris@0: load_settings(end_of_file, _, _) :- !. Chris@0: load_settings(Setting, In, Options) :- Chris@0: catch(store_setting(Setting, Options), E, Chris@0: print_message(warning, E)), Chris@0: read_setting(In, Next), Chris@0: load_settings(Next, In, Options). Chris@0: Chris@0: read_setting(In, Term) :- Chris@0: read_term(In, Term, Chris@0: [ errors(dec10) Chris@0: ]). Chris@0: Chris@0: %% store_setting(Term, +Options) Chris@0: % Chris@0: % Store setting loaded from file in the Prolog database. Chris@0: Chris@0: store_setting(setting(Module:Name, Value), _) :- Chris@0: current_setting(Name, Module, Type, Default0, _Commentm, _Src), !, Chris@0: eval_default(Default0, Module, Type, Default), Chris@0: ( Value == Default Chris@0: -> true Chris@0: ; check_type(Type, Value), Chris@0: assert(value(Name, Module, Value)), Chris@0: broadcast(settings(changed(Module:Name, Default, Value))) Chris@0: ). Chris@0: store_setting(setting(Module:Name, Value), Options) :- Chris@0: ( option(undefined(load), Options, load) Chris@0: -> assert(value(Name, Module, Value)) Chris@0: ; existence_error(setting, Module:Name) Chris@0: ). Chris@0: store_setting(Term, _) :- Chris@0: type_error(setting, Term). Chris@0: Chris@0: %% save_settings is det. Chris@0: %% save_settings(+File) is det. Chris@0: % Chris@0: % Save modified settings to File. Chris@0: Chris@0: save_settings :- Chris@0: local_file(File), !, Chris@0: save_settings(File). Chris@0: Chris@0: save_settings(File) :- Chris@0: absolute_file_name(File, Path, Chris@0: [ access(write) Chris@0: ]), !, Chris@0: open(Path, write, Out, Chris@0: [ encoding(utf8), Chris@0: bom(true) Chris@0: ]), Chris@0: write_setting_header(Out), Chris@0: forall(current_setting(Name, Module, _, _, _, _), Chris@0: save_setting(Out, Module:Name)), Chris@0: close(Out). Chris@0: Chris@0: Chris@0: write_setting_header(Out) :- Chris@0: get_time(Now), Chris@0: format_time(string(Date), '%+', Now), Chris@0: format(Out, '/* Saved settings~n', []), Chris@0: format(Out, ' Date: ~w~n', [Date]), Chris@0: format(Out, '*/~n~n', []). Chris@0: Chris@0: save_setting(Out, Module:Name) :- Chris@0: current_setting(Name, Module, Type, Default, Comment, _Src), Chris@0: ( value(Name, Module, Value), Chris@0: \+ ( eval_default(Default, Module, Type, DefValue), Chris@0: debug(setting, '~w <-> ~w~n', [DefValue, Value]), Chris@0: DefValue =@= Value Chris@0: ) Chris@0: -> format(Out, '~n% ~w~n', [Comment]), Chris@0: format(Out, 'setting(~q:~q, ~q).~n', [Module, Name, Value]) Chris@0: ; true Chris@0: ). Chris@0: Chris@0: %% current_setting(?Setting) is nondet. Chris@0: % Chris@0: % True if Setting is a currently defined setting Chris@0: Chris@0: current_setting(Setting) :- Chris@0: ground(Setting), !, Chris@0: strip_module(Setting, Module, Name), Chris@0: current_setting(Name, Module, _, _, _, _). Chris@0: current_setting(Module:Name) :- Chris@0: current_setting(Name, Module, _, _, _, _). Chris@0: Chris@0: %% setting_property(+Setting, +Property) is det. Chris@0: %% setting_property(?Setting, ?Property) is nondet. Chris@0: % Chris@0: % Query currently defined settings. Property is one of Chris@0: % Chris@0: % * comment(-Atom) Chris@0: % * type(-Type) Chris@0: % Type of the setting. Chris@0: % * default(-Default) Chris@0: % Default value. If this is an expression, it is Chris@0: % evaluated. Chris@0: Chris@0: setting_property(Setting, Property) :- Chris@0: ground(Setting), !, Chris@0: Setting = Module:Name, Chris@0: current_setting(Name, Module, Type, Default, Comment, _Src), !, Chris@0: setting_property(Property, Module, Type, Default, Comment). Chris@0: setting_property(Setting, Property) :- Chris@0: Setting = Module:Name, Chris@0: current_setting(Name, Module, Type, Default, Comment, _Src), Chris@0: setting_property(Property, Module, Type, Default, Comment). Chris@0: Chris@0: setting_property(type(Type), _, Type, _, _). Chris@0: setting_property(default(Default), M, Type, Default0, _) :- Chris@0: eval_default(Default0, M, Type, Default). Chris@0: setting_property(comment(Comment), _, _, _, Comment). Chris@0: Chris@0: %% list_settings Chris@0: % Chris@0: % List settings to =current_output=. Chris@0: Chris@0: list_settings :- Chris@0: format('~`=t~72|~n'), Chris@0: format('~w~t~20| ~w~w~t~40| ~w~n', ['Name', 'Value (*=modified)', '', 'Comment']), Chris@0: format('~`=t~72|~n'), Chris@0: forall(current_setting(Setting), Chris@0: list_setting(Setting)). Chris@0: Chris@0: list_setting(Module:Name) :- Chris@0: current_setting(Name, Module, Type, Default0, Comment, _Src), Chris@0: eval_default(Default0, Module, Type, Default), Chris@0: setting(Module:Name, Value), Chris@0: ( Value \== Default Chris@0: -> Modified = (*) Chris@0: ; Modified = '' Chris@0: ), Chris@0: format('~w~t~20| ~q~w~t~40| ~w~n', [Module:Name, Value, Modified, Comment]). Chris@0: Chris@0: Chris@0: /******************************* Chris@0: * TYPES * Chris@0: *******************************/ Chris@0: Chris@0: %% convert_setting_text(+Type, +Text, -Value) Chris@0: % Chris@0: % Converts from textual form to Prolog Value. Used to convert Chris@0: % values obtained from the environment. Public to provide support Chris@0: % in user-interfaces to this library. Chris@0: % Chris@0: % @error type_error(Type, Value) Chris@0: Chris@0: :- multifile Chris@0: convert_text/3. % +Type, +Text, -Value Chris@0: Chris@0: convert_setting_text(Type, Text, Value) :- Chris@0: convert_text(Type, Text, Value), !. Chris@0: convert_setting_text(atom, Value, Value) :- !, Chris@0: must_be(atom, Value). Chris@0: convert_setting_text(boolean, Value, Value) :- !, Chris@0: must_be(boolean, Value). Chris@0: convert_setting_text(integer, Atom, Number) :- !, Chris@0: term_to_atom(Term, Atom), Chris@0: Number is round(Term). Chris@0: convert_setting_text(float, Atom, Number) :- !, Chris@0: term_to_atom(Term, Atom), Chris@0: Number is float(Term). Chris@0: convert_setting_text(between(L,U), Atom, Number) :- !, Chris@0: ( integer(L) Chris@0: -> convert_setting_text(integer, Atom, Number) Chris@0: ; convert_setting_text(float, Atom, Number) Chris@0: ), Chris@0: must_be(between(L,U), Number). Chris@0: convert_setting_text(Type, Atom, Term) :- Chris@0: term_to_atom(Term, Atom), Chris@0: must_be(Type, Term). Chris@0: Chris@0: