35
36:- module(settings,
37 [ setting/4, 38 setting/2, 39 set_setting/2, 40 set_setting_default/2, 41 restore_setting/1, 42 load_settings/1, 43 load_settings/2, 44 save_settings/0,
45 save_settings/1, 46 current_setting/1, 47 setting_property/2, 48 list_settings/0,
49 list_settings/1, 50
51 convert_setting_text/3 52 ]). 53:- use_module(library(error)). 54:- use_module(library(broadcast)). 55:- use_module(library(debug)). 56:- use_module(library(option)). 57:- use_module(library(arithmetic)). 58:- set_prolog_flag(generate_debug_info, false). 59
87
88:- dynamic
89 st_value/3, 90 st_default/3, 91 local_file/1. 92
93:- multifile
94 current_setting/6. 95
96:- meta_predicate
97 setting(:, +, +, +),
98 setting(:, ?),
99 set_setting(:, +),
100 set_setting_default(:, +),
101 current_setting(:),
102 restore_setting(:). 103
104:- predicate_options(load_settings/2, 2, [undefined(oneof([load,error]))]). 105
106curr_setting(Name, Module, Type, Default, Comment, Src) :-
107 current_setting(Name, Module, Type, Default0, Comment, Src),
108 ( st_default(Name, Module, Default1)
109 -> Default = Default1
110 ; Default = Default0
111 ).
112
129
130
131setting(Name, Type, Default, Comment) :-
132 throw(error(context_error(nodirective,
133 setting(Name, Type, Default, Comment)),
134 _)).
135
136:- multifile
137 system:term_expansion/2. 138
139system:term_expansion((:- setting(QName, Type, Default, Comment)),
140 Expanded) :-
141 \+ current_prolog_flag(xref, true),
142 prolog_load_context(module, M0),
143 strip_module(M0:QName, Module, Name),
144 must_be(atom, Name),
145 to_atom(Comment, CommentAtom),
146 eval_default(Default, Module, Type, Value),
147 check_type(Type, Value),
148 source_location(File, Line),
149 ( current_setting(Name, Module, OType, ODef, _, OldLoc),
150 ( OType \=@= Type
151 ; ODef \=@= Default
152 ),
153 OldLoc \= (File:_)
154 -> format(string(Message),
155 'Already defined at: ~w', [OldLoc]),
156 throw(error(permission_error(redefine, setting, Module:Name),
157 context(Message, _)))
158 ; Expanded = settings:current_setting(Name, Module, Type, Default,
159 CommentAtom, File:Line)
160 ).
161
162to_atom(Atom, Atom) :-
163 atom(Atom),
164 !.
165to_atom(String, Atom) :-
166 format(atom(Atom), '~s', String).
167
177
178setting(Module:Name, Value) :-
179 ( nonvar(Name), nonvar(Module)
180 -> ( st_value(Name, Module, Value0)
181 -> Value = Value0
182 ; curr_setting(Name, Module, Type, Default, _, _)
183 -> eval_default(Default, Module, Type, Value)
184 ; existence_error(setting, Module:Name)
185 )
186 ; current_setting(Name, Module, _, _, _, _),
187 setting(Module:Name, Value)
188 ).
189
190
191:- dynamic
192 setting_cache/3. 193:- volatile
194 setting_cache/3. 195
199
200clear_setting_cache :-
201 retractall(setting_cache(_,_,_)).
202
226
227:- multifile
228 eval_default/3. 229
230eval_default(Default, _, _Type, Value) :-
231 var(Default),
232 !,
233 Value = Default.
234eval_default(Default, _, Type, Value) :-
235 eval_default(Default, Type, Val),
236 !,
237 Value = Val.
238eval_default(Default, _, _, Value) :-
239 atomic(Default),
240 !,
241 Value = Default.
242eval_default(Default, _, Type, Value) :-
243 setting_cache(Default, Type, Val),
244 !,
245 Value = Val.
246eval_default(env(Name), _, Type, Value) :-
247 !,
248 ( getenv(Name, TextValue)
249 -> convert_setting_text(Type, TextValue, Val),
250 assert(setting_cache(env(Name), Type, Val)),
251 Value = Val
252 ; existence_error(environment_variable, Name)
253 ).
254eval_default(env(Name, Default), _, Type, Value) :-
255 !,
256 ( getenv(Name, TextValue)
257 -> convert_setting_text(Type, TextValue, Val)
258 ; Val = Default
259 ),
260 assert(setting_cache(env(Name), Type, Val)),
261 Value = Val.
262eval_default(setting(Name), Module, Type, Value) :-
263 !,
264 strip_module(Module:Name, M, N),
265 setting(M:N, Value),
266 must_be(Type, Value).
267eval_default(Expr, _, Type, Value) :-
268 numeric_type(Type, Basic),
269 !,
270 arithmetic_expression_value(Expr, Val0),
271 ( Basic == float
272 -> Val is float(Val0)
273 ; Basic = integer
274 -> Val is round(Val0)
275 ; Val = Val0
276 ),
277 assert(setting_cache(Expr, Type, Val)),
278 Value = Val.
279eval_default(A+B, Module, atom, Value) :-
280 !,
281 phrase(expr_to_list(A+B, Module), L),
282 atomic_list_concat(L, Val),
283 assert(setting_cache(A+B, atom, Val)),
284 Value = Val.
285eval_default(List, Module, list(Type), Value) :-
286 !,
287 eval_list_default(List, Module, Type, Val),
288 assert(setting_cache(List, list(Type), Val)),
289 Value = Val.
290eval_default(Default, _, _, Default).
291
292
296
297eval_list_default([], _, _, []).
298eval_list_default([H0|T0], Module, Type, [H|T]) :-
299 eval_default(H0, Module, Type, H),
300 eval_list_default(T0, Module, Type, T).
301
306
307expr_to_list(A+B, Module) -->
308 !,
309 expr_to_list(A, Module),
310 expr_to_list(B, Module).
311expr_to_list(env(Name), _) -->
312 !,
313 ( { getenv(Name, Text) }
314 -> [Text]
315 ; { existence_error(environment_variable, Name) }
316 ).
317expr_to_list(env(Name, Default), _) -->
318 !,
319 ( { getenv(Name, Text) }
320 -> [Text]
321 ; [Default]
322 ).
323expr_to_list(setting(Name), Module) -->
324 !,
325 { strip_module(Module:Name, M, N),
326 setting(M:N, Value)
327 },
328 [ Value ].
329expr_to_list(A, _) -->
330 [A].
331
337
338:- arithmetic_function(env/1). 339:- arithmetic_function(env/2). 340
341env(Name, Value) :-
342 ( getenv(Name, Text)
343 -> convert_setting_text(number, Text, Value)
344 ; existence_error(environment_variable, Name)
345 ).
346env(Name, Default, Value) :-
347 ( getenv(Name, Text)
348 -> convert_setting_text(number, Text, Value)
349 ; Value = Default
350 ).
351
352
358
359numeric_type(integer, integer).
360numeric_type(nonneg, integer).
361numeric_type(float, float).
362numeric_type(between(L,_), Type) :-
363 ( integer(L) -> Type = integer ; Type = float ).
364
365
376
377set_setting(QName, Value) :-
378 strip_module(QName, Module, Name),
379 must_be(atom, Name),
380 ( curr_setting(Name, Module, Type, Default0, _Comment, _Src),
381 eval_default(Default0, Module, Type, Default)
382 -> setting(Module:Name, Old),
383 ( Value == Default
384 -> retract_setting(Module:Name)
385 ; st_value(Name, Module, Value)
386 -> true
387 ; check_type(Type, Value)
388 -> retract_setting(Module:Name),
389 assert_setting(Module:Name, Value)
390 ),
391 ( Old == Value
392 -> true
393 ; broadcast(settings(changed(Module:Name, Old, Value))),
394 clear_setting_cache 395 )
396 ; existence_error(setting, Name)
397 ).
398
399retract_setting(Module:Name) :-
400 retractall(st_value(Name, Module, _)).
401
402assert_setting(Module:Name, Value) :-
403 assert(st_value(Name, Module, Value)).
404
410
411restore_setting(QName) :-
412 strip_module(QName, Module, Name),
413 must_be(atom, Name),
414 ( st_value(Name, Module, Old)
415 -> retract_setting(Module:Name),
416 setting(Module:Name, Value),
417 ( Old \== Value
418 -> broadcast(settings(changed(Module:Name, Old, Value)))
419 ; true
420 )
421 ; true
422 ).
423
430
431set_setting_default(QName, Default) :-
432 strip_module(QName, Module, Name),
433 must_be(atom, Name),
434 ( current_setting(Name, Module, Type, Default0, _Comment, _Src)
435 -> retractall(settings:st_default(Name, Module, _)),
436 retract_setting(Module:Name),
437 ( Default == Default0
438 -> true
439 ; assert(settings:st_default(Name, Module, Default))
440 ),
441 eval_default(Default, Module, Type, Value),
442 set_setting(Module:Name, Value)
443 ; existence_error(setting, Module:Name)
444 ).
445
446
447 450
455
456check_type(Type, Term) :-
457 must_be(Type, Term).
458
459
460 463
475
476load_settings(File) :-
477 load_settings(File, []).
478
479load_settings(File, Options) :-
480 absolute_file_name(File, Path,
481 [ access(read),
482 file_errors(fail)
483 ]),
484 !,
485 assert(local_file(Path)),
486 open(Path, read, In, [encoding(utf8)]),
487 read_setting(In, T0),
488 call_cleanup(load_settings(T0, In, Options), close(In)),
489 clear_setting_cache.
490load_settings(File, _) :-
491 absolute_file_name(File, Path,
492 [ access(write),
493 file_errors(fail)
494 ]),
495 !,
496 assert(local_file(Path)).
497load_settings(_, _).
498
499load_settings(end_of_file, _, _) :- !.
500load_settings(Setting, In, Options) :-
501 catch(store_setting(Setting, Options), E,
502 print_message(warning, E)),
503 read_setting(In, Next),
504 load_settings(Next, In, Options).
505
506read_setting(In, Term) :-
507 read_term(In, Term,
508 [ syntax_errors(dec10)
509 ]).
510
514
515store_setting(setting(Module:Name, Value), _) :-
516 curr_setting(Name, Module, Type, Default0, _Commentm, _Src),
517 !,
518 eval_default(Default0, Module, Type, Default),
519 ( Value == Default
520 -> true
521 ; check_type(Type, Value)
522 -> retractall(st_value(Name, Module, _)),
523 assert(st_value(Name, Module, Value)),
524 broadcast(settings(changed(Module:Name, Default, Value)))
525 ).
526store_setting(setting(Module:Name, Value), Options) :-
527 !,
528 ( option(undefined(load), Options, load)
529 -> retractall(st_value(Name, Module, _)),
530 assert(st_value(Name, Module, Value))
531 ; existence_error(setting, Module:Name)
532 ).
533store_setting(Term, _) :-
534 type_error(setting, Term).
535
540
541save_settings :-
542 local_file(File),
543 !,
544 save_settings(File).
545
546save_settings(File) :-
547 absolute_file_name(File, Path,
548 [ access(write)
549 ]),
550 !,
551 open(Path, write, Out,
552 [ encoding(utf8),
553 bom(true)
554 ]),
555 write_setting_header(Out),
556 forall(current_setting(Name, Module, _, _, _, _),
557 save_setting(Out, Module:Name)),
558 close(Out).
559
560
(Out) :-
562 get_time(Now),
563 format_time(string(Date), '%+', Now),
564 format(Out, '/* Saved settings~n', []),
565 format(Out, ' Date: ~w~n', [Date]),
566 format(Out, '*/~n~n', []).
567
568save_setting(Out, Module:Name) :-
569 curr_setting(Name, Module, Type, Default, Comment, _Src),
570 ( st_value(Name, Module, Value),
571 \+ ( eval_default(Default, Module, Type, DefValue),
572 debug(setting, '~w <-> ~w~n', [DefValue, Value]),
573 DefValue =@= Value
574 )
575 -> format(Out, '~n%\t~w~n', [Comment]),
576 format(Out, 'setting(~q:~q, ~q).~n', [Module, Name, Value])
577 ; true
578 ).
579
583
584current_setting(Setting) :-
585 ground(Setting),
586 !,
587 strip_module(Setting, Module, Name),
588 current_setting(Name, Module, _, _, _, _).
589current_setting(Module:Name) :-
590 current_setting(Name, Module, _, _, _, _).
591
605
606setting_property(Setting, Property) :-
607 ground(Setting),
608 !,
609 Setting = Module:Name,
610 curr_setting(Name, Module, Type, Default, Comment, Src),
611 !,
612 setting_property(Property, Module, Type, Default, Comment, Src).
613setting_property(Setting, Property) :-
614 Setting = Module:Name,
615 curr_setting(Name, Module, Type, Default, Comment, Src),
616 setting_property(Property, Module, Type, Default, Comment, Src).
617
618setting_property(type(Type), _, Type, _, _, _).
619setting_property(default(Default), M, Type, Default0, _, _) :-
620 eval_default(Default0, M, Type, Default).
621setting_property(comment(Comment), _, _, _, Comment, _).
622setting_property(source(Src), _, _, _, _, Src).
623
631
632list_settings :-
633 list_settings(_).
634
635list_settings(Spec) :-
636 spec_term(Spec, Term),
637 TS1 = 25,
638 TS2 = 40,
639 format('~`=t~72|~n'),
640 format('~w~t~*| ~w~w~t~*| ~w~n',
641 ['Name', TS1, 'Value (*=modified)', '', TS2, 'Comment']),
642 format('~`=t~72|~n'),
643 forall(current_setting(Term),
644 list_setting(Term, TS1, TS2)).
645
646spec_term(M:S, M:S) :- !.
647spec_term(M, M:_).
648
649
650list_setting(Module:Name, TS1, TS2) :-
651 curr_setting(Name, Module, Type, Default0, Comment, _Src),
652 eval_default(Default0, Module, Type, Default),
653 setting(Module:Name, Value),
654 ( Value \== Default
655 -> Modified = (*)
656 ; Modified = ''
657 ),
658 format('~w~t~*| ~q~w~t~*| ~w~n', [Module:Name, TS1, Value, Modified, TS2, Comment]).
659
660
661 664
672
673:- multifile
674 convert_text/3. 675
676convert_setting_text(Type, Text, Value) :-
677 convert_text(Type, Text, Value),
678 !.
679convert_setting_text(atom, Value, Value) :-
680 !,
681 must_be(atom, Value).
682convert_setting_text(boolean, Value, Value) :-
683 !,
684 must_be(boolean, Value).
685convert_setting_text(integer, Atom, Number) :-
686 !,
687 term_to_atom(Term, Atom),
688 Number is round(Term).
689convert_setting_text(float, Atom, Number) :-
690 !,
691 term_to_atom(Term, Atom),
692 Number is float(Term).
693convert_setting_text(between(L,U), Atom, Number) :-
694 !,
695 ( integer(L)
696 -> convert_setting_text(integer, Atom, Number)
697 ; convert_setting_text(float, Atom, Number)
698 ),
699 must_be(between(L,U), Number).
700convert_setting_text(Type, Atom, Term) :-
701 term_to_atom(Term, Atom),
702 must_be(Type, Term).
703
704
705 708
709:- multifile
710 sandbox:safe_meta_predicate/1. 711
712sandbox:safe_meta_predicate(settings:setting/2)