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), _{}). 121component(library(readutil), _{}). 122component(library(rlimit), _{os:unix}). 123component(library(semweb/rdf_db), _{}). 124component(library(semweb/rdf_ntriples), _{}). 125component(library(semweb/turtle), _{}). 126component(library(sgml), _{}). 127component(library(sha), _{}). 128component(library(snowball), _{}). 129component(library(socket), _{}). 130component(library(ssl), _{}). 131component(library(sweep_link), _{features:sweep_emacs_module}). 132component(library(crypto), _{}). 133component(library(syslog), _{os:unix}). 134component(library(table), _{}). 135component(library(time), _{}). 136component(library(tipc/tipc), _{os:linux}). 137component(library(unicode), _{}). 138component(library(uri), _{}). 139component(library(uuid), _{}). 140component(library(yaml), _{}). 141component(library(zlib), _{}). 142 143issue_base('http://www.swi-prolog.org/build/issues/'). 144 145:- thread_local 146 issue/1. 147 148:- meta_predicate 149 run_silent(, ).
If issues are found it prints a diagnostic message with a link to a wiki page with additional information about the issue.
166check_installation :-
167 print_message(informational, installation(checking)),
168 check_installation_(InstallIssues),
169 check_on_path,
170 check_config_files(ConfigIssues),
171 check_autoload,
172 maplist(print_message(warning), ConfigIssues),
173 append(InstallIssues, ConfigIssues, Issues),
174 ( Issues == []
175 -> print_message(informational, installation(perfect))
176 ; length(Issues, Count),
177 print_message(warning, installation(imperfect(Count)))
178 ).optional_not_found
(optional component is not present), not_found (component is
not present) or failed (component is present but cannot be
loaded).188check_installation(Issues) :- 189 check_installation_(Issues0), 190 maplist(public_issue, Issues0, Issues). 191 192public_issue(installation(Term), Source-Issue) :- 193 functor(Term, Issue, _), 194 arg(1, Term, Properties), 195 Source = Properties.source. 196 197check_installation_(Issues) :- 198 retractall(issue(_)), 199 forall(component(Source, _Properties), 200 check_component(Source)), 201 findall(I, retract(issue(I)), Issues). 202 203check_component(Source) :- 204 component(Source, Properties), 205 !, 206 check_component(Source, Properties.put(source,Source)). 207 208check_component(_Source, Properties) :- 209 OS = Properties.get(os), 210 \+ current_os(OS), 211 !. 212check_component(Source, Properties) :- 213 compound(Source), 214 !, 215 check_source(Source, Properties). 216check_component(Feature, Properties) :- 217 print_message(informational, installation(checking(Feature))), 218 ( call(Properties.test) 219 -> print_message(informational, installation(ok)) 220 ; print_issue(installation(missing(Properties))) 221 ). 222 223check_source(Source, Properties) :- 224 exists_source(Source), 225 !, 226 print_message(informational, installation(loading(Source))), 227 ( run_silent(( ( Pre = Properties.get(pre) 228 -> call(Pre) 229 ; true 230 ), 231 load_files(Source, [silent(true), if(true)]) 232 ), 233 Properties.put(action, load)) 234 -> test_component(Properties), 235 print_message(informational, installation(ok)), 236 check_features(Properties) 237 ; true 238 ). 239check_source(_Source, Properties) :- 240 Properties.get(optional) == true, 241 !, 242 print_message(silent, 243 installation(optional_not_found(Properties))). 244check_source(_Source, Properties) :- 245 print_issue(installation(not_found(Properties))). 246 247current_os(unix) :- current_prolog_flag(unix, true). 248current_os(windows) :- current_prolog_flag(windows, true). 249current_os(linux) :- current_prolog_flag(arch, Arch), 250 sub_atom(Arch, _, _, _, linux).
256test_component(Dict) :- 257 Test = Dict.get(test), 258 !, 259 call(Test). 260test_component(_).
269check_features(Dict) :- 270 Test = Dict.get(features), 271 !, 272 catch(Test, Error, 273 ( print_message(warning, Error), 274 fail)). 275check_features(_).
283run_silent(Goal, Properties) :-
284 run_collect_messages(Goal, Result, Messages),
285 ( Result == true,
286 Messages == []
287 -> true
288 ; print_issue(installation(failed(Properties, Result, Messages))),
289 fail
290 ).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)
302:- thread_local 303 got_message/1. 304 305run_collect_messages(Goal, Result, Messages) :- 306 setup_call_cleanup( 307 asserta((user:thread_message_hook(Term,Kind,Lines) :- 308 error_kind(Kind), 309 assertz(got_message(message(Term,Kind,Lines)))), Ref), 310 ( catch(Goal, E, true) 311 -> ( var(E) 312 -> Result0 = true 313 ; Result0 = exception(E) 314 ) 315 ; Result0 = false 316 ), 317 erase(Ref)), 318 findall(Msg, retract(got_message(Msg)), Messages), 319 Result = Result0. 320 321error_kind(warning). 322error_kind(error). 323 324 325 /******************************* 326 * SPECIAL TESTS * 327 *******************************/
331:- if(current_predicate(malloc_property/1)). 332test_tcmalloc :- 333 malloc_property('generic.current_allocated_bytes'(Bytes)), 334 Bytes > 1 000 000. 335:- else. 336test_tcmalloc :- 337 fail. 338:- endif.
344archive_features :- 345 tmp_file_stream(utf8, Name, Out), 346 close(Out), 347 findall(F, archive_filter(F, Name), Filters), 348 print_message(informational, installation(archive(filters, Filters))), 349 findall(F, archive_format(F, Name), Formats), 350 print_message(informational, installation(archive(formats, Formats))), 351 delete_file(Name). 352 353archive_filter(F, Name) :- 354 a_filter(F), 355 catch(archive_open(Name, A, [filter(F)]), E, true), 356 ( var(E) 357 -> archive_close(A) 358 ; true 359 ), 360 \+ subsumes_term(error(domain_error(filter, _),_), E). 361 362archive_format(F, Name) :- 363 a_format(F), 364 catch(archive_open(Name, A, [format(F)]), E, true), 365 ( var(E) 366 -> archive_close(A) 367 ; true 368 ), 369 \+ subsumes_term(error(domain_error(format, _),_), E). 370 371a_filter(bzip2). 372a_filter(compress). 373a_filter(gzip). 374a_filter(grzip). 375a_filter(lrzip). 376a_filter(lzip). 377a_filter(lzma). 378a_filter(lzop). 379a_filter(none). 380a_filter(rpm). 381a_filter(uu). 382a_filter(xz). 383 384a_format('7zip'). 385a_format(ar). 386a_format(cab). 387a_format(cpio). 388a_format(empty). 389a_format(gnutar). 390a_format(iso9660). 391a_format(lha). 392a_format(mtree). 393a_format(rar). 394a_format(raw). 395a_format(tar). 396a_format(xar). 397a_format(zip).
401pcre_features :- 402 findall(X, pcre_missing(X), Missing), 403 ( Missing == [] 404 -> true 405 ; print_message(warning, installation(pcre_missing(Missing))) 406 ), 407 ( re_config(compiled_widths(Widths)), 408 1 =:= Widths /\ 1 409 -> true 410 ; print_message(warning, installation(pcre_missing('8-bit support'))) 411 ). 412 413pcre_missing(X) :- 414 pcre_must_have(X), 415 Term =.. [X,true], 416 \+ catch(re_config(Term), _, fail). 417 418pcre_must_have(unicode).
424jquery_file :- 425 setting(jquery:version, File), 426 ( absolute_file_name(js(File), Path, [access(read), file_errors(fail)]) 427 -> print_message(informational, installation(jquery(found(Path)))) 428 ; print_message(warning, installation(jquery(not_found(File)))) 429 ). 430 431sweep_emacs_module :- 432 with_output_to(string(S), write_sweep_module_location), 433 split_string(S, "\n", "\n", [VersionInfo|Modules]), 434 must_be(oneof(["V 1"]), VersionInfo), 435 ( maplist(check_sweep_lib, Modules) 436 -> print_message(informational, installation(sweep(found(Modules)))) 437 ; print_message(warning, installation(sweep(not_found(Modules)))) 438 ). 439 440check_sweep_lib(Line) :- 441 sub_atom(Line, B, _, A, ' '), 442 sub_atom(Line, 0, B, _, Type), 443 must_be(oneof(['L', 'M']), Type), 444 sub_atom(Line, _, A, 0, Lib), 445 exists_file(Lib). 446 447python_version :- 448 py_call(sys:version, Version), 449 print_message(informational, installation(janus(Version))).
458check_on_path :- 459 current_prolog_flag(executable, EXEFlag), 460 prolog_to_os_filename(EXE, EXEFlag), 461 file_base_name(EXE, Prog), 462 absolute_file_name(EXE, AbsExe, 463 [ access(execute), 464 file_errors(fail) 465 ]), 466 !, 467 prolog_to_os_filename(AbsExe, OsExe), 468 ( absolute_file_name(path(Prog), OnPath, 469 [ access(execute), 470 file_errors(fail) 471 ]) 472 -> ( same_file(EXE, OnPath) 473 -> true 474 ; absolute_file_name(path(Prog), OnPathAny, 475 [ access(execute), 476 file_errors(fail), 477 solutions(all) 478 ]), 479 same_file(EXE, OnPathAny) 480 -> print_message(warning, installation(not_first_on_path(OsExe, OnPath))) 481 ; print_message(warning, installation(not_same_on_path(OsExe, OnPath))) 482 ) 483 ; print_message(warning, installation(not_on_path(OsExe, Prog))) 484 ). 485check_on_path. 486 487 488 /******************************* 489 * RUN TESTS * 490 *******************************/
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.
513test_installation :- 514 test_installation([]). 515 516test_installation(Options) :- 517 absolute_file_name(swi(test/test), 518 TestFile, 519 [ access(read), 520 file_errors(fail), 521 file_type(prolog) 522 ]), 523 !, 524 test_installation_run(TestFile, Options). 525test_installation(_Options) :- 526 print_message(warning, installation(testing(no_installed_tests))). 527 528test_installation_run(TestFile, Options) :- 529 ( option(package(_), Options) 530 -> merge_options(Options, 531 [ core(false), 532 subdirs(false) 533 ], TestOptions) 534 ; merge_options(Options, 535 [ packages(true) 536 ], TestOptions) 537 ), 538 load_files(user:TestFile), 539 current_prolog_flag(verbose, Old), 540 setup_call_cleanup( 541 set_prolog_flag(verbose, silent), 542 user:test([], TestOptions), 543 set_prolog_flag(verbose, Old)). 544 545 546 /******************************* 547 * MESSAGES * 548 *******************************/ 549 550:- multifile 551 prolog:message//1. 552 553print_issue(Term) :- 554 assertz(issue(Term)), 555 print_message(warning, Term). 556 557issue_url(Properties, URL) :- 558 Local = Properties.get(url), 559 !, 560 issue_base(Base), 561 atom_concat(Base, Local, URL). 562issue_url(Properties, URL) :- 563 Properties.get(source) = library(Segments), 564 !, 565 path_segments_atom(Segments, Base), 566 file_name_extension(Base, html, URLFile), 567 issue_base(Issues), 568 atom_concat(Issues, URLFile, URL). 569 570prologmessage(installation(Message)) --> 571 message(Message). 572 573message(checking) --> 574 { current_prolog_flag(address_bits, Bits) }, 575 { current_prolog_flag(arch, Arch) }, 576 { current_prolog_flag(home, Home) }, 577 { current_prolog_flag(cpu_count, Cores) }, 578 [ 'Checking your SWI-Prolog kit for common issues ...'-[], nl, nl ], 579 [ 'Version: ~`.t~24| '-[] ], '$messages':prolog_message(version), [nl], 580 [ 'Address bits: ~`.t~24| ~d'-[Bits] ], [nl], 581 [ 'Architecture: ~`.t~24| ~w'-[Arch] ], [nl], 582 [ 'Installed at: ~`.t~24| ~w'-[Home] ], [nl], 583 [ 'Cores: ~`.t~24| ~w'-[Cores] ], [nl], 584 [ nl ]. 585message(perfect) --> 586 [ nl, 'Congratulations, your kit seems sound and complete!'-[] ]. 587message(imperfect(N)) --> 588 [ 'Found ~w issues.'-[N] ]. 589message(checking(Feature)) --> 590 [ 'Checking ~w ...'-[Feature], flush ]. 591message(missing(Properties)) --> 592 [ at_same_line, '~`.t~48| not present'-[] ], 593 details(Properties). 594message(loading(Source)) --> 595 [ 'Loading ~q ...'-[Source], flush ]. 596message(ok) --> 597 [ at_same_line, '~`.t~48| ok'-[] ]. 598message(optional_not_found(Properties)) --> 599 [ 'Optional ~q ~`.t~48| not present'-[Properties.source] ]. 600message(not_found(Properties)) --> 601 [ '~q ~`.t~48| NOT FOUND'-[Properties.source] ], 602 details(Properties). 603message(failed(Properties, false, [])) --> 604 !, 605 [ at_same_line, '~`.t~48| FAILED'-[] ], 606 details(Properties). 607message(failed(Properties, exception(Ex0), [])) --> 608 !, 609 { strip_stack(Ex0, Ex), 610 message_to_string(Ex, Msg) }, 611 [ '~w'-[Msg] ], 612 details(Properties). 613message(failed(Properties, true, Messages)) --> 614 [ at_same_line, '~`.t~48| FAILED'-[] ], 615 explain(Messages), 616 details(Properties). 617message(archive(What, Names)) --> 618 [ ' Supported ~w: '-[What] ], 619 list_names(Names). 620message(pcre_missing(Features)) --> 621 [ 'Missing libpcre features: '-[] ], 622 list_names(Features). 623message(not_first_on_path(EXE, OnPath)) --> 624 { public_executable(EXE, PublicEXE), 625 file_base_name(EXE, Prog) 626 }, 627 [ 'The first ~w on '-[Prog] ], 'PATH', [ ' is ~p, while '-[OnPath], nl ], 628 [ 'this version is ~p.'-[PublicEXE] ]. 629message(not_same_on_path(EXE, OnPath)) --> 630 { public_executable(EXE, PublicEXE), 631 file_base_name(EXE, Prog) 632 }, 633 [ 'The ~w on '-[Prog] ], 'PATH', [ ' is ~p, while '-[OnPath], nl ], 634 [ 'this version is ~p.'-[PublicEXE] ]. 635message(not_on_path(EXE, Prog)) --> 636 { public_bin_dir(EXE, Dir), 637 prolog_to_os_filename(Dir, OSDir) 638 }, 639 [ 'Could not find ~w on '-[Prog] ], 'PATH', [ '. '-[], nl ], 640 [ 'You may wish to add ~p to '-[OSDir] ], 'PATH', [ '. '-[], nl ]. 641message(jquery(found(Path))) --> 642 [ ' jQuery from ~w'-[Path] ]. 643message(jquery(not_found(File))) --> 644 [ ' Cannot find jQuery (~w)'-[File] ]. 645message(sweep(found(Paths))) --> 646 [ ' GNU-Emacs plugin loads'-[] ], 647 sequence(list_file, Paths). 648message(sweep(not_found(Paths))) --> 649 [ ' Could not find all GNU-Emacs libraries'-[] ], 650 sequence(list_file, Paths). 651message(testing(no_installed_tests)) --> 652 [ ' Runtime testing is not enabled.', nl], 653 [ ' Please recompile the system with INSTALL_TESTS enabled.' ]. 654message(janus(Version)) --> 655 [ ' Python version ~w'-[Version] ]. 656message(ambiguous_autoload(PI, Paths)) --> 657 [ 'The predicate ~p can be autoloaded from multiple libraries:'-[PI]], 658 sequence(list_file, Paths). 659 660public_executable(EXE, PublicProg) :- 661 file_base_name(EXE, Prog), 662 file_directory_name(EXE, ArchDir), 663 file_directory_name(ArchDir, BinDir), 664 file_directory_name(BinDir, Home), 665 file_directory_name(Home, Lib), 666 file_directory_name(Lib, Prefix), 667 atomic_list_concat([Prefix, bin, Prog], /, PublicProg), 668 exists_file(PublicProg), 669 same_file(EXE, PublicProg), 670 !. 671public_executable(EXE, EXE). 672 673public_bin_dir(EXE, Dir) :- 674 public_executable(EXE, PublicEXE), 675 file_directory_name(PublicEXE, Dir). 676 677 678 679'PATH' --> 680 { current_prolog_flag(windows, true) }, 681 !, 682 [ '%PATH%'-[] ]. 683'PATH' --> 684 [ '$PATH'-[] ]. 685 686strip_stack(error(Error, context(prolog_stack(S), Msg)), 687 error(Error, context(_, Msg))) :- 688 nonvar(S). 689strip_stack(Error, Error). 690 691details(Properties) --> 692 { issue_url(Properties, URL), ! 693 }, 694 [ nl, 'See '-[], url(URL) ]. 695details(_) --> []. 696 697explain(Messages) --> 698 { shared_object_error(Messages) }, 699 !, 700 [nl], 701 ( { current_prolog_flag(windows, true) } 702 -> [ 'Cannot load required DLL'-[] ] 703 ; [ 'Cannot load required shared library'-[] ] 704 ). 705explain(Messages) --> 706 print_messages(Messages). 707 (Messages) :- 709 sub_term(Term, Messages), 710 subsumes_term(error(shared_object(open, _Message), _), Term), 711 !. 712 713print_messages([]) --> []. 714print_messages([message(_Term, _Kind, Lines)|T]) --> 715 , [nl], 716 print_messages(T). 717 718list_names([]) --> []. 719list_names([H|T]) --> 720 [ '~w'-[H] ], 721 ( {T==[]} 722 -> [] 723 ; [ ', '-[] ], 724 list_names(T) 725 ). 726 727list_file(File) --> 728 [ nl, ' '-[], url(File) ]. 729 730 731 /******************************* 732 * CONFIG FILES * 733 *******************************/
740check_config_files :- 741 check_config_files(Issues), 742 maplist(print_message(warning), Issues). 743 744check_config_files(Issues) :- 745 findall(Issue, check_config_file(Issue), Issues). 746 747check_config_file(config(Id, move(Type, OldFile, NewFile))) :- 748 old_config(Type, Id, OldFile), 749 access_file(OldFile, exist), 750 \+ ( new_config(Type, Id, NewFile), 751 access_file(NewFile, exist) 752 ), 753 once(new_config(Type, Id, NewFile)). 754check_config_file(config(Id, different(Type, OldFile, NewFile))) :- 755 old_config(Type, Id, OldFile), 756 access_file(OldFile, exist), 757 new_config(Type, Id, NewFile), 758 access_file(NewFile, exist), 759 \+ same_file(OldFile, NewFile).
766update_config_files :- 767 old_config(Type, Id, OldFile), 768 access_file(OldFile, exist), 769 \+ ( new_config(Type, Id, NewFile), 770 access_file(NewFile, exist) 771 ), 772 ( new_config(Type, Id, NewFile), 773 \+ same_file(OldFile, NewFile), 774 create_parent_dir(NewFile) 775 -> catch(rename_file(OldFile, NewFile), E, 776 print_message(warning, E)), 777 print_message(informational, config(Id, moved(Type, OldFile, NewFile))) 778 ), 779 fail. 780update_config_files. 781 782old_config(file, init, File) :- 783 current_prolog_flag(windows, true), 784 win_folder(appdata, Base), 785 atom_concat(Base, '/SWI-Prolog/swipl.ini', File). 786old_config(file, init, File) :- 787 expand_file_name('~/.swiplrc', [File]). 788old_config(directory, lib, Dir) :- 789 expand_file_name('~/lib/prolog', [Dir]). 790old_config(directory, xpce, Dir) :- 791 expand_file_name('~/.xpce', [Dir]). 792old_config(directory, history, Dir) :- 793 expand_file_name('~/.swipl-dir-history', [Dir]). 794old_config(directory, pack, Dir) :- 795 ( catch(expand_file_name('~/lib/swipl/pack', [Dir]), _, fail) 796 ; absolute_file_name(swi(pack), Dir, 797 [ file_type(directory), solutions(all) ]) 798 ). 799 800new_config(file, init, File) :- 801 absolute_file_name(user_app_config('init.pl'), File, 802 [ solutions(all) ]). 803new_config(directory, lib, Dir) :- 804 config_dir(user_app_config(lib), Dir). 805new_config(directory, xpce, Dir) :- 806 config_dir(user_app_config(xpce), Dir). 807new_config(directory, history, Dir) :- 808 config_dir(user_app_config('dir-history'), Dir). 809new_config(directory, pack, Dir) :- 810 config_dir([app_data(pack), swi(pack)], Dir). 811 812config_dir(Aliases, Dir) :- 813 is_list(Aliases), 814 !, 815 ( member(Alias, Aliases), 816 absolute_file_name(Alias, Dir, 817 [ file_type(directory), solutions(all) ]) 818 *-> true 819 ; member(Alias, Aliases), 820 absolute_file_name(Alias, Dir, 821 [ solutions(all) ]) 822 ). 823config_dir(Alias, Dir) :- 824 ( absolute_file_name(Alias, Dir, 825 [ file_type(directory), solutions(all) ]) 826 *-> true 827 ; absolute_file_name(Alias, Dir, 828 [ solutions(all) ]) 829 ). 830 831create_parent_dir(NewFile) :- 832 file_directory_name(NewFile, Dir), 833 create_parent_dir_(Dir). 834 835create_parent_dir_(Dir) :- 836 exists_directory(Dir), 837 '$my_file'(Dir), 838 !. 839create_parent_dir_(Dir) :- 840 file_directory_name(Dir, Parent), 841 Parent \== Dir, 842 create_parent_dir_(Parent), 843 make_directory(Dir). 844 845prologmessage(config(Id, Issue)) --> 846 [ 'Config: '-[] ], 847 config_description(Id), 848 config_issue(Issue). 849 850config_description(init) --> 851 [ '(user initialization file) '-[], nl ]. 852config_description(lib) --> 853 [ '(user library) '-[], nl ]. 854config_description(pack) --> 855 [ '(add-ons) '-[], nl ]. 856config_description(history) --> 857 [ '(command line history) '-[], nl ]. 858config_description(xpce) --> 859 [ '(gui) '-[], nl ]. 860 861config_issue(move(Type, Old, New)) --> 862 [ ' found ~w "~w"'-[Type, Old], nl ], 863 [ ' new location is "~w"'-[New] ]. 864config_issue(moved(Type, Old, New)) --> 865 [ ' found ~w "~w"'-[Type, Old], nl ], 866 [ ' moved to new location "~w"'-[New] ]. 867config_issue(different(Type, Old, New)) --> 868 [ ' found different ~w "~w"'-[Type, Old], nl ], 869 [ ' new location is "~w"'-[New] ]. 870 871 /******************************* 872 * AUTO LOADING * 873 *******************************/
879check_autoload :- 880 findall(Name/Arity, '$in_library'(Name, Arity, _Path), PIs), 881 msort(PIs, Sorted), 882 clumped(Sorted, Clumped), 883 sort(2, >=, Clumped, ClumpedS), 884 ambiguous_autoload(ClumpedS). 885 886ambiguous_autoload([PI-N|T]) :- 887 N > 1, 888 !, 889 warn_ambiguous_autoload(PI), 890 ambiguous_autoload(T). 891ambiguous_autoload(_). 892 893warn_ambiguous_autoload(PI) :- 894 PI = Name/Arity, 895 findall(PlFile, 896 ( '$in_library'(Name, Arity, File), 897 file_name_extension(File, pl, PlFile) 898 ), PlFiles), 899 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. */