36
37:- module(settings,
38 [ setting/4, 39 setting/2, 40 set_setting/2, 41 set_setting_default/2, 42 restore_setting/1, 43 load_settings/1, 44 load_settings/2, 45 save_settings/0,
46 save_settings/1, 47 current_setting/1, 48 setting_property/2, 49 list_settings/0,
50 list_settings/1, 51
52 convert_setting_text/3 53 ]). 54:- use_module(library(arithmetic),[arithmetic_expression_value/2]). 55
56:- autoload(library(broadcast),[broadcast/1]). 57:- autoload(library(debug),[debug/3]). 58:- autoload(library(error),[must_be/2,existence_error/2,type_error/2]). 59:- autoload(library(option),[option/3]). 60
61:- set_prolog_flag(generate_debug_info, false). 62
90
91:- dynamic
92 st_value/3, 93 st_default/3, 94 local_file/1, 95 st_modified/0. 96
97:- multifile
98 current_setting/6. 99
100:- meta_predicate
101 setting(:, +, +, +),
102 setting(:, ?),
103 set_setting(:, +),
104 set_setting_default(:, +),
105 current_setting(:),
106 restore_setting(:). 107
108:- predicate_options(load_settings/2, 2, [undefined(oneof([load,error]))]). 109
110curr_setting(Name, Module, Type, Default, Comment, Src) :-
111 current_setting(Name, Module, Type, Default0, Comment, Src),
112 ( st_default(Name, Module, Default1)
113 -> Default = Default1
114 ; Default = Default0
115 ).
116
133
134
135setting(Name, Type, Default, Comment) :-
136 throw(error(context_error(nodirective,
137 setting(Name, Type, Default, Comment)),
138 _)).
139
140:- multifile
141 system:term_expansion/2. 142
143system:term_expansion((:- setting(QName, Type, Default, Comment)),
144 Expanded) :-
145 \+ current_prolog_flag(xref, true),
146 prolog_load_context(module, M0),
147 strip_module(M0:QName, Module, Name),
148 must_be(atom, Name),
149 to_atom(Comment, CommentAtom),
150 eval_default(Default, Module, Type, Value),
151 check_type(Type, Value),
152 source_location(File, Line),
153 ( current_setting(Name, Module, OType, ODef, _, OldLoc),
154 ( OType \=@= Type
155 ; ODef \=@= Default
156 ),
157 OldLoc \= (File:_)
158 -> format(string(Message),
159 'Already defined at: ~w', [OldLoc]),
160 throw(error(permission_error(redefine, setting, Module:Name),
161 context(Message, _)))
162 ; Expanded = settings:current_setting(Name, Module, Type, Default,
163 CommentAtom, File:Line)
164 ).
165
166to_atom(Atom, Atom) :-
167 atom(Atom),
168 !.
169to_atom(String, Atom) :-
170 format(atom(Atom), '~s', String).
171
181
182setting(Module:Name, Value) :-
183 ( nonvar(Name), nonvar(Module)
184 -> ( st_value(Name, Module, Value0)
185 -> Value = Value0
186 ; curr_setting(Name, Module, Type, Default, _, _)
187 -> eval_default(Default, Module, Type, Value)
188 ; existence_error(setting, Module:Name)
189 )
190 ; current_setting(Name, Module, _, _, _, _),
191 setting(Module:Name, Value)
192 ).
193
194
195:- dynamic
196 setting_cache/3. 197:- volatile
198 setting_cache/3. 199
203
204clear_setting_cache :-
205 retractall(setting_cache(_,_,_)).
206
230
231:- multifile
232 eval_default/3. 233
234eval_default(Default, _, _Type, Value) :-
235 var(Default),
236 !,
237 Value = Default.
238eval_default(Default, _, Type, Value) :-
239 eval_default(Default, Type, Val),
240 !,
241 Value = Val.
242eval_default(Default, _, _, Value) :-
243 atomic(Default),
244 !,
245 Value = Default.
246eval_default(Default, _, Type, Value) :-
247 setting_cache(Default, Type, Val),
248 !,
249 Value = Val.
250eval_default(env(Name), _, Type, Value) :-
251 !,
252 ( getenv(Name, TextValue)
253 -> convert_setting_text(Type, TextValue, Val),
254 assert(setting_cache(env(Name), Type, Val)),
255 Value = Val
256 ; existence_error(environment_variable, Name)
257 ).
258eval_default(env(Name, Default), _, Type, Value) :-
259 !,
260 ( getenv(Name, TextValue)
261 -> convert_setting_text(Type, TextValue, Val)
262 ; Val = Default
263 ),
264 assert(setting_cache(env(Name), Type, Val)),
265 Value = Val.
266eval_default(setting(Name), Module, Type, Value) :-
267 !,
268 strip_module(Module:Name, M, N),
269 setting(M:N, Value),
270 must_be(Type, Value).
271eval_default(Expr, _, Type, Value) :-
272 numeric_type(Type, Basic),
273 !,
274 arithmetic_expression_value(Expr, Val0),
275 ( Basic == float
276 -> Val is float(Val0)
277 ; Basic = integer
278 -> Val is round(Val0)
279 ; Val = Val0
280 ),
281 assert(setting_cache(Expr, Type, Val)),
282 Value = Val.
283eval_default(A+B, Module, atom, Value) :-
284 !,
285 phrase(expr_to_list(A+B, Module), L),
286 atomic_list_concat(L, Val),
287 assert(setting_cache(A+B, atom, Val)),
288 Value = Val.
289eval_default(List, Module, list(Type), Value) :-
290 !,
291 eval_list_default(List, Module, Type, Val),
292 assert(setting_cache(List, list(Type), Val)),
293 Value = Val.
294eval_default(Default, _, _, Default).
295
296
300
301eval_list_default([], _, _, []).
302eval_list_default([H0|T0], Module, Type, [H|T]) :-
303 eval_default(H0, Module, Type, H),
304 eval_list_default(T0, Module, Type, T).
305
310
311expr_to_list(A+B, Module) -->
312 !,
313 expr_to_list(A, Module),
314 expr_to_list(B, Module).
315expr_to_list(env(Name), _) -->
316 !,
317 ( { getenv(Name, Text) }
318 -> [Text]
319 ; { existence_error(environment_variable, Name) }
320 ).
321expr_to_list(env(Name, Default), _) -->
322 !,
323 ( { getenv(Name, Text) }
324 -> [Text]
325 ; [Default]
326 ).
327expr_to_list(setting(Name), Module) -->
328 !,
329 { strip_module(Module:Name, M, N),
330 setting(M:N, Value)
331 },
332 [ Value ].
333expr_to_list(A, _) -->
334 [A].
335
341
342:- arithmetic_function(env/1). 343:- arithmetic_function(env/2). 344
345env(Name, Value) :-
346 ( getenv(Name, Text)
347 -> convert_setting_text(number, Text, Value)
348 ; existence_error(environment_variable, Name)
349 ).
350env(Name, Default, Value) :-
351 ( getenv(Name, Text)
352 -> convert_setting_text(number, Text, Value)
353 ; Value = Default
354 ).
355
356
362
363numeric_type(integer, integer).
364numeric_type(nonneg, integer).
365numeric_type(float, float).
366numeric_type(between(L,_), Type) :-
367 ( integer(L) -> Type = integer ; Type = float ).
368
369
383
384set_setting(QName, Value) :-
385 strip_module(QName, Module, Name),
386 must_be(atom, Name),
387 ( curr_setting(Name, Module, Type, Default0, _Comment, _Src),
388 eval_default(Default0, Module, Type, Default)
389 -> setting(Module:Name, Old),
390 ( Value == Default
391 -> retract_setting(Module:Name)
392 ; st_value(Name, Module, Value)
393 -> true
394 ; check_type(Type, Value)
395 -> retract_setting(Module:Name),
396 assert_setting(Module:Name, Value)
397 ),
398 ( Old == Value
399 -> true
400 ; broadcast(settings(changed(Module:Name, Old, Value))),
401 clear_setting_cache 402 )
403 ; existence_error(setting, Name)
404 ).
405
406retract_setting(Module:Name) :-
407 set_settings_modified,
408 retractall(st_value(Name, Module, _)).
409
410assert_setting(Module:Name, Value) :-
411 set_settings_modified,
412 assert(st_value(Name, Module, Value)).
413
414set_settings_modified :-
415 st_modified, !.
416set_settings_modified :-
417 assertz(st_modified).
418
419
425
426restore_setting(QName) :-
427 strip_module(QName, Module, Name),
428 must_be(atom, Name),
429 ( st_value(Name, Module, Old)
430 -> retract_setting(Module:Name),
431 setting(Module:Name, Value),
432 ( Old \== Value
433 -> broadcast(settings(changed(Module:Name, Old, Value)))
434 ; true
435 )
436 ; true
437 ).
438
445
446set_setting_default(QName, Default) :-
447 strip_module(QName, Module, Name),
448 must_be(atom, Name),
449 ( current_setting(Name, Module, Type, Default0, _Comment, _Src)
450 -> retractall(settings:st_default(Name, Module, _)),
451 retract_setting(Module:Name),
452 ( Default == Default0
453 -> true
454 ; assert(settings:st_default(Name, Module, Default))
455 ),
456 eval_default(Default, Module, Type, Value),
457 set_setting(Module:Name, Value)
458 ; existence_error(setting, Module:Name)
459 ).
460
461
462 465
470
471check_type(Type, Term) :-
472 must_be(Type, Term).
473
474
475 478
494
495load_settings(File) :-
496 load_settings(File, []).
497
498load_settings(File, Options) :-
499 absolute_file_name(File, Path,
500 [ access(read),
501 file_errors(fail)
502 ]),
503 !,
504 assert(local_file(Path)),
505 open(Path, read, In, [encoding(utf8)]),
506 read_setting(In, T0),
507 call_cleanup(load_settings(T0, In, Options), close(In)),
508 clear_setting_cache.
509load_settings(File, _) :-
510 absolute_file_name(File, Path,
511 [ access(write),
512 file_errors(fail)
513 ]),
514 !,
515 assert(local_file(Path)).
516load_settings(_, _).
517
518load_settings(end_of_file, _, _) :- !.
519load_settings(Setting, In, Options) :-
520 catch(store_setting(Setting, Options), E,
521 print_message(warning, E)),
522 read_setting(In, Next),
523 load_settings(Next, In, Options).
524
525read_setting(In, Term) :-
526 read_term(In, Term,
527 [ syntax_errors(dec10)
528 ]).
529
533
534store_setting(setting(Module:Name, Value), _) :-
535 curr_setting(Name, Module, Type, Default0, _Commentm, _Src),
536 !,
537 eval_default(Default0, Module, Type, Default),
538 ( Value == Default
539 -> true
540 ; check_type(Type, Value)
541 -> retractall(st_value(Name, Module, _)),
542 assert(st_value(Name, Module, Value)),
543 broadcast(settings(changed(Module:Name, Default, Value)))
544 ).
545store_setting(setting(Module:Name, Value), Options) :-
546 !,
547 ( option(undefined(load), Options, load)
548 -> retractall(st_value(Name, Module, _)),
549 assert(st_value(Name, Module, Value))
550 ; existence_error(setting, Module:Name)
551 ).
552store_setting(Term, _) :-
553 type_error(setting, Term).
554
564
565save_settings :-
566 st_modified,
567 !,
568 ( local_file(File)
569 -> save_settings(File)
570 ; throw(error(context_error(settings, no_default_file), _))
571 ).
572save_settings.
573
574save_settings(File) :-
575 absolute_file_name(File, Path,
576 [ access(write)
577 ]),
578 setup_call_cleanup(
579 open(Path, write, Out,
580 [ encoding(utf8),
581 bom(true)
582 ]),
583 ( write_setting_header(Out),
584 forall(current_setting(Name, Module, _, _, _, _),
585 save_setting(Out, Module:Name))
586 ),
587 close(Out)).
588
(Out) :-
590 get_time(Now),
591 format_time(string(Date), '%+', Now),
592 format(Out, '/* Saved settings~n', []),
593 format(Out, ' Date: ~w~n', [Date]),
594 format(Out, '*/~n~n', []).
595
596save_setting(Out, Module:Name) :-
597 curr_setting(Name, Module, Type, Default, Comment, _Src),
598 ( st_value(Name, Module, Value),
599 \+ ( eval_default(Default, Module, Type, DefValue),
600 debug(setting, '~w <-> ~w~n', [DefValue, Value]),
601 DefValue =@= Value
602 )
603 -> format(Out, '~n%\t~w~n', [Comment]),
604 format(Out, 'setting(~q:~q, ~q).~n', [Module, Name, Value])
605 ; true
606 ).
607
611
612current_setting(Setting) :-
613 ground(Setting),
614 !,
615 strip_module(Setting, Module, Name),
616 current_setting(Name, Module, _, _, _, _).
617current_setting(Module:Name) :-
618 current_setting(Name, Module, _, _, _, _).
619
633
634setting_property(Setting, Property) :-
635 ground(Setting),
636 !,
637 Setting = Module:Name,
638 curr_setting(Name, Module, Type, Default, Comment, Src),
639 !,
640 setting_property(Property, Module, Type, Default, Comment, Src).
641setting_property(Setting, Property) :-
642 Setting = Module:Name,
643 curr_setting(Name, Module, Type, Default, Comment, Src),
644 setting_property(Property, Module, Type, Default, Comment, Src).
645
646setting_property(type(Type), _, Type, _, _, _).
647setting_property(default(Default), M, Type, Default0, _, _) :-
648 eval_default(Default0, M, Type, Default).
649setting_property(comment(Comment), _, _, _, Comment, _).
650setting_property(source(Src), _, _, _, _, Src).
651
659
660list_settings :-
661 list_settings(_).
662
663list_settings(Spec) :-
664 spec_term(Spec, Term),
665 TS1 = 25,
666 TS2 = 40,
667 format('~`=t~72|~n'),
668 format('~w~t~*| ~w~w~t~*| ~w~n',
669 ['Name', TS1, 'Value (*=modified)', '', TS2, 'Comment']),
670 format('~`=t~72|~n'),
671 forall(current_setting(Term),
672 list_setting(Term, TS1, TS2)).
673
674spec_term(M:S, M:S) :- !.
675spec_term(M, M:_).
676
677
678list_setting(Module:Name, TS1, TS2) :-
679 curr_setting(Name, Module, Type, Default0, Comment, _Src),
680 eval_default(Default0, Module, Type, Default),
681 setting(Module:Name, Value),
682 ( Value \== Default
683 -> Modified = (*)
684 ; Modified = ''
685 ),
686 format('~w~t~*| ~q~w~t~*| ~w~n',
687 [Module:Name, TS1, Value, Modified, TS2, Comment]).
688
689
690 693
701
702:- multifile
703 convert_text/3. 704
705convert_setting_text(Type, Text, Value) :-
706 convert_text(Type, Text, Value),
707 !.
708convert_setting_text(atom, Value, Value) :-
709 !,
710 must_be(atom, Value).
711convert_setting_text(boolean, Value, Value) :-
712 !,
713 must_be(boolean, Value).
714convert_setting_text(integer, Atom, Number) :-
715 !,
716 term_to_atom(Term, Atom),
717 Number is round(Term).
718convert_setting_text(float, Atom, Number) :-
719 !,
720 term_to_atom(Term, Atom),
721 Number is float(Term).
722convert_setting_text(between(L,U), Atom, Number) :-
723 !,
724 ( integer(L)
725 -> convert_setting_text(integer, Atom, Number)
726 ; convert_setting_text(float, Atom, Number)
727 ),
728 must_be(between(L,U), Number).
729convert_setting_text(Type, Atom, Term) :-
730 term_to_atom(Term, Atom),
731 must_be(Type, Term).
732
733
734 737
738:- multifile
739 sandbox:safe_meta_predicate/1. 740
741sandbox:safe_meta_predicate(settings:setting/2).
742
743
744 747
748:- multifile
749 prolog:error_message//1. 750
751prolog:error_message(context_error(settings, no_default_file)) -->
752 [ 'save_settings/0: no default file' ]