1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker and Richard O'Keefe 4 E-mail: J.Wielemaker@cs.vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2014-2025, VU University Amsterdam 7 CWI, Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(check_installation, 38 [ check_installation/0, 39 check_installation/1, % -Issues 40 check_config_files/0, 41 update_config_files/0, 42 test_installation/0, 43 test_installation/1 % +Options 44 ]). 45:- autoload(library(apply), [maplist/2, maplist/3]). 46:- autoload(library(archive), [archive_open/3, archive_close/1]). 47:- autoload(library(lists), [append/3, member/2]). 48:- autoload(library(occurs), [sub_term/2]). 49:- autoload(library(option), [option/2, merge_options/3]). 50:- autoload(library(prolog_source), [path_segments_atom/2]). 51:- use_module(library(settings), [setting/2]). 52:- autoload(library(dcg/high_order), [sequence//2, sequence/4]). 53:- autoload(library(error), [must_be/2]).
http://www.swi-prolog.org/build/issues/. If not provided,
the library file with extension .html is used.windows, unix or linux. If present, the component
is only checked for if we are running on a version of the
specified operating system.86% Feature tests 87component(tcmalloc, 88 _{ optional:true, 89 test:test_tcmalloc, 90 url:'tcmalloc.html', 91 os:linux 92 }). 93component(gmp, 94 _{ test:current_prolog_flag(bounded, false), 95 url:'gmp.html' 96 }). 97% Packages that depend on foreign libraries 98component(library(archive), _{features:archive_features}). 99component(library(cgi), _{}). 100component(library(crypt), _{}). 101component(library(bdb), _{}). 102component(library(double_metaphone), _{}). 103component(library(editline), _{os:unix}). 104component(library(filesex), _{}). 105component(library(http/http_stream), _{}). 106component(library(json), _{}). 107component(library(http/jquery), _{features:jquery_file}). 108component(library(isub), _{}). 109component(library(janus), _{features:python_version}). 110component(library(jpl), _{}). 111component(library(memfile), _{}). 112component(library(odbc), _{}). 113component(library(pce), 114 _{pre:use_foreign_library(pce_principal:foreign(pl2xpce)), 115 url:'xpce.html'}). 116component(library(pcre), _{features:pcre_features}). 117component(library(pdt_console), _{}). 118component(library(porter_stem), _{}). 119component(library(process), _{}). 120component(library(protobufs), _{}). 121%component(library(readline), _{os:unix}). 122component(library(readutil), _{}). 123component(library(rlimit), _{os:unix}). 124component(library(semweb/rdf_db), _{}). 125component(library(semweb/rdf_ntriples), _{}). 126component(library(semweb/turtle), _{}). 127component(library(sgml), _{}). 128component(library(sha), _{}). 129component(library(snowball), _{}). 130component(library(socket), _{}). 131component(library(ssl), _{}). 132component(library(sweep_link), _{features:sweep_emacs_module}). 133component(library(crypto), _{}). 134component(library(syslog), _{os:unix}). 135component(library(table), _{}). 136component(library(time), _{}). 137component(library(tipc/tipc), _{os:linux}). 138component(library(unicode), _{}). 139component(library(uri), _{}). 140component(library(uuid), _{}). 141component(library(yaml), _{}). 142component(library(zlib), _{}). 143 144issue_base('http://www.swi-prolog.org/build/issues/'). 145 146:- thread_local 147 issue/1. 148 149:- meta_predicate 150 run_silent(, ).
If issues are found it prints a diagnostic message with a link to a wiki page with additional information about the issue.
167check_installation :-
168 print_message(informational, installation(checking)),
169 check_installation_(InstallIssues),
170 check_on_path,
171 check_config_files(ConfigIssues),
172 check_autoload,
173 maplist(print_message(warning), ConfigIssues),
174 append(InstallIssues, ConfigIssues, Issues),
175 ( Issues == []
176 -> print_message(informational, installation(perfect))
177 ; length(Issues, Count),
178 print_message(warning, installation(imperfect(Count)))
179 ).optional_not_found
(optional component is not present), not_found (component is
not present) or failed (component is present but cannot be
loaded).189check_installation(Issues) :- 190 check_installation_(Issues0), 191 maplist(public_issue, Issues0, Issues). 192 193public_issue(installation(Term), Source-Issue) :- 194 functor(Term, Issue, _), 195 arg(1, Term, Properties), 196 Source = Properties.source. 197 198check_installation_(Issues) :- 199 retractall(issue(_)), 200 forall(component(Source, _Properties), 201 check_component(Source)), 202 findall(I, retract(issue(I)), Issues). 203 204check_component(Source) :- 205 component(Source, Properties), 206 !, 207 check_component(Source, Properties.put(source,Source)). 208 209check_component(_Source, Properties) :- 210 OS = Properties.get(os), 211 \+ current_os(OS), 212 !. 213check_component(Source, Properties) :- 214 compound(Source), 215 !, 216 check_source(Source, Properties). 217check_component(Feature, Properties) :- 218 print_message(informational, installation(checking(Feature))), 219 ( call(Properties.test) 220 -> print_message(informational, installation(ok)) 221 ; print_issue(installation(missing(Properties))) 222 ). 223 224check_source(Source, Properties) :- 225 exists_source(Source), 226 !, 227 print_message(informational, installation(loading(Source))), 228 ( run_silent(( ( Pre = Properties.get(pre) 229 -> call(Pre) 230 ; true 231 ), 232 load_files(Source, [silent(true), if(true)]) 233 ), 234 Properties.put(action, load)) 235 -> test_component(Properties), 236 print_message(informational, installation(ok)), 237 check_features(Properties) 238 ; true 239 ). 240check_source(_Source, Properties) :- 241 Properties.get(optional) == true, 242 !, 243 print_message(silent, 244 installation(optional_not_found(Properties))). 245check_source(_Source, Properties) :- 246 print_issue(installation(not_found(Properties))). 247 248current_os(unix) :- current_prolog_flag(unix, true). 249current_os(windows) :- current_prolog_flag(windows, true). 250current_os(linux) :- current_prolog_flag(arch, Arch), 251 sub_atom(Arch, _, _, _, linux).
257test_component(Dict) :- 258 Test = Dict.get(test), 259 !, 260 call(Test). 261test_component(_).
270check_features(Dict) :- 271 Test = Dict.get(features), 272 !, 273 catch(Test, Error, 274 ( print_message(warning, Error), 275 fail)). 276check_features(_).
284run_silent(Goal, Properties) :-
285 run_collect_messages(Goal, Result, Messages),
286 ( Result == true,
287 Messages == []
288 -> true
289 ; print_issue(installation(failed(Properties, Result, Messages))),
290 fail
291 ).true, false or exception(Error)
and messages with a list of generated error and warning
messages. Each message is a term:
message(Term,Kind,Lines)
303:- thread_local 304 got_message/1. 305 306run_collect_messages(Goal, Result, Messages) :- 307 setup_call_cleanup( 308 asserta((user:thread_message_hook(Term,Kind,Lines) :- 309 error_kind(Kind), 310 assertz(got_message(message(Term,Kind,Lines)))), Ref), 311 ( catch(Goal, E, true) 312 -> ( var(E) 313 -> Result0 = true 314 ; Result0 = exception(E) 315 ) 316 ; Result0 = false 317 ), 318 erase(Ref)), 319 findall(Msg, retract(got_message(Msg)), Messages), 320 Result = Result0. 321 322error_kind(warning). 323error_kind(error). 324 325 326 /******************************* 327 * SPECIAL TESTS * 328 *******************************/
332:- if(current_predicate(malloc_property/1)). 333test_tcmalloc :- 334 malloc_property('generic.current_allocated_bytes'(Bytes)), 335 Bytes > 1 000 000. 336:- else. 337test_tcmalloc :- 338 fail. 339:- endif.
345archive_features :- 346 tmp_file_stream(utf8, Name, Out), 347 close(Out), 348 findall(F, archive_filter(F, Name), Filters), 349 print_message(informational, installation(archive(filters, Filters))), 350 findall(F, archive_format(F, Name), Formats), 351 print_message(informational, installation(archive(formats, Formats))), 352 delete_file(Name). 353 354archive_filter(F, Name) :- 355 a_filter(F), 356 catch(archive_open(Name, A, [filter(F)]), E, true), 357 ( var(E) 358 -> archive_close(A) 359 ; true 360 ), 361 \+ subsumes_term(error(domain_error(filter, _),_), E). 362 363archive_format(F, Name) :- 364 a_format(F), 365 catch(archive_open(Name, A, [format(F)]), E, true), 366 ( var(E) 367 -> archive_close(A) 368 ; true 369 ), 370 \+ subsumes_term(error(domain_error(format, _),_), E). 371 372a_filter(bzip2). 373a_filter(compress). 374a_filter(gzip). 375a_filter(grzip). 376a_filter(lrzip). 377a_filter(lzip). 378a_filter(lzma). 379a_filter(lzop). 380a_filter(none). 381a_filter(rpm). 382a_filter(uu). 383a_filter(xz). 384 385a_format('7zip'). 386a_format(ar). 387a_format(cab). 388a_format(cpio). 389a_format(empty). 390a_format(gnutar). 391a_format(iso9660). 392a_format(lha). 393a_format(mtree). 394a_format(rar). 395a_format(raw). 396a_format(tar). 397a_format(xar). 398a_format(zip).
402pcre_features :- 403 findall(X, pcre_missing(X), Missing), 404 ( Missing == [] 405 -> true 406 ; print_message(warning, installation(pcre_missing(Missing))) 407 ), 408 ( re_config(compiled_widths(Widths)), 409 1 =:= Widths /\ 1 410 -> true 411 ; print_message(warning, installation(pcre_missing('8-bit support'))) 412 ). 413 414pcre_missing(X) :- 415 pcre_must_have(X), 416 Term =.. [X,true], 417 \+ catch(re_config(Term), _, fail). 418 419pcre_must_have(unicode).
425jquery_file :- 426 setting(jquery:version, File), 427 ( absolute_file_name(js(File), Path, [access(read), file_errors(fail)]) 428 -> print_message(informational, installation(jquery(found(Path)))) 429 ; print_message(warning, installation(jquery(not_found(File)))) 430 ). 431 432sweep_emacs_module :- 433 with_output_to(string(S), write_sweep_module_location), 434 split_string(S, "\n", "\n", [VersionInfo|Modules]), 435 must_be(oneof(["V 1"]), VersionInfo), 436 ( maplist(check_sweep_lib, Modules) 437 -> print_message(informational, installation(sweep(found(Modules)))) 438 ; print_message(warning, installation(sweep(not_found(Modules)))) 439 ). 440 441check_sweep_lib(Line) :- 442 sub_atom(Line, B, _, A, ' '), 443 sub_atom(Line, 0, B, _, Type), 444 must_be(oneof(['L', 'M']), Type), 445 sub_atom(Line, _, A, 0, Lib), 446 exists_file(Lib). 447 448python_version :- 449 py_call(sys:version, Version), 450 print_message(informational, installation(janus(Version))).
459check_on_path :- 460 current_prolog_flag(executable, EXEFlag), 461 prolog_to_os_filename(EXE, EXEFlag), 462 file_base_name(EXE, Prog), 463 absolute_file_name(EXE, AbsExe, 464 [ access(execute), 465 file_errors(fail) 466 ]), 467 !, 468 prolog_to_os_filename(AbsExe, OsExe), 469 ( absolute_file_name(path(Prog), OnPath, 470 [ access(execute), 471 file_errors(fail) 472 ]) 473 -> ( same_file(EXE, OnPath) 474 -> true 475 ; absolute_file_name(path(Prog), OnPathAny, 476 [ access(execute), 477 file_errors(fail), 478 solutions(all) 479 ]), 480 same_file(EXE, OnPathAny) 481 -> print_message(warning, installation(not_first_on_path(OsExe, OnPath))) 482 ; print_message(warning, installation(not_same_on_path(OsExe, OnPath))) 483 ) 484 ; print_message(warning, installation(not_on_path(OsExe, Prog))) 485 ). 486check_on_path. 487 488 489 /******************************* 490 * RUN TESTS * 491 *******************************/
cmake -DINSTALL_TESTS=ON
Options processed:
false, do not test the packagesWhen running this predicate the working directory must be writeable and allow for writing executable files. This is due to tests for file system interaction and tests for generating stand-alone executables. Note also that due to its side effects, the predicate should not be invoked twice in the same session.
514test_installation :- 515 test_installation([]). 516 517test_installation(Options) :- 518 absolute_file_name(swi(test/test), 519 TestFile, 520 [ access(read), 521 file_errors(fail), 522 file_type(prolog) 523 ]), 524 !, 525 test_installation_run(TestFile, Options). 526test_installation(_Options) :- 527 print_message(warning, installation(testing(no_installed_tests))). 528 529test_installation_run(TestFile, Options) :- 530 ( option(package(_), Options) 531 -> merge_options(Options, 532 [ core(false), 533 subdirs(false) 534 ], TestOptions) 535 ; merge_options(Options, 536 [ packages(true) 537 ], TestOptions) 538 ), 539 load_files(user:TestFile), 540 current_prolog_flag(verbose, Old), 541 setup_call_cleanup( 542 set_prolog_flag(verbose, silent), 543 user:test([], TestOptions), 544 set_prolog_flag(verbose, Old)). 545 546 547 /******************************* 548 * MESSAGES * 549 *******************************/ 550 551:- multifile 552 prolog:message//1. 553 554print_issue(Term) :- 555 assertz(issue(Term)), 556 print_message(warning, Term). 557 558issue_url(Properties, URL) :- 559 Local = Properties.get(url), 560 !, 561 issue_base(Base), 562 atom_concat(Base, Local, URL). 563issue_url(Properties, URL) :- 564 Properties.get(source) = library(Segments), 565 !, 566 path_segments_atom(Segments, Base), 567 file_name_extension(Base, html, URLFile), 568 issue_base(Issues), 569 atom_concat(Issues, URLFile, URL). 570 571prologmessage(installation(Message)) --> 572 message(Message). 573 574message(checking) --> 575 { current_prolog_flag(address_bits, Bits) }, 576 { current_prolog_flag(arch, Arch) }, 577 { current_prolog_flag(home, Home) }, 578 { current_prolog_flag(cpu_count, Cores) }, 579 [ 'Checking your SWI-Prolog kit for common issues ...'-[], nl, nl ], 580 [ 'Version: ~`.t~24| '-[] ], '$messages':prolog_message(version), [nl], 581 [ 'Address bits: ~`.t~24| ~d'-[Bits] ], [nl], 582 [ 'Architecture: ~`.t~24| ~w'-[Arch] ], [nl], 583 [ 'Installed at: ~`.t~24| ~w'-[Home] ], [nl], 584 [ 'Cores: ~`.t~24| ~w'-[Cores] ], [nl], 585 [ nl ]. 586message(perfect) --> 587 [ nl, 'Congratulations, your kit seems sound and complete!'-[] ]. 588message(imperfect(N)) --> 589 [ 'Found ~w issues.'-[N] ]. 590message(checking(Feature)) --> 591 [ 'Checking ~w ...'-[Feature], flush ]. 592message(missing(Properties)) --> 593 [ at_same_line, '~`.t~48| not present'-[] ], 594 details(Properties). 595message(loading(Source)) --> 596 [ 'Loading ~q ...'-[Source], flush ]. 597message(ok) --> 598 [ at_same_line, '~`.t~48| ok'-[] ]. 599message(optional_not_found(Properties)) --> 600 [ 'Optional ~q ~`.t~48| not present'-[Properties.source] ]. 601message(not_found(Properties)) --> 602 [ '~q ~`.t~48| NOT FOUND'-[Properties.source] ], 603 details(Properties). 604message(failed(Properties, false, [])) --> 605 !, 606 [ at_same_line, '~`.t~48| FAILED'-[] ], 607 details(Properties). 608message(failed(Properties, exception(Ex0), [])) --> 609 !, 610 { strip_stack(Ex0, Ex), 611 message_to_string(Ex, Msg) }, 612 [ '~w'-[Msg] ], 613 details(Properties). 614message(failed(Properties, true, Messages)) --> 615 [ at_same_line, '~`.t~48| FAILED'-[] ], 616 explain(Messages), 617 details(Properties). 618message(archive(What, Names)) --> 619 [ ' Supported ~w: '-[What] ], 620 list_names(Names). 621message(pcre_missing(Features)) --> 622 [ 'Missing libpcre features: '-[] ], 623 list_names(Features). 624message(not_first_on_path(EXE, OnPath)) --> 625 { public_executable(EXE, PublicEXE), 626 file_base_name(EXE, Prog) 627 }, 628 [ 'The first ~w on '-[Prog] ], 'PATH', [ ' is ~p, while '-[OnPath], nl ], 629 [ 'this version is ~p.'-[PublicEXE] ]. 630message(not_same_on_path(EXE, OnPath)) --> 631 { public_executable(EXE, PublicEXE), 632 file_base_name(EXE, Prog) 633 }, 634 [ 'The ~w on '-[Prog] ], 'PATH', [ ' is ~p, while '-[OnPath], nl ], 635 [ 'this version is ~p.'-[PublicEXE] ]. 636message(not_on_path(EXE, Prog)) --> 637 { public_bin_dir(EXE, Dir), 638 prolog_to_os_filename(Dir, OSDir) 639 }, 640 [ 'Could not find ~w on '-[Prog] ], 'PATH', [ '. '-[], nl ], 641 [ 'You may wish to add ~p to '-[OSDir] ], 'PATH', [ '. '-[], nl ]. 642message(jquery(found(Path))) --> 643 [ ' jQuery from ~w'-[Path] ]. 644message(jquery(not_found(File))) --> 645 [ ' Cannot find jQuery (~w)'-[File] ]. 646message(sweep(found(Paths))) --> 647 [ ' GNU-Emacs plugin loads'-[] ], 648 sequence(list_file, Paths). 649message(sweep(not_found(Paths))) --> 650 [ ' Could not find all GNU-Emacs libraries'-[] ], 651 sequence(list_file, Paths). 652message(testing(no_installed_tests)) --> 653 [ ' Runtime testing is not enabled.', nl], 654 [ ' Please recompile the system with INSTALL_TESTS enabled.' ]. 655message(janus(Version)) --> 656 [ ' Python version ~w'-[Version] ]. 657message(ambiguous_autoload(PI, Paths)) --> 658 [ 'The predicate ~p can be autoloaded from multiple libraries:'-[PI]], 659 sequence(list_file, Paths). 660 661public_executable(EXE, PublicProg) :- 662 file_base_name(EXE, Prog), 663 file_directory_name(EXE, ArchDir), 664 file_directory_name(ArchDir, BinDir), 665 file_directory_name(BinDir, Home), 666 file_directory_name(Home, Lib), 667 file_directory_name(Lib, Prefix), 668 atomic_list_concat([Prefix, bin, Prog], /, PublicProg), 669 exists_file(PublicProg), 670 same_file(EXE, PublicProg), 671 !. 672public_executable(EXE, EXE). 673 674public_bin_dir(EXE, Dir) :- 675 public_executable(EXE, PublicEXE), 676 file_directory_name(PublicEXE, Dir). 677 678 679 680'PATH' --> 681 { current_prolog_flag(windows, true) }, 682 !, 683 [ '%PATH%'-[] ]. 684'PATH' --> 685 [ '$PATH'-[] ]. 686 687strip_stack(error(Error, context(prolog_stack(S), Msg)), 688 error(Error, context(_, Msg))) :- 689 nonvar(S). 690strip_stack(Error, Error). 691 692details(Properties) --> 693 { issue_url(Properties, URL), ! 694 }, 695 [ nl, 'See '-[], url(URL) ]. 696details(_) --> []. 697 698explain(Messages) --> 699 { shared_object_error(Messages) }, 700 !, 701 [nl], 702 ( { current_prolog_flag(windows, true) } 703 -> [ 'Cannot load required DLL'-[] ] 704 ; [ 'Cannot load required shared library'-[] ] 705 ). 706explain(Messages) --> 707 print_messages(Messages). 708 (Messages) :- 710 sub_term(Term, Messages), 711 subsumes_term(error(shared_object(open, _Message), _), Term), 712 !. 713 714print_messages([]) --> []. 715print_messages([message(_Term, _Kind, Lines)|T]) --> 716 , [nl], 717 print_messages(T). 718 719list_names([]) --> []. 720list_names([H|T]) --> 721 [ '~w'-[H] ], 722 ( {T==[]} 723 -> [] 724 ; [ ', '-[] ], 725 list_names(T) 726 ). 727 728list_file(File) --> 729 [ nl, ' '-[], url(File) ]. 730 731 732 /******************************* 733 * CONFIG FILES * 734 *******************************/
741check_config_files :- 742 check_config_files(Issues), 743 maplist(print_message(warning), Issues). 744 745check_config_files(Issues) :- 746 findall(Issue, check_config_file(Issue), Issues). 747 748check_config_file(config(Id, move(Type, OldFile, NewFile))) :- 749 old_config(Type, Id, OldFile), 750 access_file(OldFile, exist), 751 \+ ( new_config(Type, Id, NewFile), 752 access_file(NewFile, exist) 753 ), 754 once(new_config(Type, Id, NewFile)). 755check_config_file(config(Id, different(Type, OldFile, NewFile))) :- 756 old_config(Type, Id, OldFile), 757 access_file(OldFile, exist), 758 new_config(Type, Id, NewFile), 759 access_file(NewFile, exist), 760 \+ same_file(OldFile, NewFile).
767update_config_files :- 768 old_config(Type, Id, OldFile), 769 access_file(OldFile, exist), 770 \+ ( new_config(Type, Id, NewFile), 771 access_file(NewFile, exist) 772 ), 773 ( new_config(Type, Id, NewFile), 774 \+ same_file(OldFile, NewFile), 775 create_parent_dir(NewFile) 776 -> catch(rename_file(OldFile, NewFile), E, 777 print_message(warning, E)), 778 print_message(informational, config(Id, moved(Type, OldFile, NewFile))) 779 ), 780 fail. 781update_config_files. 782 783old_config(file, init, File) :- 784 current_prolog_flag(windows, true), 785 win_folder(appdata, Base), 786 atom_concat(Base, '/SWI-Prolog/swipl.ini', File). 787old_config(file, init, File) :- 788 expand_file_name('~/.swiplrc', [File]). 789old_config(directory, lib, Dir) :- 790 expand_file_name('~/lib/prolog', [Dir]). 791old_config(directory, xpce, Dir) :- 792 expand_file_name('~/.xpce', [Dir]). 793old_config(directory, history, Dir) :- 794 expand_file_name('~/.swipl-dir-history', [Dir]). 795old_config(directory, pack, Dir) :- 796 ( catch(expand_file_name('~/lib/swipl/pack', [Dir]), _, fail) 797 ; absolute_file_name(swi(pack), Dir, 798 [ file_type(directory), solutions(all) ]) 799 ). 800 801new_config(file, init, File) :- 802 absolute_file_name(user_app_config('init.pl'), File, 803 [ solutions(all) ]). 804new_config(directory, lib, Dir) :- 805 config_dir(user_app_config(lib), Dir). 806new_config(directory, xpce, Dir) :- 807 config_dir(user_app_config(xpce), Dir). 808new_config(directory, history, Dir) :- 809 config_dir(user_app_config('dir-history'), Dir). 810new_config(directory, pack, Dir) :- 811 config_dir([app_data(pack), swi(pack)], Dir). 812 813config_dir(Aliases, Dir) :- 814 is_list(Aliases), 815 !, 816 ( member(Alias, Aliases), 817 absolute_file_name(Alias, Dir, 818 [ file_type(directory), solutions(all) ]) 819 *-> true 820 ; member(Alias, Aliases), 821 absolute_file_name(Alias, Dir, 822 [ solutions(all) ]) 823 ). 824config_dir(Alias, Dir) :- 825 ( absolute_file_name(Alias, Dir, 826 [ file_type(directory), solutions(all) ]) 827 *-> true 828 ; absolute_file_name(Alias, Dir, 829 [ solutions(all) ]) 830 ). 831 832create_parent_dir(NewFile) :- 833 file_directory_name(NewFile, Dir), 834 create_parent_dir_(Dir). 835 836create_parent_dir_(Dir) :- 837 exists_directory(Dir), 838 '$my_file'(Dir), 839 !. 840create_parent_dir_(Dir) :- 841 file_directory_name(Dir, Parent), 842 Parent \== Dir, 843 create_parent_dir_(Parent), 844 make_directory(Dir). 845 846prologmessage(config(Id, Issue)) --> 847 [ 'Config: '-[] ], 848 config_description(Id), 849 config_issue(Issue). 850 851config_description(init) --> 852 [ '(user initialization file) '-[], nl ]. 853config_description(lib) --> 854 [ '(user library) '-[], nl ]. 855config_description(pack) --> 856 [ '(add-ons) '-[], nl ]. 857config_description(history) --> 858 [ '(command line history) '-[], nl ]. 859config_description(xpce) --> 860 [ '(gui) '-[], nl ]. 861 862config_issue(move(Type, Old, New)) --> 863 [ ' found ~w "~w"'-[Type, Old], nl ], 864 [ ' new location is "~w"'-[New] ]. 865config_issue(moved(Type, Old, New)) --> 866 [ ' found ~w "~w"'-[Type, Old], nl ], 867 [ ' moved to new location "~w"'-[New] ]. 868config_issue(different(Type, Old, New)) --> 869 [ ' found different ~w "~w"'-[Type, Old], nl ], 870 [ ' new location is "~w"'-[New] ]. 871 872 /******************************* 873 * AUTO LOADING * 874 *******************************/
880check_autoload :- 881 findall(Name/Arity, '$in_library'(Name, Arity, _Path), PIs), 882 msort(PIs, Sorted), 883 clumped(Sorted, Clumped), 884 sort(2, >=, Clumped, ClumpedS), 885 ambiguous_autoload(ClumpedS). 886 887ambiguous_autoload([PI-N|T]) :- 888 N > 1, 889 !, 890 warn_ambiguous_autoload(PI), 891 ambiguous_autoload(T). 892ambiguous_autoload(_). 893 894warn_ambiguous_autoload(PI) :- 895 PI = Name/Arity, 896 findall(PlFile, 897 ( '$in_library'(Name, Arity, File), 898 file_name_extension(File, pl, PlFile) 899 ), PlFiles), 900 print_message(warning, installation(ambiguous_autoload(PI, PlFiles)))
Check installation issues and features
This library performs checks on the installed system to verify which optional components are available and whether all libraries that load shared objects/DLLs can be loaded. */