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_build_home, []).
37
38/** <module> Setup SWI-Prolog to run from the build directory
39
40This module is loaded if SWI-Prolog  is   started  in the build tree and
41sets up paths such that all packages can be loaded and the system can be
42used interactively similar to the installed  system. This serves several
43purposes:
44
45  - We can easily debug the various installations
46  - We can easily develop
47  - We can build the documentation without installing
48
49This file is normally installed in `CMAKE_BINARY_DIRECTORY/home`.
50*/
51
52%!  cmake_binary_directory(-BinDir) is det.
53%!  cmake_source_directory(-SrcDir) is det.
54%
55%   Find    the    equivalent    of      =CMAKE_BINARY_DIRECTORY=    and
56%   CMAKE_SOURCE_DIRECTORY.
57
58cmake_binary_directory(BinDir) :-
59    current_prolog_flag(executable, OsExe),
60    OsExe \== 'libswipl.dll',           % avoid dummy for embedded JPL test
61    prolog_to_os_filename(Exe, OsExe),
62    working_directory(PWD, PWD),
63    exe_access(ExeAccess),
64    absolute_file_name(Exe, AbsExe,
65                       [ access(ExeAccess),
66                         relative_to(PWD)
67                       ]),
68    file_directory_name(AbsExe, AbsExeDir),
69    file_directory_name(AbsExeDir, ParentDir),
70    (   file_base_name(ParentDir, packages)
71    ->  file_directory_name(ParentDir, BinDir)
72    ;   BinDir = ParentDir
73    ).
74
75exe_access(Access) :-
76    (   current_prolog_flag(unix, true)
77    ->  Access = execute
78    ;   Access = read
79    ).
80
81%!  cmake_source_directory(-SrcDir) is det.
82%
83%   Find the SWI-Prolog source directory. First   try .. from the binary
84%   dir, that try the binary dir   and finally read the =CMakeLists.txt=
85%   file. We take these three steps because   the  first two are quicker
86%   and I'm not sure how much we can rely on the CMakeCache.txt content.
87
88cmake_source_directory(SrcDir) :-
89    cmake_binary_directory(BinDir),
90    (   file_directory_name(BinDir, SrcDir)
91    ;   SrcDir = BinDir
92    ),
93    atomic_list_concat([SrcDir, 'CMakeLists.txt'], /, CMakeFile),
94    exists_file(CMakeFile),
95    is_swi_prolog_cmake_file(CMakeFile),
96    !.
97cmake_source_directory(SrcDir) :-
98    cmake_binary_directory(BinDir),
99    atomic_list_concat([BinDir, 'CMakeCache.txt'], /, CacheFile),
100    cmake_var(CacheFile, 'SWI-Prolog_SOURCE_DIR:STATIC', SrcDir).
101
102is_swi_prolog_cmake_file(File) :-
103    setup_call_cleanup(
104        open(File, read, In),
105        is_swi_prolog_stream(In),
106        close(In)).
107
108is_swi_prolog_stream(In) :-
109    repeat,
110    read_string(In, "\n", "\t ", Sep, Line),
111    (   Sep == -1
112    ->  !, fail
113    ;   sub_string(Line, _, _, _, 'project(SWI-Prolog)')
114    ),
115    !.
116
117cmake_var(File, Name, Value) :-
118    setup_call_cleanup(
119        open(File, read, In),
120        cmake_var_in_stream(In, Name, Value),
121        close(In)).
122
123cmake_var_in_stream(Stream, Name, Value) :-
124    string_length(Name, NameLen),
125    repeat,
126      read_string(Stream, '\n', '\r', Sep, String0),
127      (   Sep \== -1
128      ->  String = String0
129      ;   String0 == ""
130      ->  !, fail
131      ;   String = String0
132      ),
133      sub_string(String, 0, _, _, Name),
134      sub_string(String, NameLen, 1, After, "="),
135      sub_atom(String, _, After,  0, Value),
136      !.
137
138%!  swipl_package(-Pkg, -PkgBinDir) is nondet.
139%
140%   True when Pkg is available in the build tree at the given location.
141
142swipl_package(Pkg, PkgBinDir) :-
143    cmake_binary_directory(CMakeBinDir),
144    atomic_list_concat([CMakeBinDir, packages], /, PkgRoot),
145    exists_directory(PkgRoot),
146    directory_files(PkgRoot, Candidates),
147    '$member'(Pkg, Candidates),
148    \+ special(Pkg),
149    atomic_list_concat([PkgRoot, Pkg], /, PkgBinDir),
150    atomic_list_concat([PkgBinDir, 'CMakeFiles'], /, CMakeDir),
151    exists_directory(CMakeDir).
152
153special(.).
154special(..).
155
156:- multifile user:file_search_path/2.
157:- dynamic   user:file_search_path/2.
158
159user:file_search_path(library, swi(packages)).
160user:file_search_path(foreign, AppDir) :-
161    current_prolog_flag(windows, true),
162    current_prolog_flag(executable, Exe),
163    file_directory_name(Exe, AppDir).
164
165%!  add_package(+Package, +PkgSrcDir, +PkgBinDir) is det.
166%
167%   Setup the source paths and initialization for Package with the given
168%   source and binary location.
169
170add_package(xpce, PkgBinDir) :-
171    !,
172    add_package_path(PkgBinDir),
173    cmake_source_directory(Root),
174    atomic_list_concat([Root, 'packages/xpce/swipl/swipl-rc'], /, PceLinkFile),
175    use_module(PceLinkFile).
176add_package(chr, PkgBinDir) :-
177    assertz(user:file_search_path(chr, PkgBinDir)),
178    assertz(user:file_search_path(chr, library(chr))),
179    assertz(user:file_search_path(library, PkgBinDir)).
180add_package(jpl, PkgBinDir) :-
181    add_package_path(PkgBinDir),
182    atomic_list_concat([PkgBinDir, 'src/main/java'], /, JarDir),
183    assertz(user:file_search_path(jar, JarDir)).
184add_package(http, PkgBinDir) :-
185    add_package_path(PkgBinDir),
186    file_directory_name(PkgBinDir, PkgDir),
187    assertz(user:file_search_path(library, PkgDir)).
188add_package(_Pkg, PkgBinDir) :-
189    add_package_path(PkgBinDir).
190
191%!  add_package_path(+PkgBinDir) is det.
192%
193%   Add the source  and  binary  directories   for  the  package  to the
194%   `library` and `foreign` search paths. Note that  we only need to add
195%   the binary directory if  it  contains   shared  objects,  but  it is
196%   probably cheaper to add it anyway.
197
198add_package_path(PkgBinDir) :-
199    (   current_prolog_flag(windows, true)
200    ->  true
201    ;   assertz(user:file_search_path(foreign, PkgBinDir))
202    ).
203
204:- if(\+ current_prolog_flag(emscripten, true)).
205% disabled as we do not (yet) have packages and opendir() is broken
206% and this directory_files/2 raises an exception.
207:- forall(swipl_package(Pkg, PkgBinDir),
208          add_package(Pkg, PkgBinDir)).
209:- endif.
210
211%!  set_version_info
212%
213%   Indicate we are running from the   build directory rather than using
214%   an installed version.
215
216set_version_info :-
217    (   cmake_binary_directory(BinDir)
218    ->  version(format('    CMake built from "~w"', [BinDir]))
219    ;   current_prolog_flag(home, Home)
220    ->  version(format('    CMake built with home "~w"', [Home]))
221    ).
222
223:- initialization(set_version_info).
224
225% Avoid getting Java from the host when running under Wine.
226
227:- if(current_prolog_flag(wine_version, _)).
228delete_host_java_home :-
229    (   getenv('JAVA_HOME', Dir),
230        sub_atom(Dir, 0, _, _, /)
231    ->  unsetenv('JAVA_HOME')
232    ;   true
233    ).
234
235:- initialization(delete_host_java_home).
236:- endif.
237
238
239		 /*******************************
240		 *        DOCUMENTATION		*
241		 *******************************/
242
243user:file_search_path(swi_man_manual, ManDir) :-
244    cmake_binary_directory(BinDir),
245    atomic_list_concat([BinDir, 'man/Manual'], /, ManDir).
246user:file_search_path(swi_man_packages, BinDir) :-
247    swipl_package(_, BinDir).
248
249
250		 /*******************************
251		 *        CONFIGURATION		*
252		 *******************************/
253
254:- multifile
255    prolog:runtime_config/2.
256
257prolog:runtime_config(c_libdir, LibDir) :-
258    cmake_binary_directory(BinDir),
259    atomic_list_concat([BinDir, src], /, LibDir).
260