1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
2
3    Author:        Jan Wielemaker and Anjo Anjewierden
4    E-mail:        wielemak@science.uva.nl
5    WWW:           http://www.swi-prolog.org/packages/xpce/
6    Copyright (c)  2006-2015, University of Amsterdam
7    All rights reserved.
8
9    Redistribution and use in source and binary forms, with or without
10    modification, are permitted provided that the following conditions
11    are met:
12
13    1. Redistributions of source code must retain the above copyright
14       notice, this list of conditions and the following disclaimer.
15
16    2. Redistributions in binary form must reproduce the above copyright
17       notice, this list of conditions and the following disclaimer in
18       the documentation and/or other materials provided with the
19       distribution.
20
21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32    POSSIBILITY OF SUCH DAMAGE.
33*/
34
35:- module(pce_xref_gui,
36          [ gxref/0,
37            xref_file_imports/2,        % +File, -Imports
38            xref_file_exports/2         % +File, -Exports
39          ]).
40:- use_module(pce).
41:- use_module(persistent_frame).
42:- use_module(tabbed_window).
43:- use_module(toolbar).
44:- use_module(pce_report).
45:- use_module(pce_util).
46:- use_module(pce_toc).
47:- use_module(pce_arm).
48:- use_module(pce_tagged_connection).
49:- use_module(dragdrop).
50:- use_module(pce_prolog_xref).
51:- use_module(print_graphics).
52:- use_module(tabular).
53:- use_module(library(lists)).
54:- use_module(library(autowin)).
55:- use_module(library(broadcast)).
56:- use_module(library(prolog_source)).
57:- require([ auto_call/1,
58	     edit/1,
59	     exists_file/1,
60	     (\=)/2,
61	     call_cleanup/2,
62	     file_base_name/2,
63	     file_directory_name/2,
64	     portray_clause/2,
65	     term_to_atom/2,
66	     time_file/2,
67	     absolute_file_name/3,
68	     atomic_list_concat/3,
69	     file_name_extension/3,
70	     format_time/3,
71	     maplist/3,
72	     strip_module/3,
73	     xref_called/4
74	   ]).
75
76gxref_version('0.1.1').
77
78:- dynamic
79    setting/2.
80
81setting_menu([ warn_autoload,
82               warn_not_called
83             ]).
84
85setting(warn_autoload,      false).
86setting(warn_not_called,    true).
87setting(hide_system_files,  true).
88setting(hide_profile_files, true).
89
90/** <module> Cross-referencer front-end
91
92XPCE based font-end of the Prolog cross-referencer.  Tasks:
93
94        * Cross-reference currently loaded program              OK
95        * Generate module-dependency graph                      OK
96        * Information on
97                - Syntax and other encountered errors
98                - Export/Import relation between modules        OK
99                - Undefined predicates                          OK
100                - Unused predicates                             OK
101        * Summary information
102                - Syntax and other encountered errors
103                - Exports never used (not for libs!)
104                - Undefined predicates
105                - Unused predicates
106        * Export module import and export header
107                - Using require/1
108                - Using use_module/1
109                - Using use_module/2                            OK
110                - Export header for non-module files            OK
111
112@bug    Tool produces an error if a file that has been xref'ed is
113        deleted.  Paulo Moura.
114@see    library(prolog_xref) holds the actual data-collection.
115*/
116
117%!  gxref
118%
119%   Start graphical cross-referencer on loaded program.  The GUI
120%   is started in the XPCE thread.
121
122gxref :-
123    in_pce_thread(xref_gui).
124
125xref_gui :-
126    send(new(XREF, xref_frame), open),
127    send(XREF, wait),
128    send(XREF, update).
129
130
131:- pce_begin_class(xref_frame, persistent_frame,
132                   "GUI for the Prolog cross-referencer").
133
134initialise(F) :->
135    send_super(F, initialise, 'Prolog XREF'),
136    new(FilterDialog, xref_filter_dialog),
137    send(new(BrowserTabs, tabbed_window), below, FilterDialog),
138    send(BrowserTabs, left, new(WSTabs, tabbed_window)),
139    send(BrowserTabs, name, browsers),
140    send(BrowserTabs, hor_shrink, 10),
141    send(BrowserTabs, hor_stretch, 10),
142    send(WSTabs, name, workspaces),
143    send_list([BrowserTabs, WSTabs], label_popup, F?tab_popup),
144    send(new(TD, tool_dialog(F)), above, BrowserTabs),
145    send(new(report_dialog), below, BrowserTabs),
146    send(F, append, BrowserTabs),
147    send_list(BrowserTabs,
148              [ append(new(xref_file_tree), files),
149                append(new(xref_predicate_browser), predicates)
150              ]),
151    send_list(WSTabs,
152              [ append(new(xref_depgraph), dependencies)
153              ]),
154    send(F, fill_toolbar, TD).
155
156tab_popup(_F, P:popup) :<-
157    "Popup for tab labels"::
158    new(P, popup),
159    send_list(P, append,
160              [ menu_item(close, message(@arg1, destroy)),
161                menu_item(detach, message(@arg1, untab))
162              ]).
163
164fill_toolbar(F, TD:tool_dialog) :->
165    send(TD, append, new(File, popup(file))),
166    send(TD, append,
167         new(Settings, popup(settings,
168                             message(F, setting, @arg1, @arg2)))),
169    send(TD, append, new(View, popup(view))),
170    send(TD, append, new(Help, popup(help))),
171    send_list(File, append,
172              [ menu_item(exit, message(F, destroy))
173              ]),
174    send_list(View, append,
175              [ menu_item(refresh, message(F, update))
176              ]),
177    send_list(Help, append,
178              [ menu_item(about, message(F, about))
179              ]),
180    send(Settings, show_current, @on),
181    send(Settings, multiple_selection, @on),
182    send(F, update_setting_menu).
183
184about(_F) :->
185    gxref_version(Version),
186    send(@display, inform,
187         string('SWI-Prolog cross-referencer version %s\n\c
188                    By Jan Wielemaker', Version)).
189
190:- pce_group(parts).
191
192workspace(F, Which:name, Create:[bool], Expose:bool, WS:window) :<-
193    "Find named workspace"::
194    get(F, member, workspaces, Tabs),
195    (   get(Tabs, member, Which, WS)
196    ->  true
197    ;   Create == @on
198    ->  workspace_term(Which, New),
199        new(WS, New),
200        send(WS, name, Which),
201        send(Tabs, append, WS)
202    ),
203    (   Expose == @on
204    ->  send(Tabs, on_top, WS?name)
205    ;   true
206    ).
207
208workspace_term(file_info, prolog_file_info).
209workspace_term(header,    xref_view).
210
211browser(F, Which:name, Browser:browser) :<-
212    "Find named browser"::
213    get(F, member, browsers, Tabs),
214    get(Tabs, member, Which, Browser).
215
216update(F) :->
217    "Update all windows"::
218    send(F, xref_all),
219    get(F, member, browsers, Tabs),
220    send(Tabs?members, for_some,
221         message(@arg1, update)),
222    get(F, member, workspaces, WSs),
223    send(WSs?members, for_some,
224         message(@arg1, update)).
225
226xref_all(F) :->
227    "Run X-referencer on all files"::
228    forall(( source_file(File),
229             exists_file(File)
230           ),
231           send(F, xref_file, File)).
232
233xref_file(F, File:name) :->
234    "XREF a single file if not already done"::
235    (   xref_done(File, Time),
236        catch(time_file(File, Modified), _, fail),
237        Modified == Time
238    ->  true
239    ;   send(F, report, progress, 'XREF %s', File),
240        xref_source(File, [silent(true)]),
241        send(F, report, done)
242    ).
243
244:- pce_group(actions).
245
246
247file_info(F, File:name) :->
248    "Show summary info on File"::
249    get(F, workspace, file_info, @on, @on, Window),
250    send(Window, file, File),
251    broadcast(xref_refresh_file(File)).
252
253file_header(F, File:name) :->
254    "Create import/export header"::
255    get(F, workspace, header, @on, @on, View),
256    send(View, file_header, File).
257
258:- pce_group(settings).
259
260update_setting_menu(F) :->
261    "Update the menu for the settings with the current values"::
262    get(F, member, tool_dialog, TD),
263    get(TD, member, menu_bar, MB),
264    get(MB, member, settings, Popup),
265    send(Popup, clear),
266    setting_menu(Entries),
267    (   member(Name, Entries),
268        setting(Name, Value),
269        send(Popup, append, new(MI, menu_item(Name))),
270        (   Value == true
271        ->  send(MI, selected, @on)
272        ;   true
273        ),
274        fail ; true
275    ).
276
277setting(F, S:name, PceVal:bool) :->
278    "Update setting and redo analysis"::
279    pce_to_prolog_bool(PceVal, Val),
280    retractall(setting(S, _)),
281    assert(setting(S, Val)),
282    send(F, update).
283
284pce_to_prolog_bool(@on, true).
285pce_to_prolog_bool(@off, false).
286
287:- pce_end_class(xref_frame).
288
289
290                 /*******************************
291                 *            WORKSPACE         *
292                 *******************************/
293
294:- pce_begin_class(xref_depgraph, picture,
295                   "Workspace showing dependecies").
296:- use_class_template(arm).
297:- use_class_template(print_graphics).
298
299initialise(W) :->
300    send_super(W, initialise),
301    send(W, popup, new(P, popup)),
302    send_list(P, append,
303              [ menu_item(layout, message(W, layout)),
304                gap,
305                menu_item(view_whole_project, message(W, show_project)),
306                gap,
307                menu_item(clear, message(W, clear, destroy)),
308                gap,
309                menu_item(print, message(W, print))
310              ]).
311
312update(P) :->
313    "Initial screen"::
314    send(P, display,
315         new(T, text('Drag files or directories to dependency view\n\c
316                          or use background menu to show the whole project')),
317         point(10,10)),
318    send(T, name, intro_text),
319    send(T, colour, grey50).
320
321remove_intro_text(P) :->
322    "Remove the introductionary text"::
323    (   get(P, member, intro_text, Text)
324    ->  send(Text, destroy)
325    ;   true
326    ).
327
328show_project(P) :->
329    get(P, sources, Sources),
330    send(P, clear, destroy),
331    forall(member(Src, Sources),
332           send(P, append, Src)),
333    send(P, update_links),
334    send(P, layout).
335
336sources(_, Sources:prolog) :<-
337    findall(S, dep_source(S), Sources).
338
339%!  dep_source(?Src)
340%
341%   Generate all sources for the dependecy graph one-by-one.
342
343dep_source(Src) :-
344    source_file(Src),
345    (   setting(hide_system_files, true)
346    ->  \+ library_file(Src)
347    ;   true
348    ),
349    (   setting(hide_profile_files, true)
350    ->  \+ profile_file(Src)
351    ;   true
352    ).
353
354append(P, File:name, Create:[bool|{always}]) :->
355    "Append File.  If Create == always also if a system file"::
356    default(Create, @on, C),
357    get(P, node, File, C, _).
358
359node(G, File:name, Create:[bool|{always}], Pos:[point],
360     Gr:xref_file_graph_node) :<-
361    "Get the node representing File"::
362    (   get(G, member, File, Gr)
363    ->  true
364    ;   (   Create == @on
365        ->  dep_source(File)
366        ;   Create == always
367        ),
368        (   Pos == @default
369        ->  get(G?visible, center, At)
370        ;   At = Pos
371        ),
372        send(G, display, new(Gr, xref_file_graph_node(File)), At),
373        send(G, remove_intro_text)
374    ).
375
376update_links(G) :->
377    "Add all export links"::
378    send(G?graphicals, for_all,
379         if(message(@arg1, instance_of, xref_file_graph_node),
380            message(@arg1, create_export_links))).
381
382layout(G, MoveOnly:[chain]) :->
383    "Do graph layout"::
384    get(G?graphicals, find_all,
385        message(@arg1, instance_of, xref_file_graph_node), Nodes),
386    get(Nodes, find_all, not(@arg1?connections), UnConnected),
387    send(Nodes, subtract, UnConnected),
388    new(Pos, point(10,10)),
389    send(UnConnected, for_all,
390         and(message(@arg1, position, Pos),
391             message(Pos, offset, 0, 25))),
392    get(Nodes, head, First),
393    send(First, layout,
394         nominal := 100,
395         iterations := 1000,
396         network := Nodes,
397         move_only := MoveOnly).
398
399
400:- pce_group(dragdrop).
401
402drop(G, Obj:object, Pos:point) :->
403    "Drop a file on the graph"::
404    (   send(Obj, instance_of, xref_file_text)
405    ->  get(Obj, path, File),
406        (   get(G, node, File, Node)
407        ->  send(Node, flash)
408        ;   get(G, node, File, always, Pos, _Node),
409            send(G, update_links)
410        )
411    ;   send(Obj, instance_of, xref_directory_text)
412    ->  get(Obj, files, Files),
413        layout_new(G,
414                   (   send(Files, for_all,
415                            message(G, append, @arg1, always)),
416                       send(G, update_links)
417                   ))
418    ).
419
420preview_drop(G, Obj:object*, Pos:point) :->
421    "Show preview of drop"::
422    (   Obj == @nil
423    ->  send(G, report, status, '')
424    ;   send(Obj, instance_of, xref_file_text)
425    ->  (   get(Obj, device, G)
426        ->  send(Obj, move, Pos)
427        ;   get(Obj, path, File),
428            get(Obj, string, Label),
429            (   get(G, node, File, _Node)
430            ->  send(G, report, status, '%s: already in graph', Label)
431            ;   send(G, report, status, 'Add %s to graph', Label)
432            )
433        )
434    ;   send(Obj, instance_of, xref_directory_text)
435    ->  get(Obj, path, Path),
436        send(G, report, status, 'Add files from directory %s', Path)
437    ).
438
439:- pce_end_class(xref_depgraph).
440
441:- pce_begin_class(xref_file_graph_node, xref_file_text).
442
443:- send(@class, handle, handle(w/2, 0, link, north)).
444:- send(@class, handle, handle(w, h/2, link, west)).
445:- send(@class, handle, handle(w/2, h, link, south)).
446:- send(@class, handle, handle(0, h/2, link, east)).
447
448initialise(N, File:name) :->
449    send_super(N, initialise, File),
450    send(N, font, bold),
451    send(N, background, grey80).
452
453create_export_links(N, Add:[bool]) :->
454    "Create the export links to other files"::
455    get(N, path, Exporter),
456    forall(export_link(Exporter, Importer, Callables),
457           create_export_link(N, Add, Importer, Callables)).
458
459create_export_link(From, Add, Importer, Callables) :-
460    (   get(From?device, node, Importer, Add, INode)
461    ->  send(From, link, INode, Callables)
462    ;   true
463    ).
464
465create_import_links(N, Add:[bool]) :->
466    "Create the import links from other files"::
467    get(N, path, Importer),
468    forall(export_link(Exporter, Importer, Callables),
469           create_import_link(N, Add, Exporter, Callables)).
470
471create_import_link(From, Add, Importer, Callables) :-
472    (   get(From?device, node, Importer, Add, INode)
473    ->  send(INode, link, From, Callables)
474    ;   true
475    ).
476
477link(N, INode:xref_file_graph_node, Callables:prolog) :->
478    "Create export link to INode"::
479    (   get(N, connections, INode, CList),
480        get(CList, find, @arg1?from == N, C)
481    ->  send(C, callables, Callables)
482    ;   new(L, xref_export_connection(N, INode, Callables)),
483        send(L, hide)
484    ).
485
486:- pce_global(@xref_file_graph_node_recogniser,
487              make_xref_file_graph_node_recogniser).
488
489make_xref_file_graph_node_recogniser(G) :-
490    new(G, move_gesture(left, '')).
491
492event(N, Ev:event) :->
493    "Add moving (overrule supreclass"::
494    (   send(@xref_file_graph_node_recogniser, event, Ev)
495    ->  true
496    ;   send_super(N, event, Ev)
497    ).
498
499popup(N, Popup:popup) :<-
500    get_super(N, popup, Popup),
501    send_list(Popup, append,
502              [ gap,
503                menu_item(show_exports,
504                          message(@arg1, show_import_exports, export)),
505                menu_item(show_imports,
506                          message(@arg1, show_import_exports, import)),
507                gap,
508                menu_item(hide,
509                          message(@arg1, destroy))
510              ]).
511
512show_import_exports(N, Which:{import,export}) :->
513    "Show who I'm exporting to"::
514    get(N, device, G),
515    layout_new(G,
516               (   (   Which == export
517                   ->  send(N, create_export_links, @on)
518                   ;   send(N, create_import_links, @on)
519                   ),
520                   send(G, update_links)
521               )).
522
523layout_new(G, Goal) :-
524    get(G?graphicals, find_all,
525        message(@arg1, instance_of, xref_file_graph_node), Nodes0),
526    Goal,
527    get(G?graphicals, find_all,
528        message(@arg1, instance_of, xref_file_graph_node), Nodes),
529    send(Nodes, subtract, Nodes0),
530    (   send(Nodes, empty)
531    ->  send(G, report, status, 'No nodes added')
532    ;   send(G, layout, Nodes),
533        get(Nodes, size, Size),
534        send(G, report, status, '%d nodes added', Size)
535    ).
536
537:- pce_end_class(xref_file_graph_node).
538
539:- pce_begin_class(xref_export_connection, tagged_connection).
540
541variable(callables, prolog, get, "Callables in Import/export link").
542
543initialise(C, From:xref_file_graph_node, To:xref_file_graph_node,
544           Callables:prolog) :->
545    send_super(C, initialise, From, To),
546    send(C, arrows, second),
547    send(C, slot, callables, Callables),
548    length(Callables, N),
549    send(C, tag, xref_export_connection_tag(C, N)).
550
551callables(C, Callables:prolog) :->
552    send(C, slot, callables, Callables). % TBD: update tag?
553
554called_by_popup(Conn, P:popup) :<-
555    "Create popup to show relating predicates"::
556    new(P, popup(called_by, message(Conn, edit_callable, @arg1))),
557    get(Conn, callables, Callables),
558    get(Conn?from, path, ExportFile),
559    get(Conn?to, path, ImportFile),
560    sort_callables(Callables, Sorted),
561    forall(member(C, Sorted),
562           append_io_callable(P, ImportFile, ExportFile, C)).
563
564%!  append_io_callable(+Popup, -ImportFile, +Callable)
565
566append_io_callable(P, ImportFile, ExportFile, Callable) :-
567    callable_to_label(Callable, Label),
568    send(P, append, new(MI, menu_item(@nil, @default, Label))),
569    send(MI, popup, new(P2, popup)),
570    send(P2, append,
571         menu_item(prolog('<definition>'(Callable)),
572                   @default, definition?label_name)),
573    send(P2, append, gap),
574    qualify_from_file(Callable, ExportFile, QCall),
575    findall(By, used_in(ImportFile, QCall, By), ByList0),
576    sort_callables(ByList0, ByList),
577    forall(member(C, ByList),
578           ( callable_to_label(C, CLabel),
579             send(P2, append, menu_item(prolog(C), @default, CLabel)))).
580
581edit_callable(C, Callable:prolog) :->
582    "Edit definition or callers"::
583    (   Callable = '<definition>'(Def)
584    ->  get(C?from, path, ExportFile),
585        edit_callable(Def, ExportFile)
586    ;   get(C?to, path, ImportFile),
587        edit_callable(Callable, ImportFile)
588    ).
589
590:- pce_end_class(xref_export_connection).
591
592
593:- pce_begin_class(xref_export_connection_tag, text,
594                   "Text showing import/export count").
595
596variable(connection, xref_export_connection, get, "Related connection").
597
598initialise(Tag, C:xref_export_connection, N:int) :->
599    send(Tag, slot, connection, C),
600    send_super(Tag, initialise, string('(%d)', N)),
601    send(Tag, colour, blue),
602    send(Tag, underline, @on).
603
604:- pce_global(@xref_export_connection_tag_recogniser,
605              new(popup_gesture(@receiver?connection?called_by_popup, left))).
606
607event(Tag, Ev:event) :->
608    (   send_super(Tag, event, Ev)
609    ->  true
610    ;   send(@xref_export_connection_tag_recogniser, event, Ev)
611    ).
612
613:- pce_end_class(xref_export_connection_tag).
614
615
616
617%!  export_link(+ExportingFile, -ImportingFile, -Callables) is det.
618%!  export_link(-ExportingFile, +ImportingFile, -Callables) is det.
619%
620%   Callables are exported from ExportingFile to ImportingFile.
621
622export_link(ExportFile, ImportingFile, Callables) :-
623    setof(Callable,
624          export_link_1(ExportFile, ImportingFile, Callable),
625          Callables0),
626    sort_callables(Callables0, Callables).
627
628
629export_link_1(ExportFile, ImportFile, Callable) :-       % module export
630    nonvar(ExportFile),
631    xref_module(ExportFile, Module),
632    !,
633    (   xref_exported(ExportFile, Callable),
634        xref_defined(ImportFile, Callable, imported(ExportFile)),
635        xref_called(ImportFile, Callable)
636    ;   defined(ExportFile, Callable),
637        single_qualify(Module:Callable, QCall),
638        xref_called(ImportFile, QCall)
639    ),
640    ImportFile \== ExportFile,
641    atom(ImportFile).
642export_link_1(ExportFile, ImportFile, Callable) :-      % Non-module export
643    nonvar(ExportFile),
644    !,
645    defined(ExportFile, Callable),
646    xref_called(ImportFile, Callable),
647    atom(ImportFile),
648    ExportFile \== ImportFile.
649export_link_1(ExportFile, ImportFile, Callable) :-      % module import
650    nonvar(ImportFile),
651    xref_module(ImportFile, Module),
652    !,
653    xref_called(ImportFile, Callable),
654    (   xref_defined(ImportFile, Callable, imported(ExportFile))
655    ;   single_qualify(Module:Callable, QCall),
656        QCall = M:G,
657        (   defined(ExportFile, G),
658            xref_module(ExportFile, M)
659        ;   defined(ExportFile, QCall)
660        )
661    ),
662    ImportFile \== ExportFile,
663    atom(ExportFile).
664export_link_1(ExportFile, ImportFile, Callable) :-      % Non-module import
665    xref_called(ImportFile, Callable),
666    \+ (  xref_defined(ImportFile, Callable, How),
667          How \= imported(_)
668       ),
669                                    % see also undefined/2
670    (   xref_defined(ImportFile, Callable, imported(ExportFile))
671    ;   defined(ExportFile, Callable),
672        \+ xref_module(ExportFile, _)
673    ;   Callable = _:_,
674        defined(ExportFile, Callable)
675    ;   Callable = M:G,
676        defined(ExportFile, G),
677        xref_module(ExportFile, M)
678    ).
679
680
681                 /*******************************
682                 *             FILTER           *
683                 *******************************/
684
685:- pce_begin_class(xref_filter_dialog, dialog,
686                   "Show filter options").
687
688class_variable(border, size, size(0,0)).
689
690initialise(D) :->
691    send_super(D, initialise),
692    send(D, hor_stretch, 100),
693    send(D, hor_shrink, 100),
694    send(D, name, filter_dialog),
695    send(D, append, xref_file_filter_item(filter_on_filename)).
696
697resize(D) :->
698    send(D, layout, D?visible?size).
699
700:- pce_end_class(xref_filter_dialog).
701
702
703:- pce_begin_class(xref_file_filter_item, text_item,
704                   "Filter files as you type").
705
706typed(FFI, Id) :->
707    "Activate filter"::
708    send_super(FFI, typed, Id),
709    get(FFI, displayed_value, Current),
710    get(FFI?frame, browser, files, Tree),
711    (   send(Current, equal, '')
712    ->  send(Tree, filter_file_name, @nil)
713    ;   (   text_to_regex(Current, Filter)
714        ->  send(Tree, filter_file_name, Filter)
715        ;   send(FFI, report, status, 'Incomplete expression')
716        )
717    ).
718
719%!  text_to_regex(+Pattern, -Regex) is semidet.
720%
721%   Convert text to a regular expression.  Fail if the text
722%   does not represent a valid regular expression.
723
724text_to_regex(Pattern, Regex) :-
725    send(@pce, last_error, @nil),
726    new(Regex, regex(Pattern)),
727    ignore(pce_catch_error(_, send(Regex, search, ''))),
728    get(@pce, last_error, @nil).
729
730:- pce_end_class(xref_file_filter_item).
731
732
733
734                 /*******************************
735                 *           FILE TREE          *
736                 *******************************/
737
738:- pce_begin_class(xref_file_tree, toc_window,
739                   "Show loaded files as a tree").
740:- use_class_template(arm).
741
742initialise(Tree) :->
743    send_super(Tree, initialise),
744    send(Tree, clear),
745    listen(Tree, xref_refresh_file(File),
746           send(Tree, refresh_file, File)).
747
748unlink(Tree) :->
749    unlisten(Tree),
750    send_super(Tree, unlink).
751
752refresh_file(Tree, File:name) :->
753    "Update given file"::
754    (   get(Tree, node, File, Node)
755    ->  send(Node, set_flags)
756    ;   true
757    ).
758
759collapse_node(_, _:any) :->
760    true.
761
762expand_node(_, _:any) :->
763    true.
764
765update(FL) :->
766    get(FL, expanded_ids, Chain),
767    send(FL, clear),
768    send(FL, report, progress, 'Building source tree ...'),
769    send(FL, append_all_sourcefiles),
770    send(FL, expand_ids, Chain),
771    send(@display, synchronise),
772    send(FL, report, progress, 'Flagging files ...'),
773    send(FL, set_flags),
774    send(FL, report, done).
775
776append_all_sourcefiles(FL) :->
777    "Append all files loaded into Prolog"::
778    forall(source_file(File),
779           send(FL, append, File)),
780    send(FL, sort).
781
782clear(Tree) :->
783    "Remove all nodes, recreate the toplevel"::
784    send_super(Tree, clear),
785    send(Tree, root, new(Root, toc_folder(project, project))),
786    forall(top_node(Name, Class),
787           (   New =.. [Class, Name, Name],
788               send(Tree, son, project, New))),
789    send(Root, for_all, message(@arg1, collapsed, @off)).
790
791append(Tree, File:name) :->
792    "Add Prolog source file"::
793    send(Tree, append_node, new(prolog_file_node(File))).
794
795append_node(Tree, Node:toc_node) :->
796    "Append a given node to the tree"::
797    get(Node, parent_id, ParentId),
798    (   get(Tree, node, ParentId, Parent)
799    ->  true
800    ;   send(Tree, append_node,
801             new(Parent, prolog_directory_node(ParentId)))
802    ),
803    send(Parent, son, Node).
804
805sort(Tree) :->
806    forall(top_node(Name, _),
807           (   get(Tree, node, Name, Node),
808               send(Node, sort_sons, ?(@arg1, compare, @arg2)),
809               send(Node?sons, for_all, message(@arg1, sort))
810           )).
811
812select_node(Tree, File:name) :->
813    "User selected a node"::
814    (   exists_file(File)
815    ->  send(Tree?frame, file_info, File)
816    ;   true
817    ).
818
819set_flags(Tree) :->
820    "Set alert-flags on all nodes"::
821    forall(top_node(Name, _),
822           (   get(Tree, node, Name, Node),
823               (   send(Node, instance_of, prolog_directory_node)
824               ->  send(Node, set_flags)
825               ;   send(Node?sons, for_all, message(@arg1, set_flags))
826               )
827           )).
828
829top_node('.',           prolog_directory_node).
830top_node('alias',       toc_folder).
831top_node('/',           prolog_directory_node).
832
833
834:- pce_group(filter).
835
836filter_file_name(Tree, Regex:regex*) :->
837    "Only show files that match Regex"::
838    (   Regex == @nil
839    ->  send(Tree, filter_files, @nil)
840    ;   send(Tree, filter_files,
841             message(Regex, search, @arg1?base_name))
842    ).
843
844filter_files(Tree, Filter:code*) :->
845    "Highlight files that match Filter"::
846    send(Tree, collapse_all),
847    send(Tree, selection, @nil),
848    (   Filter == @nil
849    ->  send(Tree, expand_id, '.'),
850        send(Tree, expand_id, project)
851    ;   new(Count, number(0)),
852        get(Tree?tree, root, Root),
853        send(Root, for_all,
854             if(and(message(@arg1, instance_of, prolog_file_node),
855                    message(Filter, forward, @arg1)),
856                and(message(Tree, show_node_path, @arg1),
857                    message(Count, plus, 1)))),
858        send(Tree, report, status, 'Filter on file name: %d hits', Count)
859    ),
860    send(Tree, scroll_to, point(0,0)).
861
862show_node_path(Tree, Node:node) :->
863    "Select Node and make sure all parents are expanded"::
864    send(Node, selected, @on),
865    send(Tree, expand_parents, Node).
866
867expand_parents(Tree, Node:node) :->
868    (   get(Node, collapsed, @nil)
869    ->  true
870    ;   send(Node, collapsed, @off)
871    ),
872    send(Node?parents, for_all, message(Tree, expand_parents, @arg1)).
873
874collapse_all(Tree) :->
875    "Collapse all nodes"::
876    get(Tree?tree, root, Root),
877    send(Root, for_all,
878         if(@arg1?collapsed == @off,
879            message(@arg1, collapsed, @on))).
880
881:- pce_end_class(xref_file_tree).
882
883
884:- pce_begin_class(prolog_directory_node, toc_folder,
885                   "Represent a directory").
886
887variable(flags, name*, get, "Warning status").
888
889initialise(DN, Dir:name, Label:[name]) :->
890    "Create a directory node"::
891    (   Label \== @default
892    ->  Name = Label
893    ;   file_alias_path(Name, Dir)
894    ->  true
895    ;   file_base_name(Dir, Name)
896    ),
897    send_super(DN, initialise, xref_directory_text(Dir, Name), Dir).
898
899parent_id(FN, ParentId:name) :<-
900    "Get id for the parent"::
901    get(FN, identifier, Path),
902    (   file_alias_path(_, Path)
903    ->  ParentId = alias
904    ;   file_directory_name(Path, ParentId)
905    ).
906
907sort(DN) :->
908    "Sort my sons"::
909    send(DN, sort_sons, ?(@arg1, compare, @arg2)),
910    send(DN?sons, for_all, message(@arg1, sort)).
911
912compare(DN, Node:toc_node, Diff:{smaller,equal,larger}) :<-
913    "Compare for sorting children"::
914    (   send(Node, instance_of, prolog_file_node)
915    ->  Diff = smaller
916    ;   get(DN, label, L1),
917        get(Node, label, L2),
918        get(L1, compare, L2, Diff)
919    ).
920
921set_flags(DN) :->
922    "Set alert images"::
923    send(DN?sons, for_all, message(@arg1, set_flags)),
924    (   get(DN?sons, find, @arg1?flags \== ok, _Node)
925    ->  send(DN, collapsed_image, @xref_alert_closedir),
926        send(DN, expanded_image, @xref_alert_opendir),
927        send(DN, slot, flags, alert)
928    ;   send(DN, collapsed_image, @xref_ok_closedir),
929        send(DN, expanded_image, @xref_ok_opendir),
930        send(DN, slot, flags, ok)
931    ),
932    send(@display, synchronise).
933
934:- pce_end_class(prolog_directory_node).
935
936
937:- pce_begin_class(prolog_file_node, toc_file,
938                   "Represent a file").
939
940variable(flags,         name*, get, "Warning status").
941variable(base_name,     name,  get, "Base-name of file").
942
943initialise(FN, File:name) :->
944    "Create from a file"::
945    absolute_file_name(File, Path),
946    send_super(FN, initialise, new(T, xref_file_text(Path)), Path),
947    file_base_name(File, Base),
948    send(FN, slot, base_name, Base),
949    send(T, default_action, info).
950
951basename(FN, BaseName:name) :<-
952    "Get basename of the file for sorting"::
953    get(FN, identifier, File),
954    file_base_name(File, BaseName).
955
956parent_id(FN, ParentId:name) :<-
957    "Get id for the parent"::
958    get(FN, identifier, Path),
959    file_directory_name(Path, Dir),
960    (   file_alias_path('.', Dir)
961    ->  ParentId = '.'
962    ;   ParentId = Dir
963    ).
964
965sort(_) :->
966    true.
967
968compare(FN, Node:toc_node, Diff:{smaller,equal,larger}) :<-
969    "Compare for sorting children"::
970    (   send(Node, instance_of, prolog_directory_node)
971    ->  Diff = larger
972    ;   get(FN, basename, L1),
973        get(Node, basename, L2),
974        get(L1, compare, L2, Diff)
975    ).
976
977set_flags(FN) :->
978    "Set alert images"::
979    get(FN, identifier, File),
980    (   file_warnings(File, _)
981    ->  send(FN, image, @xref_alert_file),
982        send(FN, slot, flags, alert)
983    ;   send(FN, image, @xref_ok_file),
984        send(FN, slot, flags, ok)
985    ),
986    send(@display, synchronise).
987
988:- pce_global(@xref_ok_file,
989              make_xref_image([ image('16x16/doc.xpm'),
990                                image('16x16/ok.xpm')
991                              ])).
992:- pce_global(@xref_alert_file,
993              make_xref_image([ image('16x16/doc.xpm'),
994                                image('16x16/alert.xpm')
995                              ])).
996
997:- pce_global(@xref_ok_opendir,
998              make_xref_image([ image('16x16/opendir.xpm'),
999                                image('16x16/ok.xpm')
1000                              ])).
1001:- pce_global(@xref_alert_opendir,
1002              make_xref_image([ image('16x16/opendir.xpm'),
1003                                image('16x16/alert.xpm')
1004                              ])).
1005
1006:- pce_global(@xref_ok_closedir,
1007              make_xref_image([ image('16x16/closedir.xpm'),
1008                                image('16x16/ok.xpm')
1009                              ])).
1010:- pce_global(@xref_alert_closedir,
1011              make_xref_image([ image('16x16/closedir.xpm'),
1012                                image('16x16/alert.xpm')
1013                              ])).
1014
1015make_xref_image([First|More], Image) :-
1016    new(Image, image(@nil, 0, 0, pixmap)),
1017    send(Image, copy, First),
1018    forall(member(I2, More),
1019           send(Image, draw_in, bitmap(I2))).
1020
1021:- pce_end_class(prolog_file_node).
1022
1023
1024
1025
1026                 /*******************************
1027                 *           FILE INFO          *
1028                 *******************************/
1029
1030
1031:- pce_begin_class(prolog_file_info, window,
1032                   "Show information on File").
1033:- use_class_template(arm).
1034
1035variable(tabular,     tabular, get, "Displayed table").
1036variable(prolog_file, name*,   get, "Displayed Prolog file").
1037
1038initialise(W, File:[name]*) :->
1039    send_super(W, initialise),
1040    send(W, pen, 0),
1041    send(W, scrollbars, vertical),
1042    send(W, display, new(T, tabular)),
1043    send(T, rules, all),
1044    send(T, cell_spacing, -1),
1045    send(W, slot, tabular, T),
1046    (   atom(File)
1047    ->  send(W, prolog_file, File)
1048    ;   true
1049    ).
1050
1051resize(W) :->
1052    send_super(W, resize),
1053    get(W?visible, width, Width),
1054    send(W?tabular, table_width, Width-3).
1055
1056
1057file(V, File0:name*) :->
1058    "Set vizualized file"::
1059    (   File0 == @nil
1060    ->  File = File0
1061    ;   absolute_file_name(File0, File)
1062    ),
1063    (   get(V, prolog_file, File)
1064    ->  true
1065    ;   send(V, slot, prolog_file, File),
1066        send(V, update)
1067    ).
1068
1069
1070clear(W) :->
1071    send(W?tabular, clear).
1072
1073
1074update(V) :->
1075    "Show information on the current file"::
1076    send(V, clear),
1077    send(V, scroll_to, point(0,0)),
1078    (   get(V, prolog_file, File),
1079        File \== @nil
1080    ->  send(V?frame, xref_file, File), % Make sure data is up-to-date
1081        send(V, show_info)
1082    ;   true
1083    ).
1084
1085
1086module(W, Module:name) :<-
1087    "Module associated with this file"::
1088    get(W, prolog_file, File),
1089    (   xref_module(File, Module)
1090    ->  true
1091    ;   Module = user               % TBD: does not need to be true!
1092    ).
1093
1094:- pce_group(info).
1095
1096show_info(W) :->
1097    get(W, tabular, T),
1098    BG = (background := khaki1),
1099    get(W, prolog_file, File),
1100    new(FG, xref_file_text(File)),
1101    send(FG, font, huge),
1102    send(T, append, FG, halign := center, colspan := 2, BG),
1103    send(T, next_row),
1104    send(W, show_module),
1105    send(W, show_modified),
1106    send(W, show_undefined),
1107    send(W, show_not_called),
1108    send(W, show_exports),
1109    send(W, show_imports),
1110    true.
1111
1112show_module(W) :->
1113    "Show basic module info"::
1114    get(W, prolog_file, File),
1115    get(W, tabular, T),
1116    (   xref_module(File, Module)
1117    ->  send(T, append, 'Module:', bold, right),
1118        send(T, append, Module),
1119        send(T, next_row)
1120    ;   true
1121    ).
1122
1123show_modified(W) :->
1124    get(W, prolog_file, File),
1125    get(W, tabular, T),
1126    time_file(File, Stamp),
1127    format_time(string(Modified), '%+', Stamp),
1128    send(T, append, 'Modified:', bold, right),
1129    send(T, append, Modified),
1130    send(T, next_row).
1131
1132show_exports(W) :->
1133    get(W, prolog_file, File),
1134    (   xref_module(File, Module),
1135        findall(E, xref_exported(File, E), Exports),
1136        Exports \== []
1137    ->  send(W, show_export_header, export, imported_by),
1138        sort_callables(Exports, Sorted),
1139        forall(member(Callable, Sorted),
1140               send(W, show_module_export, File, Module, Callable))
1141    ;   true
1142    ),
1143    (   findall(C-Fs,
1144                ( setof(F, export_link_1(File, F, C), Fs),
1145                  \+ xref_exported(File, C)),
1146                Pairs0),
1147        Pairs0 \== []
1148    ->  send(W, show_export_header, defined, used_by),
1149        keysort(Pairs0, Pairs),     % TBD
1150        forall(member(Callable-ImportFiles, Pairs),
1151               send(W, show_file_export, Callable, ImportFiles))
1152    ;   true
1153    ).
1154
1155show_export_header(W, Left:name, Right:name) :->
1156    get(W, tabular, T),
1157    BG = (background := khaki1),
1158    send(T, append, Left?label_name, bold, center, BG),
1159    send(T, append, Right?label_name, bold, center, BG),
1160    send(T, next_row).
1161
1162show_module_export(W, File:name, Module:name, Callable:prolog) :->
1163    get(W, prolog_file, File),
1164    get(W, tabular, T),
1165    send(T, append, xref_predicate_text(Module:Callable, @default, File)),
1166    findall(In, exported_to(File, Callable, In), InL),
1167    send(T, append, new(XL, xref_graphical_list)),
1168    (   InL == []
1169    ->  true
1170    ;   sort_files(InL, Sorted),
1171        forall(member(F, Sorted),
1172               send(XL, append, xref_imported_by(F, Callable)))
1173    ),
1174    send(T, next_row).
1175
1176show_file_export(W, Callable:prolog, ImportFiles:prolog) :->
1177    get(W, prolog_file, File),
1178    get(W, tabular, T),
1179    send(T, append, xref_predicate_text(Callable, @default, File)),
1180    send(T, append, new(XL, xref_graphical_list)),
1181    sort_files(ImportFiles, Sorted),
1182    qualify_from_file(Callable, File, QCall),
1183    forall(member(F, Sorted),
1184           send(XL, append, xref_imported_by(F, QCall))),
1185    send(T, next_row).
1186
1187qualify_from_file(Callable, _, Callable) :-
1188    Callable = _:_,
1189    !.
1190qualify_from_file(Callable, File, M:Callable) :-
1191    xref_module(File, M),
1192    !.
1193qualify_from_file(Callable, _, Callable).
1194
1195
1196%!  exported_to(+ExportFile, +Callable, -ImportFile)
1197%
1198%   ImportFile imports Callable from ExportFile.  The second clause
1199%   deals with auto-import.
1200%
1201%   TBD: Make sure the autoload library is loaded before we begin.
1202
1203exported_to(ExportFile, Callable, ImportFile) :-
1204    xref_defined(ImportFile, Callable, imported(ExportFile)),
1205    atom(ImportFile).               % avoid XPCE buffers.
1206exported_to(ExportFile, Callable, ImportFile) :-
1207    '$autoload':library_index(Callable, _, ExportFileNoExt),
1208    file_name_extension(ExportFileNoExt, _, ExportFile),
1209    xref_called(ImportFile, Callable),
1210    atom(ImportFile),
1211    \+ xref_defined(ImportFile, Callable, _).
1212
1213show_imports(W) :->
1214    "Show predicates we import"::
1215    get(W, prolog_file, File),
1216    findall(E-Cs,
1217            setof(C, export_link_1(E, File, C), Cs),
1218            Pairs),
1219    (   Pairs \== []
1220    ->  sort(Pairs, Sorted),        % TBD: use sort_files/2
1221        (   xref_module(File, _)
1222        ->  send(W, show_export_header, from, imports)
1223        ;   send(W, show_export_header, from, uses)
1224        ),
1225        forall(member(E-Cs, Sorted),
1226               send(W, show_import, E, Cs))
1227    ;   true
1228    ).
1229
1230show_import(W, File:name, Callables:prolog) :->
1231    "Show imports from file"::
1232    get(W, tabular, T),
1233    send(T, append, xref_file_text(File)),
1234    send(T, append, new(XL, xref_graphical_list)),
1235    sort_callables(Callables, Sorted),
1236    forall(member(C, Sorted),
1237           send(XL, append, xref_predicate_text(C, @default, File))),
1238    send(T, next_row).
1239
1240
1241show_undefined(W) :->
1242    "Add underfined predicates to table"::
1243    get(W, prolog_file, File),
1244    findall(Undef, undefined(File, Undef), UndefList),
1245    (   UndefList == []
1246    ->  true
1247    ;   BG = (background := khaki1),
1248        get(W, tabular, T),
1249        (   setting(warn_autoload, true)
1250        ->  Label = 'Undefined/autoload'
1251        ;   Label = 'Undefined'
1252        ),
1253        send(T, append, Label, bold, center, BG),
1254        send(T, append, 'Called by', bold, center, BG),
1255        send(T, next_row),
1256        sort_callables(UndefList, Sorted),
1257        forall(member(Callable, Sorted),
1258               send(W, show_undef, Callable))
1259    ).
1260
1261show_undef(W, Callable:prolog) :->
1262    "Show undefined predicate"::
1263    get(W, prolog_file, File),
1264    get(W, module, Module),
1265    get(W, tabular, T),
1266    send(T, append,
1267         xref_predicate_text(Module:Callable, undefined, File)),
1268    send(T, append, new(L, xref_graphical_list)),
1269    findall(By, xref_called(File, Callable, By), By),
1270    sort_callables(By, Sorted),
1271    forall(member(P, Sorted),
1272           send(L, append, xref_predicate_text(Module:P, called_by, File))),
1273    send(T, next_row).
1274
1275
1276show_not_called(W) :->
1277    "Show predicates that are not called"::
1278    get(W, prolog_file, File),
1279    findall(NotCalled, not_called(File, NotCalled), NotCalledList),
1280    (   NotCalledList == []
1281    ->  true
1282    ;   BG = (background := khaki1),
1283        get(W, tabular, T),
1284        send(T, append, 'Not called', bold, center, colspan := 2, BG),
1285         send(T, next_row),
1286        sort_callables(NotCalledList, Sorted),
1287        forall(member(Callable, Sorted),
1288               send(W, show_not_called_pred, Callable))
1289    ).
1290
1291show_not_called_pred(W, Callable:prolog) :->
1292    "Show a not-called predicate"::
1293    get(W, prolog_file, File),
1294    get(W, module, Module),
1295    get(W, tabular, T),
1296    send(T, append,
1297         xref_predicate_text(Module:Callable, not_called, File),
1298         colspan := 2),
1299    send(T, next_row).
1300
1301:- pce_end_class(prolog_file_info).
1302
1303
1304:- pce_begin_class(xref_predicate_text, text,
1305                   "Text representing a predicate").
1306
1307class_variable(colour, colour, dark_green).
1308
1309variable(callable,       prolog, get, "Predicate indicator").
1310variable(classification, [name], get, "Classification of the predicate").
1311variable(file,           name*,  get, "File of predicate").
1312
1313initialise(T, Callable0:prolog,
1314           Class:[{undefined,called_by,not_called}],
1315           File:[name]) :->
1316    "Create from callable or predicate indicator"::
1317    single_qualify(Callable0, Callable),
1318    send(T, slot, callable, Callable),
1319    callable_to_label(Callable, File, Label),
1320    send_super(T, initialise, Label),
1321    (   File \== @default
1322    ->  send(T, slot, file, File)
1323    ;   true
1324    ),
1325    send(T, classification, Class).
1326
1327%!  single_qualify(+Term, -Qualified)
1328%
1329%   Strip redundant M: from the term, leaving at most one qualifier.
1330
1331single_qualify(_:Q0, Q) :-
1332    is_qualified(Q0),
1333    !,
1334    single_qualify(Q0, Q).
1335single_qualify(Q, Q).
1336
1337is_qualified(M:_) :-
1338    atom(M).
1339
1340pi(IT, PI:prolog) :<-
1341    "Get predicate as predicate indicator (Name/Arity)"::
1342    get(IT, callable, Callable),
1343    to_predicate_indicator(Callable, PI).
1344
1345classification(T, Class:[name]) :->
1346    send(T, slot, classification, Class),
1347    (   Class == undefined
1348    ->  get(T, callable, Callable),
1349        strip_module(Callable, _, Plain),
1350        (   autoload_predicate(Plain)
1351        ->  send(T, colour, navy_blue),
1352            send(T, slot, classification, autoload)
1353        ;   global_predicate(Plain)
1354        ->  send(T, colour, navy_blue),
1355            send(T, slot, classification, global)
1356        ;   send(T, colour, red)
1357        )
1358    ;   Class == not_called
1359    ->  send(T, colour, red)
1360    ;   true
1361    ).
1362
1363:- pce_global(@xref_predicate_text_recogniser,
1364              new(handler_group(@arm_recogniser,
1365                                click_gesture(left, '', single,
1366                                              message(@receiver, edit))))).
1367
1368event(T, Ev:event) :->
1369    (   send_super(T, event, Ev)
1370    ->  true
1371    ;   send(@xref_predicate_text_recogniser, event, Ev)
1372    ).
1373
1374
1375arm(TF, Val:bool) :->
1376    "Preview activiity"::
1377    (   Val == @on
1378    ->  send(TF, underline, @on),
1379        (   get(TF, classification, Class),
1380            Class \== @default
1381        ->  send(TF, report, status,
1382                 '%s predicate %s', Class?capitalise, TF?string)
1383        ;   send(TF, report, status,
1384                 'Predicate %s', TF?string)
1385        )
1386    ;   send(TF, underline, @off),
1387        send(TF, report, status, '')
1388    ).
1389
1390edit(T) :->
1391    get(T, file, File),
1392    get(T, callable, Callable),
1393    edit_callable(Callable, File).
1394
1395:- pce_end_class(xref_predicate_text).
1396
1397
1398:- pce_begin_class(xref_file_text, text,
1399                   "Represent a file-name").
1400
1401variable(path,           name,         get, "Filename represented").
1402variable(default_action, name := edit, both, "Default on click").
1403
1404initialise(TF, File:name) :->
1405    absolute_file_name(File, Path),
1406    file_name_on_path(Path, ShortId),
1407    short_file_name_to_atom(ShortId, Label),
1408    send_super(TF, initialise, Label),
1409    send(TF, name, Path),
1410    send(TF, slot, path, Path).
1411
1412:- pce_global(@xref_file_text_recogniser,
1413              make_xref_file_text_recogniser).
1414
1415make_xref_file_text_recogniser(G) :-
1416    new(C, click_gesture(left, '', single,
1417                         message(@receiver, run_default_action))),
1418    new(P, popup_gesture(@arg1?popup)),
1419    new(D, drag_and_drop_gesture(left)),
1420    send(D, cursor, @default),
1421    new(G, handler_group(C, D, P, @arm_recogniser)).
1422
1423popup(_, Popup:popup) :<-
1424    new(Popup, popup),
1425    send_list(Popup, append,
1426              [ menu_item(edit, message(@arg1, edit)),
1427                menu_item(info, message(@arg1, info)),
1428                menu_item(header, message(@arg1, header))
1429              ]).
1430
1431event(T, Ev:event) :->
1432    (   send_super(T, event, Ev)
1433    ->  true
1434    ;   send(@xref_file_text_recogniser, event, Ev)
1435    ).
1436
1437arm(TF, Val:bool) :->
1438    "Preview activity"::
1439    (   Val == @on
1440    ->  send(TF, underline, @on),
1441        send(TF, report, status, 'File %s', TF?path)
1442    ;   send(TF, underline, @off),
1443        send(TF, report, status, '')
1444    ).
1445
1446run_default_action(T) :->
1447    get(T, default_action, Def),
1448    send(T, Def).
1449
1450edit(T) :->
1451    get(T, path, Path),
1452    auto_call(edit(file(Path))).
1453
1454info(T) :->
1455    get(T, path, Path),
1456    send(T?frame, file_info, Path).
1457
1458header(T) :->
1459    get(T, path, Path),
1460    send(T?frame, file_header, Path).
1461
1462prolog_source(T, Src:string) :<-
1463    "Import declarations"::
1464    get(T, path, File),
1465    new(V, xref_view),
1466    send(V, file_header, File),
1467    get(V?text_buffer, contents, Src),
1468    send(V, destroy).
1469
1470:- pce_end_class(xref_file_text).
1471
1472
1473:- pce_begin_class(xref_directory_text, text,
1474                   "Represent a directory-name").
1475
1476variable(path,           name,         get, "Filename represented").
1477
1478initialise(TF, Dir:name, Label:[name]) :->
1479    absolute_file_name(Dir, Path),
1480    (   Label == @default
1481    ->  file_base_name(Path, TheLabel)
1482    ;   TheLabel = Label
1483    ),
1484    send_super(TF, initialise, TheLabel),
1485    send(TF, slot, path, Path).
1486
1487files(DT, Files:chain) :<-
1488    "List of files that belong to this directory"::
1489    new(Files, chain),
1490    get(DT, path, Path),
1491    (   source_file(File),
1492        sub_atom(File, 0, _, _, Path),
1493        send(Files, append, File),
1494        fail ; true
1495    ).
1496
1497:- pce_global(@xref_directory_text_recogniser,
1498              make_xref_directory_text_recogniser).
1499
1500make_xref_directory_text_recogniser(G) :-
1501    new(D, drag_and_drop_gesture(left)),
1502    send(D, cursor, @default),
1503    new(G, handler_group(D, @arm_recogniser)).
1504
1505event(T, Ev:event) :->
1506    (   send_super(T, event, Ev)
1507    ->  true
1508    ;   send(@xref_directory_text_recogniser, event, Ev)
1509    ).
1510
1511arm(TF, Val:bool) :->
1512    "Preview activiity"::
1513    (   Val == @on
1514    ->  send(TF, underline, @on),
1515        send(TF, report, status, 'Directory %s', TF?path)
1516    ;   send(TF, underline, @off),
1517        send(TF, report, status, '')
1518    ).
1519
1520:- pce_end_class(xref_directory_text).
1521
1522
1523:- pce_begin_class(xref_imported_by, figure,
1524                   "Indicate import of callable into file").
1525
1526variable(callable, prolog, get, "Callable term of imported predicate").
1527
1528:- pce_global(@xref_horizontal_format,
1529              make_xref_horizontal_format).
1530
1531make_xref_horizontal_format(F) :-
1532    new(F, format(vertical, 1, @on)),
1533    send(F, row_sep, 3),
1534    send(F, column_sep, 0).
1535
1536initialise(IT, File:name, Imported:prolog) :->
1537    send_super(IT, initialise),
1538    send(IT, format, @xref_horizontal_format),
1539    send(IT, display, new(F, xref_file_text(File))),
1540    send(F, name, file_text),
1541    send(IT, slot, callable, Imported),
1542    send(IT, show_called_by).
1543
1544path(IT, Path:name) :<-
1545    "Represented file"::
1546    get(IT, member, file_text, Text),
1547    get(Text, path, Path).
1548
1549show_called_by(IT) :->
1550    "Add number indicating calls"::
1551    get(IT, called_by, List),
1552    length(List, N),
1553    send(IT, display, new(T, text(string('(%d)', N)))),
1554    send(T, name, called_count),
1555    (   N > 0
1556    ->  send(T, underline, @on),
1557        send(T, colour, blue),
1558        send(T, recogniser, @xref_called_by_recogniser)
1559    ;   send(T, colour, grey60)
1560    ).
1561
1562called_by(IT, ByList:prolog) :<-
1563    "Return list of callables satisfied by the import"::
1564    get(IT, path, Source),
1565    get(IT, callable, Callable),
1566    findall(By, used_in(Source, Callable, By), ByList).
1567
1568%!  used_in(+Source, +QCallable, -CalledBy)
1569%
1570%   Determine which the callers for   QCallable in Source. QCallable
1571%   is qualified with the module of the exporting file (if any).
1572
1573used_in(Source, M:Callable, By) :-              % we are the same module
1574    xref_module(Source, M),
1575    !,
1576    xref_called(Source, Callable, By).
1577used_in(Source, _:Callable, By) :-              % we imported
1578    xref_defined(Source, Callable, imported(_)),
1579    !,
1580    xref_called(Source, Callable, By).
1581used_in(Source, Callable, By) :-
1582    xref_called(Source, Callable, By).
1583used_in(Source, Callable, '<export>') :-
1584    xref_exported(Source, Callable).
1585
1586:- pce_group(event).
1587
1588:- pce_global(@xref_called_by_recogniser,
1589              new(popup_gesture(@receiver?device?called_by_popup, left))).
1590
1591called_by_popup(IT, P:popup) :<-
1592    "Show called where import is called"::
1593    new(P, popup(called_by, message(IT, edit_called_by, @arg1))),
1594    get(IT, called_by, ByList),
1595    sort_callables(ByList, Sorted),
1596    forall(member(C, Sorted),
1597           ( callable_to_label(C, Label),
1598             send(P, append, menu_item(prolog(C), @default, Label)))).
1599
1600edit_called_by(IT, Called:prolog) :->
1601    "Edit file on the predicate Called"::
1602    get(IT, path, Source),
1603    edit_callable(Called, Source).
1604
1605:- pce_end_class(xref_imported_by).
1606
1607
1608:- pce_begin_class(xref_graphical_list, figure,
1609                   "Show list of exports to files").
1610
1611variable(wrap, {extend,wrap,wrap_fixed_width,clip} := extend, get,
1612         "Wrapping mode").
1613
1614initialise(XL) :->
1615    send_super(XL, initialise),
1616    send(XL, margin, 500, wrap).
1617
1618append(XL, I:graphical) :->
1619    (   send(XL?graphicals, empty)
1620    ->  true
1621    ;   send(XL, display, text(', '))
1622    ),
1623    send(XL, display, I).
1624
1625:- pce_group(layout).
1626
1627:- pce_global(@xref_graphical_list_format,
1628              make_xref_graphical_list_format).
1629
1630make_xref_graphical_list_format(F) :-
1631    new(F, format(horizontal, 500, @off)),
1632    send(F, column_sep, 0),
1633    send(F, row_sep, 0).
1634
1635margin(T, Width:int*, How:[{wrap,wrap_fixed_width,clip}]) :->
1636    "Wrap items to indicated width"::
1637    (   Width == @nil
1638    ->  send(T, slot, wrap, extend),
1639        send(T, format, @rdf_composite_format)
1640    ;   send(T, slot, wrap, How),
1641        How == wrap
1642    ->  FmtWidth is max(10, Width),
1643        new(F, format(horizontal, FmtWidth, @off)),
1644        send(F, column_sep, 0),
1645        send(F, row_sep, 0),
1646        send(T, format, F)
1647    ;   throw(tbd)
1648    ).
1649
1650:- pce_end_class(xref_graphical_list).
1651
1652
1653
1654                 /*******************************
1655                 *          PREDICATES          *
1656                 *******************************/
1657
1658:- pce_begin_class(xref_predicate_browser, browser,
1659                 "Show loaded files").
1660
1661initialise(PL) :->
1662    send_super(PL, initialise),
1663    send(PL, popup, new(P, popup)),
1664    send_list(P, append,
1665              [ menu_item(edit, message(@arg1, edit))
1666              ]).
1667
1668update(PL) :->
1669    send(PL, clear),
1670    forall((defined(File, Callable), atom(File), \+ library_file(File)),
1671           send(PL, append, Callable, @default, File)),
1672    forall((xref_current_source(File), atom(File), \+library_file(File)),
1673           forall(undefined(File, Callable),
1674                  send(PL, append, Callable, undefined, File))),
1675    send(PL, sort).
1676
1677append(PL, Callable:prolog, Class:[name], File:[name]) :->
1678    send_super(PL, append, xref_predicate_dict_item(Callable, Class, File)).
1679
1680:- pce_end_class(xref_predicate_browser).
1681
1682
1683:- pce_begin_class(xref_predicate_dict_item, dict_item,
1684                   "Represent a Prolog predicate").
1685
1686variable(callable, prolog, get, "Callable term").
1687variable(file,     name*,  get, "Origin file").
1688
1689initialise(PI, Callable0:prolog, _Class:[name], File:[name]) :->
1690    "Create from callable, class and file"::
1691    single_qualify(Callable0, Callable),
1692    send(PI, slot, callable, Callable),
1693    callable_to_label(Callable, Label),
1694    send_super(PI, initialise, Label),
1695    (   File \== @default
1696    ->  send(PI, slot, file, File)
1697    ;   true
1698    ).
1699
1700edit(PI) :->
1701    "Edit Associated prediate"::
1702    get(PI, file, File),
1703    get(PI, callable, Callable),
1704    edit_callable(Callable, File).
1705
1706:- pce_end_class(xref_predicate_dict_item).
1707
1708
1709                 /*******************************
1710                 *         UTIL CLASSES         *
1711                 *******************************/
1712
1713:- pce_begin_class(xref_view, view,
1714                   "View with additional facilities for formatting").
1715
1716initialise(V) :->
1717    send_super(V, initialise),
1718    send(V, font, fixed).
1719
1720update(_) :->
1721    true.                           % or ->clear?  ->destroy?
1722
1723file_header(View, File:name) :->
1724    "Create import/export fileheader for File"::
1725    (   xref_module(File, _)
1726    ->  Decls = Imports
1727    ;   xref_file_exports(File, Export),
1728        Decls = [Export|Imports]
1729    ),
1730    xref_file_imports(File, Imports),
1731    send(View, clear),
1732    send(View, declarations, Decls),
1733    (   (   nonvar(Export)
1734        ->  send(View, report, status,
1735                 'Created module header for non-module file %s', File)
1736        ;   send(View, report, status,
1737                 'Created import header for module file %s', File)
1738        )
1739    ->  true
1740    ;   true
1741    ).
1742
1743declarations(V, Decls:prolog) :->
1744    pce_open(V, append, Out),
1745    call_cleanup(print_decls(Decls, Out), close(Out)).
1746
1747print_decls([], _) :- !.
1748print_decls([H|T], Out) :-
1749    !,
1750    print_decls(H, Out),
1751    print_decls(T, Out).
1752print_decls(Term, Out) :-
1753    portray_clause(Out, Term).
1754
1755:- pce_end_class(xref_view).
1756
1757
1758                 /*******************************
1759                 *        FILE-NAME LOGIC       *
1760                 *******************************/
1761
1762%!  short_file_name_to_atom(+ShortId, -Atom)
1763%
1764%   Convert a short filename into an atom
1765
1766short_file_name_to_atom(Atom, Atom) :-
1767    atomic(Atom),
1768    !.
1769short_file_name_to_atom(Term, Atom) :-
1770    term_to_atom(Term, Atom).
1771
1772
1773%!  library_file(+Path)
1774%
1775%   True if Path comes from the Prolog tree and must be considered a
1776%   library.
1777
1778library_file(Path) :-
1779    current_prolog_flag(home, Home),
1780    sub_atom(Path, 0, _, _, Home).
1781
1782%!  profile_file(+Path)
1783%
1784%   True if path is a personalisation file.  This is a bit hairy.
1785
1786profile_file(Path) :-
1787    file_name_on_path(Path, user_profile(File)),
1788    known_profile_file(File).
1789
1790known_profile_file('.swiplrc').
1791known_profile_file('swipl.ini').
1792known_profile_file('.pceemacsrc').
1793known_profile_file(File) :-
1794    sub_atom(File, 0, _, _, 'lib/xpce/emacs').
1795
1796%!  sort_files(+Files, -Sorted)
1797%
1798%   Sort files, keeping groups comming from the same alias together.
1799
1800sort_files(Files0, Sorted) :-
1801    sort(Files0, Files),            % remove duplicates
1802    maplist(key_file, Files, Keyed),
1803    keysort(Keyed, KSorted),
1804    unkey(KSorted, Sorted).
1805
1806key_file(File, Key-File) :-
1807    file_name_on_path(File, Key).
1808
1809
1810                 /*******************************
1811                 *           PREDICATES         *
1812                 *******************************/
1813
1814%!  available(+File, +Callable, -HowDefined)
1815%
1816%   True if Callable is available in File.
1817
1818available(File, Called, How) :-
1819    xref_defined(File, Called, How0),
1820    !,
1821    How = How0.
1822available(_, Called, How) :-
1823    built_in_predicate(Called),
1824    !,
1825    How = builtin.
1826available(_, Called, How) :-
1827    setting(warn_autoload, false),
1828    autoload_predicate(Called),
1829    !,
1830    How = autoload.
1831available(_, Called, How) :-
1832    setting(warn_autoload, false),
1833    global_predicate(Called),
1834    !,
1835    How = global.
1836available(_, Called, How) :-
1837    Called = _:_,
1838    defined(_, Called),
1839    !,
1840    How = module_qualified.
1841available(_, M:G, How) :-
1842    defined(ExportFile, G),
1843    xref_module(ExportFile, M),
1844    !,
1845    How = module_overruled.
1846available(_, Called, How) :-
1847    defined(ExportFile, Called),
1848    \+ xref_module(ExportFile, _),
1849    !,
1850    How == plain_file.
1851
1852
1853%!  built_in_predicate(+Callable)
1854%
1855%   True if Callable is a built-in
1856
1857built_in_predicate(Goal) :-
1858    strip_module(Goal, _, Plain),
1859    xref_built_in(Plain).
1860
1861%!  autoload_predicate(+Callable) is semidet.
1862%!  autoload_predicate(+Callable, -File) is semidet.
1863%
1864%   True if Callable can be autoloaded.  TBD: make sure the autoload
1865%   index is up-to-date.
1866
1867autoload_predicate(Goal) :-
1868    '$autoload':library_index(Goal, _, _).
1869
1870
1871autoload_predicate(Goal, File) :-
1872    '$autoload':library_index(Goal, _, FileNoExt),
1873    file_name_extension(FileNoExt, pl, File).
1874
1875
1876%!  global_predicate(+Callable)
1877%
1878%   True if Callable can  be  auto-imported   from  the  global user
1879%   module.
1880
1881global_predicate(Goal) :-
1882    predicate_property(user:Goal, _),
1883    !.
1884
1885%!  to_predicate_indicator(+Term, -PI)
1886%
1887%   Convert to a predicate indicator.
1888
1889to_predicate_indicator(PI, PI) :-
1890    is_predicate_indicator(PI),
1891    !.
1892to_predicate_indicator(Callable, PI) :-
1893    callable(Callable),
1894    predicate_indicator(Callable, PI).
1895
1896%!  is_predicate_indicator(+PI) is semidet.
1897%
1898%   True if PI is a predicate indicator.
1899
1900is_predicate_indicator(Name/Arity) :-
1901    atom(Name),
1902    integer(Arity).
1903is_predicate_indicator(Module:Name/Arity) :-
1904    atom(Module),
1905    atom(Name),
1906    integer(Arity).
1907
1908%!  predicate_indicator(+Callable, -Name)
1909%
1910%   Generate a human-readable predicate indicator
1911
1912predicate_indicator(Module:Goal, PI) :-
1913    atom(Module),
1914    !,
1915    predicate_indicator(Goal, PI0),
1916    (   hidden_module(Module)
1917    ->  PI = PI0
1918    ;   PI = Module:PI0
1919    ).
1920predicate_indicator(Goal, Name/Arity) :-
1921    callable(Goal),
1922    !,
1923    functor(Goal, Name, Arity).
1924predicate_indicator(Goal, Goal).
1925
1926hidden_module(user) :- !.
1927hidden_module(system) :- !.
1928hidden_module(M) :-
1929    sub_atom(M, 0, _, _, $).
1930
1931%!  sort_callables(+List, -Sorted)
1932%
1933%   Sort list of callable terms.
1934
1935sort_callables(Callables, Sorted) :-
1936    key_callables(Callables, Tagged),
1937    keysort(Tagged, KeySorted),
1938    unkey(KeySorted, SortedList),
1939    ord_list_to_set(SortedList, Sorted).
1940
1941key_callables([], []).
1942key_callables([H0|T0], [Key-H0|T]) :-
1943    key_callable(H0, Key),
1944    key_callables(T0, T).
1945
1946key_callable(Callable, k(Name, Arity, Module)) :-
1947    predicate_indicator(Callable, PI),
1948    (   PI = Name/Arity
1949    ->  Module = user
1950    ;   PI = Module:Name/Arity
1951    ).
1952
1953unkey([], []).
1954unkey([_-H|T0], [H|T]) :-
1955    unkey(T0, T).
1956
1957%!  ord_list_to_set(+OrdList, -OrdSet)
1958%
1959%   Removed duplicates (after unification) from an ordered list,
1960%   creating a set.
1961
1962ord_list_to_set([], []).
1963ord_list_to_set([H|T0], [H|T]) :-
1964    ord_remove_same(H, T0, T1),
1965    ord_list_to_set(T1, T).
1966
1967ord_remove_same(H, [H|T0], T) :-
1968    !,
1969    ord_remove_same(H, T0, T).
1970ord_remove_same(_, L, L).
1971
1972
1973%!  callable_to_label(+Callable, +File, -Label:atom) is det.
1974%!  callable_to_label(+Callable, -Label:atom) is det.
1975%
1976%   Label is a textual label representing Callable in File.
1977
1978callable_to_label(Callable, Label) :-
1979    callable_to_label(Callable, @nil, Label).
1980
1981callable_to_label(pce_principal:send_implementation(Id,_,_), _, Id) :-
1982    atom(Id),
1983    !.
1984callable_to_label(pce_principal:get_implementation(Id,_,_,_), _, Id) :-
1985    atom(Id),
1986    !.
1987callable_to_label('<export>', _, '<export>') :- !.
1988callable_to_label('<directive>'(Line), _, Label) :-
1989    !,
1990    atom_concat('<directive>@', Line, Label).
1991callable_to_label(_:'<directive>'(Line), _, Label) :-
1992    !,
1993    atom_concat('<directive>@', Line, Label).
1994callable_to_label(Callable, File, Label) :-
1995    to_predicate_indicator(Callable, PI0),
1996    (   PI0 = M:PI1
1997    ->  (   atom(File),
1998            xref_module(File, M)
1999        ->  PI = PI1
2000        ;   PI = PI0
2001        )
2002    ;   PI = PI0
2003    ),
2004    term_to_atom(PI, Label).
2005
2006%!  edit_callable(+Callable, +File)
2007
2008edit_callable('<export>', File) :-
2009    !,
2010    edit(file(File)).
2011edit_callable(Callable, File) :-
2012    local_callable(Callable, File, Local),
2013    (   xref_defined(File, Local, How),
2014        xref_definition_line(How, Line)
2015    ->  edit(file(File, line(Line)))
2016    ;   autoload_predicate(Local)
2017    ->  functor(Local, Name, Arity),
2018        edit(Name/Arity)
2019    ).
2020edit_callable(pce_principal:send_implementation(Id,_,_), _) :-
2021    atom(Id),
2022    atomic_list_concat([Class,Method], ->, Id),
2023    !,
2024    edit(send(Class, Method)).
2025edit_callable(pce_principal:get_implementation(Id,_,_,_), _) :-
2026    atom(Id),
2027    atomic_list_concat([Class,Method], <-, Id),
2028    !,
2029    edit(get(Class, Method)).
2030edit_callable('<directive>'(Line), File) :-
2031    File \== @nil,
2032    !,
2033    edit(file(File, line(Line))).
2034edit_callable(_:'<directive>'(Line), File) :-
2035    File \== @nil,
2036    !,
2037    edit(file(File, line(Line))).
2038edit_callable(Callable, _) :-
2039    to_predicate_indicator(Callable, PI),
2040    edit(PI).
2041
2042local_callable(M:Callable, File, Callable) :-
2043    xref_module(File, M),
2044    !.
2045local_callable(Callable, _, Callable).
2046
2047
2048                 /*******************************
2049                 *            WARNINGS          *
2050                 *******************************/
2051
2052%!  file_warnings(+File:atom, -Warnings:list(atom))
2053%
2054%   Unify Warnings with a list  of   dubious  things  found in File.
2055%   Intended to create icons.  Fails if the file is totally ok.
2056
2057file_warnings(File, Warnings) :-
2058    setof(W, file_warning(File, W), Warnings).
2059
2060file_warning(File, undefined) :-
2061    undefined(File, _) -> true.
2062file_warning(File, not_called) :-
2063    setting(warn_not_called, true),
2064    not_called(File, _) -> true.
2065
2066
2067%!  not_called(+File, -Callable)
2068%
2069%   Callable is a term defined in File, and for which no callers can
2070%   be found.
2071
2072not_called(File, NotCalled) :-          % module version
2073    xref_module(File, Module),
2074    !,
2075    defined(File, NotCalled),
2076    \+ (   xref_called(File, NotCalled)
2077       ;   xref_exported(File, NotCalled)
2078       ;   xref_hook(NotCalled)
2079       ;   xref_hook(Module:NotCalled)
2080       ;   NotCalled = _:Goal,
2081           xref_hook(Goal)
2082       ;   xref_called(_, Module:NotCalled)
2083       ;   NotCalled = _:_,
2084           xref_called(_, NotCalled)
2085       ;   NotCalled = M:G,
2086           xref_called(ModFile, G),
2087           xref_module(ModFile, M)
2088       ;   generated_callable(Module:NotCalled)
2089       ).
2090not_called(File, NotCalled) :-          % non-module version
2091    defined(File, NotCalled),
2092    \+ (   xref_called(ImportFile, NotCalled),
2093           \+ xref_module(ImportFile, _)
2094       ;   NotCalled = _:_,
2095           xref_called(_, NotCalled)
2096       ;   NotCalled = M:G,
2097           xref_called(ModFile, G),
2098           xref_module(ModFile, M)
2099       ;   xref_called(AutoImportFile, NotCalled),
2100           \+ defined(AutoImportFile, NotCalled),
2101           global_predicate(NotCalled)
2102       ;   xref_hook(NotCalled)
2103       ;   xref_hook(user:NotCalled)
2104       ;   generated_callable(user:NotCalled)
2105       ).
2106
2107generated_callable(M:Term) :-
2108    functor(Term, Name, Arity),
2109    prolog:generated_predicate(M:Name/Arity).
2110
2111%!  xref_called(?Source, ?Callable) is nondet.
2112%
2113%   True if Callable is called in   Source, after removing recursive
2114%   calls and calls made to predicates where the condition says that
2115%   the predicate should not exist.
2116
2117xref_called(Source, Callable) :-
2118    xref_called_cond(Source, Callable, _).
2119
2120xref_called_cond(Source, Callable, Cond) :-
2121    xref_called(Source, Callable, By, Cond),
2122    By \= Callable.                 % recursive calls
2123
2124%!  defined(?File, ?Callable)
2125%
2126%   True if Callable is defined in File and not imported.
2127
2128defined(File, Callable) :-
2129    xref_defined(File, Callable, How),
2130    atom(File),
2131    How \= imported(_),
2132    How \= (multifile).
2133
2134%!  undefined(+File, -Callable)
2135%
2136%   Callable is called in File, but no   definition can be found. If
2137%   File is not a module file we   consider other files that are not
2138%   module files.
2139
2140undefined(File, Undef) :-
2141    xref_module(File, _),
2142    !,
2143    xref_called_cond(File, Undef, Cond),
2144    \+ (   available(File, Undef, How),
2145           How \== plain_file
2146       ),
2147    included_if_defined(Cond, Undef).
2148undefined(File, Undef) :-
2149    xref_called_cond(File, Undef, Cond),
2150    \+ available(File, Undef, _),
2151    included_if_defined(Cond, Undef).
2152
2153%!  included_if_defined(+Condition, +Callable) is semidet.
2154
2155included_if_defined(true, _)  :- !.
2156included_if_defined(false, _) :- !, fail.
2157included_if_defined(fail, _)  :- !, fail.
2158included_if_defined(current_predicate(Name/Arity), Callable) :-
2159    \+ functor(Callable, Name, Arity),
2160    !.
2161included_if_defined(\+ Cond, Callable) :-
2162    !,
2163    \+ included_if_defined(Cond, Callable).
2164included_if_defined((A,B), Callable) :-
2165    !,
2166    included_if_defined(A, Callable),
2167    included_if_defined(B, Callable).
2168included_if_defined((A;B), Callable) :-
2169    !,
2170    (   included_if_defined(A, Callable)
2171    ;   included_if_defined(B, Callable)
2172    ).
2173
2174
2175                 /*******************************
2176                 *    IMPORT/EXPORT HEADERS     *
2177                 *******************************/
2178
2179%!  file_imports(+File, -Imports)
2180%
2181%   Determine which modules must  be  imported   into  this  one. It
2182%   considers all called predicates that are   not covered by system
2183%   predicates. Next, we have three sources to resolve the remaining
2184%   predicates, which are tried in the   order below. The latter two
2185%   is dubious.
2186%
2187%           * Already existing imports
2188%           * Imports from other files in the project
2189%           * Imports from the (autoload) library
2190%
2191%   We first resolve all imports to   absolute  files. Localizing is
2192%   done afterwards.  Imports is a list of
2193%
2194%!          use_module(FileSpec, Callables)
2195
2196xref_file_imports(FileSpec, Imports) :-
2197    canonical_filename(FileSpec, File),
2198    findall(Called, called_no_builtin(File, Called), Resolve0),
2199    resolve_old_imports(Resolve0, File, Resolve1, Imports0),
2200    find_new_imports(Resolve1, File, Imports1),
2201    disambiguate_imports(Imports1, File, Imports2),
2202    flatten([Imports0, Imports2], ImportList),
2203    keysort(ImportList, SortedByFile),
2204    merge_by_key(SortedByFile, ImportsByFile),
2205    maplist(make_import(File), ImportsByFile, Imports).
2206
2207canonical_filename(FileSpec, File) :-
2208    absolute_file_name(FileSpec,
2209                       [ file_type(prolog),
2210                         access(read),
2211                         file_errors(fail)
2212                       ],
2213                       File).
2214
2215called_no_builtin(File, Callable) :-
2216    xref_called(File, Callable),
2217    \+ defined(File, Callable),
2218    \+ built_in_predicate(Callable).
2219
2220resolve_old_imports([], _, [], []).
2221resolve_old_imports([H|T0], File, UnRes, [From-H|T]) :-
2222    xref_defined(File, H, imported(From)),
2223    !,
2224    resolve_old_imports(T0, File, UnRes, T).
2225resolve_old_imports([H|T0], File, [H|UnRes], Imports) :-
2226    resolve_old_imports(T0, File, UnRes, Imports).
2227
2228find_new_imports([], _, []).
2229find_new_imports([H|T0], File, [FL-H|T]) :-
2230    findall(F, resolve(H, F), FL0),
2231    sort(FL0, FL),
2232    find_new_imports(T0, File, T).
2233
2234disambiguate_imports(Imports0, File, Imports) :-
2235    ambiguous_imports(Imports0, Ambig, UnAmbig, _Undef),
2236    (   Ambig == []
2237    ->  Imports = UnAmbig
2238    ;   new(D, xref_disambiguate_import_dialog(File, Ambig)),
2239        get(D, confirm_centered, Result),
2240        (   Result == ok
2241        ->  get(D, result, List),
2242            send(D, destroy),
2243            append(UnAmbig, List, Imports)
2244        )
2245    ).
2246
2247ambiguous_imports([], [], [], []).
2248ambiguous_imports([[]-C|T0], Ambig, UnAmbig, [C|T]) :-
2249    !,
2250    ambiguous_imports(T0, Ambig, UnAmbig, T).
2251ambiguous_imports([[F]-C|T0], Ambig, [F-C|T], Undef) :-
2252    !,
2253    ambiguous_imports(T0, Ambig, T, Undef).
2254ambiguous_imports([A-C|T0], [A-C|T], UnAmbig, Undef) :-
2255    is_list(A),
2256    !,
2257    ambiguous_imports(T0, T, UnAmbig, Undef).
2258
2259
2260%!  resolve(+Callable, -File)
2261%
2262%   Try to find files from which to resolve Callable.
2263
2264resolve(Callable, File) :-              % Export from module files
2265    xref_exported(File, Callable),
2266    atom(File).
2267resolve(Callable, File) :-              % Non-module files
2268    defined(File, Callable),
2269    atom(File),
2270    \+ xref_module(File, _).
2271resolve(Callable, File) :-              % The Prolog autoload library
2272    autoload_predicate(Callable, File).
2273
2274
2275%!  merge_by_key(+KeyedList, -ListOfKeyValues) is det.
2276%
2277%   Example: [a-x, a-y, b-z] --> [a-[x,y], b-[z]]
2278
2279merge_by_key([], []).
2280merge_by_key([K-V|T0], [K-[V|Vs]|T]) :-
2281    same_key(K, T0, Vs, T1),
2282    merge_by_key(T1, T).
2283
2284same_key(K, [K-V|T0], [V|VT], T) :-
2285    !,
2286    same_key(K, T0, VT, T).
2287same_key(_, L, [], L).
2288
2289
2290%!  make_import(+RefFile, +ImportList, -UseModules)
2291%
2292%   Glues it all together to make a list of directives.
2293
2294make_import(RefFile, File-Imports, (:-use_module(ShortPath, PIs))) :-
2295    local_filename(File, RefFile, ShortPath),
2296    sort_callables(Imports, SortedImports),
2297    maplist(predicate_indicator, SortedImports, PIs).
2298
2299local_filename(File, RefFile, ShortPath) :-
2300    atom(RefFile),
2301    file_directory_name(File, Dir),
2302    file_directory_name(RefFile, Dir),     % i.e. same dir
2303    !,
2304    file_base_name(File, Base),
2305    remove_extension(Base, ShortPath).
2306local_filename(File, _RefFile, ShortPath) :-
2307    file_name_on_path(File, ShortPath0),
2308    remove_extension(ShortPath0, ShortPath).
2309
2310
2311remove_extension(Term0, Term) :-
2312    Term0 =.. [Alias,ShortPath0],
2313    file_name_extension(ShortPath, pl, ShortPath0),
2314    !,
2315    Term  =.. [Alias,ShortPath].
2316remove_extension(ShortPath0, ShortPath) :-
2317    atom(ShortPath0),
2318    file_name_extension(ShortPath, pl, ShortPath0),
2319    !.
2320remove_extension(Path, Path).
2321
2322:- pce_begin_class(xref_disambiguate_import_dialog, auto_sized_dialog,
2323                   "Prompt for alternative sources").
2324
2325initialise(D, File:name, Ambig:prolog) :->
2326    send_super(D, initialise, string('Disambiguate calls for %s', File)),
2327    forall(member(Files-Callable, Ambig),
2328           send(D, append_row, File, Callable, Files)),
2329    send(D, append, button(ok)),
2330    send(D, append, button(cancel)).
2331
2332append_row(D, File:name, Callable:prolog, Files:prolog) :->
2333    send(D, append, xref_predicate_text(Callable, @default, File)),
2334    send(D, append, new(FM, menu(file, cycle)), right),
2335    send(FM, append, menu_item(@nil, @default, '-- Select --')),
2336    forall(member(Path, Files),
2337           (   file_name_on_path(Path, ShortId),
2338               short_file_name_to_atom(ShortId, Label),
2339               send(FM, append, menu_item(Path, @default, Label))
2340           )).
2341
2342result(D, Disam:prolog) :<-
2343    "Get disambiguated files"::
2344    get_chain(D, graphicals, Grs),
2345    selected_files(Grs, Disam).
2346
2347selected_files([], []).
2348selected_files([PreText,Menu|T0], [File-Callable|T]) :-
2349    send(PreText, instance_of, xref_predicate_text),
2350    send(Menu, instance_of, menu),
2351    get(Menu, selection, File),
2352    atom(File),
2353    !,
2354    get(PreText, callable, Callable),
2355    selected_files(T0, T).
2356selected_files([_|T0], T) :-
2357    selected_files(T0, T).
2358
2359
2360ok(D) :->
2361    send(D, return, ok).
2362
2363cancel(D) :->
2364    send(D, destroy).
2365
2366:- pce_end_class(xref_disambiguate_import_dialog).
2367
2368%!  xref_file_exports(+File, -Exports)
2369%
2370%   Produce the export-header for non-module files.  Fails if the
2371%   file is already a module file.
2372
2373xref_file_exports(FileSpec, (:- module(Module, Exports))) :-
2374    canonical_filename(FileSpec, File),
2375    \+ xref_module(File, _),
2376    findall(C, export_link_1(File, _, C), Cs),
2377    sort_callables(Cs, Sorted),
2378    file_base_name(File, Base),
2379    file_name_extension(Module, _, Base),
2380    maplist(predicate_indicator, Sorted, Exports).
2381