1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
2
3    Author:        Jan Wielemaker and Anjo Anjewierden
4    E-mail:        jan@swi.psy.uva.nl
5    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
6    Copyright (c)  1996-2018, University of 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(man_word_index,
37          [ pce_make_manual_index/0,
38            pce_make_manual_index/1,    % +File
39            pce_make_manual_index/2     % +File, -Reference
40          ]).
41:- use_module(user:library(pce)).       % HACK: needed for build process
42:- use_module(library(pce)).
43:- use_module(library(pce_manual)).
44:- require([ atomic_list_concat/2
45           ]).
46
47:- dynamic
48    use_gui/0,
49    quiet/0.
50
51quiet.
52
53:- pce_begin_class(man_index_manager, object,
54                   "Dummy object to exploit XPCE autoloader").
55
56make_index(_IM, IndexFile:name, Index:chain_table) :<-
57    asserta(use_gui),
58    pce_make_manual_index(IndexFile, Index).
59
60:- pce_end_class.
61
62
63%       make_manual_index([+File, [-Reference]])
64%
65%       Creates a word index for the manual system.  This index is a
66%       chain_table mapping all words that appear in the manual onto
67%       a chain of card identifiers.
68%
69%       At the moment only all class-related cards (classes, variables,
70%       methods and class-variables are processed.
71
72
73pce_ifhostproperty(prolog(quintus),
74(   access_file(File, Mode) :-
75        can_open_file(File, Mode))).
76
77pce_make_manual_index :-
78    absolute_file_name(pce('man/reference/index.obj'), File),
79    pce_make_manual_index(File).
80pce_make_manual_index(File, @man_tmp_index) :-
81    pce_make_manual_index(File).
82pce_make_manual_index(File) :-
83    prepare_manual,
84    access_file(File, write),      % just make sure!
85    !,
86    new(Ch, chain),                 % gather all built-in classes
87    send(@man_tmp_view, format, 'Collecting built-in classes ... '),
88    send(@man_tmp_view, synchronise),
89    send(@classes, for_all,
90         if(@arg2?creator == built_in,
91            message(Ch, append, @arg2))),
92    send(Ch, sort, ?(@arg1?name, compare, @arg2?name)),
93    send(@man_tmp_view, format, '%d classes.\n', Ch?size),
94    send(@man_tmp_view, synchronise),
95    send(Ch, for_all, message(@prolog, make_class_index, @arg1)),
96    make_module_index,
97    send(@man_tmp_view, format, '\n\nCleaning index table'),
98    send(@man_tmp_view, synchronise),
99    clean_index(@man_tmp_index),
100    send(@man_tmp_view, format, 'Cleaning done\n\n'),
101    send(@man_tmp_view, format, 'Saving index table to %s ... ', File),
102    send(@man_tmp_view, synchronise),
103    send(@man_tmp_index, save_in_file, File),
104    send(@man_tmp_view, format, '%d bytes. Finished.\n', file(File)?size),
105    send(@man_tmp_view, synchronise),
106    (   get(@man_tmp_view?frame, member, dialog, D),
107        get(D, member, quit, Quit),
108        get(D, member, abort, Abort)
109    ->  send(Quit, active, @on),
110        send(Abort, active, @off)
111    ;   true
112    ).
113pce_make_manual_index(File) :-
114    send(file(File), report, error, 'Cannot write %s', File),
115    fail.
116
117make_class_index(Class) :-
118    get(Class, name, Name),
119    (   get(@man_tmp_view, column, C),
120        C > 64
121    ->  send(@man_tmp_view, newline)
122    ;   true
123    ),
124    send(@man_tmp_view, format, '(%s', Name),
125    send(@man_tmp_view, synchronise),
126    new(Objs, chain),
127    send(Objs, merge, Class?send_methods),
128    send(Objs, merge, Class?get_methods),
129    send(Objs, for_all,
130         if(message(@arg1?message, instance_of, c_pointer),
131            message(Objs, delete, @arg1))),
132    send(Class?instance_variables, for_all,
133         message(Objs, append, @arg1)),
134    send(Objs, merge, Class?class_variables),
135    send(Objs, append, Class),
136    send(Objs, for_all,
137         message(@prolog, make_card_index, @arg1)),
138    send(Objs, done),
139    send(@man_tmp_view, format, ') ', Name),
140    send(@man_tmp_view, synchronise).
141
142make_card_index(Card) :-
143    get(Card, man_id, Id),
144    (   get(Card, man_summary, Summary)
145    ->  word_index(Summary, Id)
146    ;   true
147    ),
148    (   get(Card, man_description, Description)
149    ->  word_index(Description, Id)
150    ;   true
151    ).
152
153
154:- pce_global(@man_tmp_view, make_man_tmp_view).
155:- pce_global(@man_tmp_index, new(chain_table)).
156:- pce_global(@man_tmp_index_regex, make_index_regex).
157
158make_index_regex(R) :-
159    new(R, regex('@?[a-zA-Z]\\w+')),
160    send(R, compile, @on).
161
162make_man_tmp_view(V) :-
163    use_gui,
164    !,
165    new(V, view('Build PCE manual index')),
166    send(new(D, dialog), below, V),
167    send(D, append, new(Quit, button(quit, message(D, destroy)))),
168    send(Quit, active, @off),
169    send(D, append,
170         button(abort,
171                and(message(@display, confirm,
172                            'Abort generation of search index?'),
173                    message(@prolog, halt)))),
174    send(D, append, label(reporter), right),
175    send(V, open),
176    send(V, wait),
177    send(V, format, 'Building PCE manual index.\n'),
178    send(V, format, 'This process will take several minutes.\n\n').
179make_man_tmp_view(V) :-
180    new(V, man_index_output).
181
182word_index(Text, Id) :-
183    send(@man_tmp_index_regex, for_all, Text,
184         message(@man_tmp_index, append,
185                 ?(@arg1, register_value, @arg2, 0, name)?downcase, Id)).
186
187:- pce_begin_class(man_index_output, object,
188                   "Dummy drain to catch feedback in non-gui mode").
189
190synchronise(_) :->
191    true.
192
193column(_, C) :<-
194    C = 0.
195
196format(_, Fmt:char_array, Args:any ...) :->
197    (   quiet
198    ->  true
199    ;   Msg =.. [format, Fmt | Args],
200        send(@pce, Msg),
201        flush
202    ).
203
204frame(_, _) :<-
205    fail.
206
207:- pce_end_class.
208
209
210                 /*******************************
211                 *             MANUAL           *
212                 *******************************/
213
214prepare_manual :-
215    use_gui,
216    !,
217    manpce.
218prepare_manual :-
219    new(Directory, directory('$PCEHOME/man/reference')),
220    new(@man_space, man_space(reference, Directory)),
221    send(@pce, send_method,         % make it silent
222         send_method(report, vector('any ...'), new(and))).
223
224
225                 /*******************************
226                 *        NON-CLASS CARDS       *
227                 *******************************/
228
229non_class_module(predicates).
230non_class_module(objects).
231non_class_module(tools).
232
233make_module_index :-
234    send(@man_tmp_view, format, '\n\n'),
235    non_class_module(Module),
236    send(@man_tmp_view, format, '%s index ... ', Module),
237    send(@man_tmp_view, synchronise),
238    make_module_index(Module),
239    send(@man_tmp_view, format, 'done.\n'),
240    send(@man_tmp_view, synchronise),
241    fail.
242make_module_index.
243
244make_module_index(ModuleName) :-
245    (   object(@manual)
246    ->  get(@manual, space, ManSpace)
247    ;   ManSpace = @man_space       % non-gui building
248    ),
249    get(ManSpace, module, ModuleName, @on, Module),
250    send(Module?id_table, for_all,
251         message(@prolog, index_card, ModuleName, @arg1, @arg2)).
252
253
254index_card(Module, CardId, Card) :-
255    send(@man_tmp_view, synchronise),
256    atomic_list_concat([$, Module, $, CardId], Id),
257    (   get(Card, man_summary, Summary)
258    ->  word_index(Summary, Id)
259    ;   true
260    ),
261    (   get(Card, man_description, Description)
262    ->  word_index(Description, Id)
263    ;   true
264    ).
265
266
267                 /*******************************
268                 *             CLEAN            *
269                 *******************************/
270
271/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
272These words appear in more then 500 cards and probably have little value
273in specifying search  options.   Deleting   them  significantly  reduces
274memory and saves time with loading and processing the index.
275- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
276
277noindex(and).
278noindex(will).
279noindex(was).
280noindex(using).
281noindex(is).
282noindex(or).
283noindex(not).
284noindex(the).
285noindex(a).
286noindex(an).
287noindex(class).
288noindex(object).
289noindex(method).
290noindex(that).
291noindex(also).
292noindex(see).
293noindex(it).
294noindex(to).
295noindex(used).
296noindex(when).
297noindex(by).
298noindex(of).
299noindex(with).
300noindex(from).
301noindex(if).
302noindex(in).
303noindex(are).
304noindex(be).
305noindex(this).
306
307clean_index(Table) :-
308    noindex(Word),
309    get(Table, member, Word, Chain),
310    get(Chain, size, Size),
311    send(@man_tmp_view, format, 'Deleted "%s", %d entries\n', Word, Size),
312    send(@man_tmp_view, synchronise),
313    send(Table, delete, Word),
314    fail.
315clean_index(Table) :-
316    send(Table, for_all, message(@arg2, unique)).
317
318
319