1/*  Part of SWI-Prolog
2
3    Author:        Jan Wielemaker
4    E-mail:        J.Wielemaker@vu.nl
5    WWW:           http://www.swi-prolog.org
6    Copyright (c)  2018, VU University Amsterdam
7                         CWI, Amsterdam
8    All rights reserved.
9
10    Redistribution and use in source and binary forms, with or without
11    modification, are permitted provided that the following conditions
12    are met:
13
14    1. Redistributions of source code must retain the above copyright
15       notice, this list of conditions and the following disclaimer.
16
17    2. Redistributions in binary form must reproduce the above copyright
18       notice, this list of conditions and the following disclaimer in
19       the documentation and/or other materials provided with the
20       distribution.
21
22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33    POSSIBILITY OF SUCH DAMAGE.
34*/
35
36:- module(prolog_run_in_build_directory, []).
37:- use_module(library(lists)).
38
39/** <module> Setup SWI-Prolog to run from the build directory
40
41This module is loaded if SWI-Prolog  is   started  in the build tree and
42sets up paths such that all packages can be loaded and the system can be
43used interactively similar to the installed  system. This serves several
44purposes:
45
46  - We can easily debug the various installations
47  - We can easily develop
48  - We can build the documentation without installing
49
50@tbd	Ideally we can only access Prolog files that are normally
51	installed.  How can we limit that?
52        - When available, use the install_manifest.txt and place
53          a hook into the load message that validates the file
54          appears in the install manifest?
55@tbd    Deal with the library index for autoloading, compatible to the
56	normal installation.
57	- Create the index in the CMAKE_BINARY_DIRECTORY
58        - Load it on startup
59@tbd	Find HTML manual locations.  Can we deal with the fact that
60	the manual files are in the bindir?
61*/
62
63%!  cmake_binary_directory(-BinDir) is det.
64%!  cmake_source_directory(-SrcDir) is det.
65%
66%   Find    the    equivalent    of      =CMAKE_BINARY_DIRECTORY=    and
67%   CMAKE_SOURCE_DIRECTORY.
68
69cmake_binary_directory(BinDir) :-
70    current_prolog_flag(executable, Exe),
71    file_directory_name(Exe, CoreDir),
72    file_directory_name(CoreDir, RelBinDir),
73    working_directory(PWD, PWD),
74    absolute_file_name(RelBinDir, BinDir,
75                       [ file_type(directory),
76                         relative_to(PWD)
77                       ]).
78
79cmake_source_directory(SrcDir) :-
80    current_prolog_flag(home, SrcDir).
81
82%!  swipl_package(-Pkg, -PkgSrcDir, -PkgBinDir) is nondet.
83%
84%   True when Pkg is available in the build tree at the given locations.
85
86swipl_package(Pkg, PkgSrcDir, PkgBinDir) :-
87    cmake_source_directory(CMakeSrcDir),
88    cmake_binary_directory(CMakeBinDir),
89    atomic_list_concat([CMakeBinDir, packages], /, PkgRoot),
90    exists_directory(PkgRoot),
91    directory_files(PkgRoot, Candidates),
92    member(Pkg, Candidates),
93    atomic_list_concat([CMakeSrcDir, packages, Pkg], /, PkgSrcDir),
94    atomic_list_concat([PkgSrcDir, 'CMakeLists.txt'], /, CMakeLists),
95    atomic_list_concat([PkgRoot, Pkg], /, PkgBinDir),
96    exists_file(CMakeLists).
97
98:- multifile user:file_search_path/2.
99:- dynamic   user:file_search_path/2.
100
101user:file_search_path(library, swi(packages)).
102
103%!  add_package(+Package, +PkgSrcDir, +PkgBinDir) is det.
104%
105%   Setup the source paths and initialization for Package with the given
106%   source and binary location.
107
108add_package(xpce, PkgSrcDir, PkgBinDir) :-
109    !,
110    atomic_list_concat([PkgSrcDir, prolog, lib], /, PceLibDir),
111    atomic_list_concat([PkgSrcDir, swipl, 'swipl-rc'], /, PceLinkFile),
112    assertz(user:file_search_path(library, PceLibDir)),
113    assertz(user:file_search_path(foreign, PkgBinDir)),
114    setenv('XPCEHOME', PkgSrcDir),
115    use_module(PceLinkFile).
116add_package(sgml, PkgSrcDir, PkgBinDir) :-
117    !,
118    atomic_list_concat([PkgSrcDir, 'DTD'], /, DTDDir),
119    assertz(user:file_search_path(dtd, DTDDir)),
120    add_package_path(PkgSrcDir, PkgBinDir).
121add_package(_Pkg, PkgSrcDir, PkgBinDir) :-
122    add_package_path(PkgSrcDir, PkgBinDir).
123
124%!  add_package_path(+PkgSrcDir, +PkgBinDir) is det.
125%
126%   Add the source  and  binary  directories   for  the  package  to the
127%   `library` and `foreign` search paths. Note that  we only need to add
128%   the binary directory if  it  contains   shared  objects,  but  it is
129%   probably cheaper to add it anyway.
130
131add_package_path(PkgSrcDir, PkgBinDir) :-
132    assertz(user:file_search_path(library, PkgSrcDir)),
133    assertz(user:file_search_path(foreign, PkgBinDir)).
134
135:- forall(swipl_package(Pkg, PkgSrcDir, PkgBinDir),
136          add_package(Pkg, PkgSrcDir, PkgBinDir)).
137