View source with raw comments or as raw
    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(debug)).   55:- use_module(library(autowin)).   56:- use_module(library(broadcast)).   57:- use_module(library(prolog_source)).   58
   59version('0.1.1').
   60
   61:- dynamic
   62    setting/2.   63
   64setting_menu([ warn_autoload,
   65               warn_not_called
   66             ]).
   67
   68setting(warn_autoload,      false).
   69setting(warn_not_called,    true).
   70setting(hide_system_files,  true).
   71setting(hide_profile_files, true).

Cross-referencer front-end

XPCE based font-end of the Prolog cross-referencer. Tasks:

See also
- library(prolog_xref) holds the actual data-collection. */
bug
- Tool produces an error if a file that has been xref'ed is deleted. Paulo Moura.
 gxref
Start graphical cross-referencer on loaded program. The GUI is started in the XPCE thread.
  105gxref :-
  106    in_pce_thread(xref_gui).
  107
  108xref_gui :-
  109    send(new(XREF, xref_frame), open),
  110    send(XREF, wait),
  111    send(XREF, update).
  112
  113
  114:- pce_begin_class(xref_frame, persistent_frame,
  115                   "GUI for the Prolog cross-referencer").
  116
  117initialise(F) :->
  118    send_super(F, initialise, 'Prolog XREF'),
  119    new(FilterDialog, xref_filter_dialog),
  120    send(new(BrowserTabs, tabbed_window), below, FilterDialog),
  121    send(BrowserTabs, left, new(WSTabs, tabbed_window)),
  122    send(BrowserTabs, name, browsers),
  123    send(BrowserTabs, hor_shrink, 10),
  124    send(BrowserTabs, hor_stretch, 10),
  125    send(WSTabs, name, workspaces),
  126    send_list([BrowserTabs, WSTabs], label_popup, F?tab_popup),
  127    send(new(TD, tool_dialog(F)), above, BrowserTabs),
  128    send(new(report_dialog), below, BrowserTabs),
  129    send(F, append, BrowserTabs),
  130    send_list(BrowserTabs,
  131              [ append(new(xref_file_tree), files),
  132                append(new(xref_predicate_browser), predicates)
  133              ]),
  134    send_list(WSTabs,
  135              [ append(new(xref_depgraph), dependencies)
  136              ]),
  137    send(F, fill_toolbar, TD).
  138
  139tab_popup(_F, P:popup) :<-
  140    "Popup for tab labels"::
  141    new(P, popup),
  142    send_list(P, append,
  143              [ menu_item(close, message(@arg1, destroy)),
  144                menu_item(detach, message(@arg1, untab))
  145              ]).
  146
  147fill_toolbar(F, TD:tool_dialog) :->
  148    send(TD, append, new(File, popup(file))),
  149    send(TD, append,
  150         new(Settings, popup(settings,
  151                             message(F, setting, @arg1, @arg2)))),
  152    send(TD, append, new(View, popup(view))),
  153    send(TD, append, new(Help, popup(help))),
  154    send_list(File, append,
  155              [ menu_item(exit, message(F, destroy))
  156              ]),
  157    send_list(View, append,
  158              [ menu_item(refresh, message(F, update))
  159              ]),
  160    send_list(Help, append,
  161              [ menu_item(about, message(F, about))
  162              ]),
  163    send(Settings, show_current, @on),
  164    send(Settings, multiple_selection, @on),
  165    send(F, update_setting_menu).
  166
  167about(_F) :->
  168    version(Version),
  169    send(@display, inform,
  170         string('SWI-Prolog cross-referencer version %s\n\c
  171                    By Jan Wielemaker', Version)).
  172
  173:- pce_group(parts).
  174
  175workspace(F, Which:name, Create:[bool], Expose:bool, WS:window) :<-
  176    "Find named workspace"::
  177    get(F, member, workspaces, Tabs),
  178    (   get(Tabs, member, Which, WS)
  179    ->  true
  180    ;   Create == @on
  181    ->  workspace_term(Which, New),
  182        new(WS, New),
  183        send(WS, name, Which),
  184        send(Tabs, append, WS)
  185    ),
  186    (   Expose == @on
  187    ->  send(Tabs, on_top, WS?name)
  188    ;   true
  189    ).
  190
  191workspace_term(file_info, prolog_file_info).
  192workspace_term(header,    xref_view).
  193
  194browser(F, Which:name, Browser:browser) :<-
  195    "Find named browser"::
  196    get(F, member, browsers, Tabs),
  197    get(Tabs, member, Which, Browser).
  198
  199update(F) :->
  200    "Update all windows"::
  201    send(F, xref_all),
  202    get(F, member, browsers, Tabs),
  203    send(Tabs?members, for_some,
  204         message(@arg1, update)),
  205    get(F, member, workspaces, WSs),
  206    send(WSs?members, for_some,
  207         message(@arg1, update)).
  208
  209xref_all(F) :->
  210    "Run X-referencer on all files"::
  211    forall(( source_file(File),
  212             exists_file(File)
  213           ),
  214           send(F, xref_file, File)).
  215
  216xref_file(F, File:name) :->
  217    "XREF a single file if not already done"::
  218    (   xref_done(File, Time),
  219        catch(time_file(File, Modified), _, fail),
  220        Modified == Time
  221    ->  true
  222    ;   send(F, report, progress, 'XREF %s', File),
  223        xref_source(File, [silent(true)]),
  224        send(F, report, done)
  225    ).
  226
  227:- pce_group(actions).
  228
  229
  230file_info(F, File:name) :->
  231    "Show summary info on File"::
  232    get(F, workspace, file_info, @on, @on, Window),
  233    send(Window, file, File),
  234    broadcast(xref_refresh_file(File)).
  235
  236file_header(F, File:name) :->
  237    "Create import/export header"::
  238    get(F, workspace, header, @on, @on, View),
  239    send(View, file_header, File).
  240
  241:- pce_group(settings).
  242
  243update_setting_menu(F) :->
  244    "Update the menu for the settings with the current values"::
  245    get(F, member, tool_dialog, TD),
  246    get(TD, member, menu_bar, MB),
  247    get(MB, member, settings, Popup),
  248    send(Popup, clear),
  249    setting_menu(Entries),
  250    (   member(Name, Entries),
  251        setting(Name, Value),
  252        send(Popup, append, new(MI, menu_item(Name))),
  253        (   Value == true
  254        ->  send(MI, selected, @on)
  255        ;   true
  256        ),
  257        fail ; true
  258    ).
  259
  260setting(F, S:name, PceVal:bool) :->
  261    "Update setting and redo analysis"::
  262    pce_to_prolog_bool(PceVal, Val),
  263    retractall(setting(S, _)),
  264    assert(setting(S, Val)),
  265    send(F, update).
  266
  267pce_to_prolog_bool(@on, true).
  268pce_to_prolog_bool(@off, false).
  269
  270:- pce_end_class(xref_frame).
  271
  272
  273                 /*******************************
  274                 *            WORKSPACE         *
  275                 *******************************/
  276
  277:- pce_begin_class(xref_depgraph, picture,
  278                   "Workspace showing dependecies").
  279:- use_class_template(arm).
  280:- use_class_template(print_graphics).
  281
  282initialise(W) :->
  283    send_super(W, initialise),
  284    send(W, popup, new(P, popup)),
  285    send_list(P, append,
  286              [ menu_item(layout, message(W, layout)),
  287                gap,
  288                menu_item(view_whole_project, message(W, show_project)),
  289                gap,
  290                menu_item(clear, message(W, clear, destroy)),
  291                gap,
  292                menu_item(print, message(W, print))
  293              ]).
  294
  295update(P) :->
  296    "Initial screen"::
  297    send(P, display,
  298         new(T, text('Drag files or directories to dependency view\n\c
  299                          or use background menu to show the whole project')),
  300         point(10,10)),
  301    send(T, name, intro_text),
  302    send(T, colour, grey50).
  303
  304remove_intro_text(P) :->
  305    "Remove the introductionary text"::
  306    (   get(P, member, intro_text, Text)
  307    ->  send(Text, destroy)
  308    ;   true
  309    ).
  310
  311show_project(P) :->
  312    get(P, sources, Sources),
  313    send(P, clear, destroy),
  314    forall(member(Src, Sources),
  315           send(P, append, Src)),
  316    send(P, update_links),
  317    send(P, layout).
  318
  319sources(_, Sources:prolog) :<-
  320    findall(S, dep_source(S), Sources).
 dep_source(?Src)
Generate all sources for the dependecy graph one-by-one.
  326dep_source(Src) :-
  327    source_file(Src),
  328    (   setting(hide_system_files, true)
  329    ->  \+ library_file(Src)
  330    ;   true
  331    ),
  332    (   setting(hide_profile_files, true)
  333    ->  \+ profile_file(Src)
  334    ;   true
  335    ).
  336
  337append(P, File:name, Create:[bool|{always}]) :->
  338    "Append File.  If Create == always also if a system file"::
  339    default(Create, @on, C),
  340    get(P, node, File, C, _).
  341
  342node(G, File:name, Create:[bool|{always}], Pos:[point],
  343     Gr:xref_file_graph_node) :<-
  344    "Get the node representing File"::
  345    (   get(G, member, File, Gr)
  346    ->  true
  347    ;   (   Create == @on
  348        ->  dep_source(File)
  349        ;   Create == always
  350        ),
  351        (   Pos == @default
  352        ->  get(G?visible, center, At)
  353        ;   At = Pos
  354        ),
  355        send(G, display, new(Gr, xref_file_graph_node(File)), At),
  356        send(G, remove_intro_text)
  357    ).
  358
  359update_links(G) :->
  360    "Add all export links"::
  361    send(G?graphicals, for_all,
  362         if(message(@arg1, instance_of, xref_file_graph_node),
  363            message(@arg1, create_export_links))).
  364
  365layout(G, MoveOnly:[chain]) :->
  366    "Do graph layout"::
  367    get(G?graphicals, find_all,
  368        message(@arg1, instance_of, xref_file_graph_node), Nodes),
  369    get(Nodes, find_all, not(@arg1?connections), UnConnected),
  370    send(Nodes, subtract, UnConnected),
  371    new(Pos, point(10,10)),
  372    send(UnConnected, for_all,
  373         and(message(@arg1, position, Pos),
  374             message(Pos, offset, 0, 25))),
  375    get(Nodes, head, First),
  376    send(First, layout,
  377         nominal := 100,
  378         iterations := 1000,
  379         network := Nodes,
  380         move_only := MoveOnly).
  381
  382
  383:- pce_group(dragdrop).
  384
  385drop(G, Obj:object, Pos:point) :->
  386    "Drop a file on the graph"::
  387    (   send(Obj, instance_of, xref_file_text)
  388    ->  get(Obj, path, File),
  389        (   get(G, node, File, Node)
  390        ->  send(Node, flash)
  391        ;   get(G, node, File, always, Pos, _Node),
  392            send(G, update_links)
  393        )
  394    ;   send(Obj, instance_of, xref_directory_text)
  395    ->  get(Obj, files, Files),
  396        layout_new(G,
  397                   (   send(Files, for_all,
  398                            message(G, append, @arg1, always)),
  399                       send(G, update_links)
  400                   ))
  401    ).
  402
  403preview_drop(G, Obj:object*, Pos:point) :->
  404    "Show preview of drop"::
  405    (   Obj == @nil
  406    ->  send(G, report, status, '')
  407    ;   send(Obj, instance_of, xref_file_text)
  408    ->  (   get(Obj, device, G)
  409        ->  send(Obj, move, Pos)
  410        ;   get(Obj, path, File),
  411            get(Obj, string, Label),
  412            (   get(G, node, File, _Node)
  413            ->  send(G, report, status, '%s: already in graph', Label)
  414            ;   send(G, report, status, 'Add %s to graph', Label)
  415            )
  416        )
  417    ;   send(Obj, instance_of, xref_directory_text)
  418    ->  get(Obj, path, Path),
  419        send(G, report, status, 'Add files from directory %s', Path)
  420    ).
  421
  422:- pce_end_class(xref_depgraph).
  423
  424:- pce_begin_class(xref_file_graph_node, xref_file_text).
  425
  426:- send(@class, handle, handle(w/2, 0, link, north)).  427:- send(@class, handle, handle(w, h/2, link, west)).  428:- send(@class, handle, handle(w/2, h, link, south)).  429:- send(@class, handle, handle(0, h/2, link, east)).  430
  431initialise(N, File:name) :->
  432    send_super(N, initialise, File),
  433    send(N, font, bold),
  434    send(N, background, grey80).
  435
  436create_export_links(N, Add:[bool]) :->
  437    "Create the export links to other files"::
  438    get(N, path, Exporter),
  439    forall(export_link(Exporter, Importer, Callables),
  440           create_export_link(N, Add, Importer, Callables)).
  441
  442create_export_link(From, Add, Importer, Callables) :-
  443    (   get(From?device, node, Importer, Add, INode)
  444    ->  send(From, link, INode, Callables)
  445    ;   true
  446    ).
  447
  448create_import_links(N, Add:[bool]) :->
  449    "Create the import links from other files"::
  450    get(N, path, Importer),
  451    forall(export_link(Exporter, Importer, Callables),
  452           create_import_link(N, Add, Exporter, Callables)).
  453
  454create_import_link(From, Add, Importer, Callables) :-
  455    (   get(From?device, node, Importer, Add, INode)
  456    ->  send(INode, link, From, Callables)
  457    ;   true
  458    ).
  459
  460link(N, INode:xref_file_graph_node, Callables:prolog) :->
  461    "Create export link to INode"::
  462    (   get(N, connections, INode, CList),
  463        get(CList, find, @arg1?from == N, C)
  464    ->  send(C, callables, Callables)
  465    ;   new(L, xref_export_connection(N, INode, Callables)),
  466        send(L, hide)
  467    ).
  468
  469:- pce_global(@xref_file_graph_node_recogniser,
  470              make_xref_file_graph_node_recogniser).  471
  472make_xref_file_graph_node_recogniser(G) :-
  473    new(G, move_gesture(left, '')).
  474
  475event(N, Ev:event) :->
  476    "Add moving (overrule supreclass"::
  477    (   send(@xref_file_graph_node_recogniser, event, Ev)
  478    ->  true
  479    ;   send_super(N, event, Ev)
  480    ).
  481
  482popup(N, Popup:popup) :<-
  483    get_super(N, popup, Popup),
  484    send_list(Popup, append,
  485              [ gap,
  486                menu_item(show_exports,
  487                          message(@arg1, show_import_exports, export)),
  488                menu_item(show_imports,
  489                          message(@arg1, show_import_exports, import)),
  490                gap,
  491                menu_item(hide,
  492                          message(@arg1, destroy))
  493              ]).
  494
  495show_import_exports(N, Which:{import,export}) :->
  496    "Show who I'm exporting to"::
  497    get(N, device, G),
  498    layout_new(G,
  499               (   (   Which == export
  500                   ->  send(N, create_export_links, @on)
  501                   ;   send(N, create_import_links, @on)
  502                   ),
  503                   send(G, update_links)
  504               )).
  505
  506layout_new(G, Goal) :-
  507    get(G?graphicals, find_all,
  508        message(@arg1, instance_of, xref_file_graph_node), Nodes0),
  509    Goal,
  510    get(G?graphicals, find_all,
  511        message(@arg1, instance_of, xref_file_graph_node), Nodes),
  512    send(Nodes, subtract, Nodes0),
  513    (   send(Nodes, empty)
  514    ->  send(G, report, status, 'No nodes added')
  515    ;   send(G, layout, Nodes),
  516        get(Nodes, size, Size),
  517        send(G, report, status, '%d nodes added', Size)
  518    ).
  519
  520:- pce_end_class(xref_file_graph_node).
  521
  522:- pce_begin_class(xref_export_connection, tagged_connection).
  523
  524variable(callables, prolog, get, "Callables in Import/export link").
  525
  526initialise(C, From:xref_file_graph_node, To:xref_file_graph_node,
  527           Callables:prolog) :->
  528    send_super(C, initialise, From, To),
  529    send(C, arrows, second),
  530    send(C, slot, callables, Callables),
  531    length(Callables, N),
  532    send(C, tag, xref_export_connection_tag(C, N)).
  533
  534callables(C, Callables:prolog) :->
  535    send(C, slot, callables, Callables). % TBD: update tag?
  536
  537called_by_popup(Conn, P:popup) :<-
  538    "Create popup to show relating predicates"::
  539    new(P, popup(called_by, message(Conn, edit_callable, @arg1))),
  540    get(Conn, callables, Callables),
  541    get(Conn?from, path, ExportFile),
  542    get(Conn?to, path, ImportFile),
  543    sort_callables(Callables, Sorted),
  544    forall(member(C, Sorted),
  545           append_io_callable(P, ImportFile, ExportFile, C)).
 append_io_callable(+Popup, -ImportFile, +Callable)
  549append_io_callable(P, ImportFile, ExportFile, Callable) :-
  550    callable_to_label(Callable, Label),
  551    send(P, append, new(MI, menu_item(@nil, @default, Label))),
  552    send(MI, popup, new(P2, popup)),
  553    send(P2, append,
  554         menu_item(prolog('<definition>'(Callable)),
  555                   @default, definition?label_name)),
  556    send(P2, append, gap),
  557    qualify_from_file(Callable, ExportFile, QCall),
  558    findall(By, used_in(ImportFile, QCall, By), ByList0),
  559    sort_callables(ByList0, ByList),
  560    forall(member(C, ByList),
  561           ( callable_to_label(C, CLabel),
  562             send(P2, append, menu_item(prolog(C), @default, CLabel)))).
  563
  564edit_callable(C, Callable:prolog) :->
  565    "Edit definition or callers"::
  566    (   Callable = '<definition>'(Def)
  567    ->  get(C?from, path, ExportFile),
  568        edit_callable(Def, ExportFile)
  569    ;   get(C?to, path, ImportFile),
  570        edit_callable(Callable, ImportFile)
  571    ).
  572
  573:- pce_end_class(xref_export_connection).
  574
  575
  576:- pce_begin_class(xref_export_connection_tag, text,
  577                   "Text showing import/export count").
  578
  579variable(connection, xref_export_connection, get, "Related connection").
  580
  581initialise(Tag, C:xref_export_connection, N:int) :->
  582    send(Tag, slot, connection, C),
  583    send_super(Tag, initialise, string('(%d)', N)),
  584    send(Tag, colour, blue),
  585    send(Tag, underline, @on).
  586
  587:- pce_global(@xref_export_connection_tag_recogniser,
  588              new(popup_gesture(@receiver?connection?called_by_popup, left))).
  589
  590event(Tag, Ev:event) :->
  591    (   send_super(Tag, event, Ev)
  592    ->  true
  593    ;   send(@xref_export_connection_tag_recogniser, event, Ev)
  594    ).
  595
  596:- pce_end_class(xref_export_connection_tag).
 export_link(+ExportingFile, -ImportingFile, -Callables) is det
export_link(-ExportingFile, +ImportingFile, -Callables) is det
Callables are exported from ExportingFile to ImportingFile.
  605export_link(ExportFile, ImportingFile, Callables) :-
  606    setof(Callable,
  607          export_link_1(ExportFile, ImportingFile, Callable),
  608          Callables0),
  609    sort_callables(Callables0, Callables).
  610
  611
  612export_link_1(ExportFile, ImportFile, Callable) :-       % module export
  613    nonvar(ExportFile),
  614    xref_module(ExportFile, Module),
  615    !,
  616    (   xref_exported(ExportFile, Callable),
  617        xref_defined(ImportFile, Callable, imported(ExportFile)),
  618        xref_called(ImportFile, Callable)
  619    ;   defined(ExportFile, Callable),
  620        single_qualify(Module:Callable, QCall),
  621        xref_called(ImportFile, QCall)
  622    ),
  623    ImportFile \== ExportFile,
  624    atom(ImportFile).
  625export_link_1(ExportFile, ImportFile, Callable) :-      % Non-module export
  626    nonvar(ExportFile),
  627    !,
  628    defined(ExportFile, Callable),
  629    xref_called(ImportFile, Callable),
  630    atom(ImportFile),
  631    ExportFile \== ImportFile.
  632export_link_1(ExportFile, ImportFile, Callable) :-      % module import
  633    nonvar(ImportFile),
  634    xref_module(ImportFile, Module),
  635    !,
  636    xref_called(ImportFile, Callable),
  637    (   xref_defined(ImportFile, Callable, imported(ExportFile))
  638    ;   single_qualify(Module:Callable, QCall),
  639        QCall = M:G,
  640        (   defined(ExportFile, G),
  641            xref_module(ExportFile, M)
  642        ;   defined(ExportFile, QCall)
  643        )
  644    ),
  645    ImportFile \== ExportFile,
  646    atom(ExportFile).
  647export_link_1(ExportFile, ImportFile, Callable) :-      % Non-module import
  648    xref_called(ImportFile, Callable),
  649    \+ (  xref_defined(ImportFile, Callable, How),
  650          How \= imported(_)
  651       ),
  652                                    % see also undefined/2
  653    (   xref_defined(ImportFile, Callable, imported(ExportFile))
  654    ;   defined(ExportFile, Callable),
  655        \+ xref_module(ExportFile, _)
  656    ;   Callable = _:_,
  657        defined(ExportFile, Callable)
  658    ;   Callable = M:G,
  659        defined(ExportFile, G),
  660        xref_module(ExportFile, M)
  661    ).
  662
  663
  664                 /*******************************
  665                 *             FILTER           *
  666                 *******************************/
  667
  668:- pce_begin_class(xref_filter_dialog, dialog,
  669                   "Show filter options").
  670
  671class_variable(border, size, size(0,0)).
  672
  673initialise(D) :->
  674    send_super(D, initialise),
  675    send(D, hor_stretch, 100),
  676    send(D, hor_shrink, 100),
  677    send(D, name, filter_dialog),
  678    send(D, append, xref_file_filter_item(filter_on_filename)).
  679
  680resize(D) :->
  681    send(D, layout, D?visible?size).
  682
  683:- pce_end_class(xref_filter_dialog).
  684
  685
  686:- pce_begin_class(xref_file_filter_item, text_item,
  687                   "Filter files as you type").
  688
  689typed(FFI, Id) :->
  690    "Activate filter"::
  691    send_super(FFI, typed, Id),
  692    get(FFI, displayed_value, Current),
  693    get(FFI?frame, browser, files, Tree),
  694    (   send(Current, equal, '')
  695    ->  send(Tree, filter_file_name, @nil)
  696    ;   (   text_to_regex(Current, Filter)
  697        ->  send(Tree, filter_file_name, Filter)
  698        ;   send(FFI, report, status, 'Incomplete expression')
  699        )
  700    ).
 text_to_regex(+Pattern, -Regex) is semidet
Convert text to a regular expression. Fail if the text does not represent a valid regular expression.
  707text_to_regex(Pattern, Regex) :-
  708    send(@pce, last_error, @nil),
  709    new(Regex, regex(Pattern)),
  710    ignore(pce_catch_error(_, send(Regex, search, ''))),
  711    get(@pce, last_error, @nil).
  712
  713:- pce_end_class(xref_file_filter_item).
  714
  715
  716
  717                 /*******************************
  718                 *           FILE TREE          *
  719                 *******************************/
  720
  721:- pce_begin_class(xref_file_tree, toc_window,
  722                   "Show loaded files as a tree").
  723:- use_class_template(arm).
  724
  725initialise(Tree) :->
  726    send_super(Tree, initialise),
  727    send(Tree, clear),
  728    listen(Tree, xref_refresh_file(File),
  729           send(Tree, refresh_file, File)).
  730
  731unlink(Tree) :->
  732    unlisten(Tree),
  733    send_super(Tree, unlink).
  734
  735refresh_file(Tree, File:name) :->
  736    "Update given file"::
  737    (   get(Tree, node, File, Node)
  738    ->  send(Node, set_flags)
  739    ;   true
  740    ).
  741
  742collapse_node(_, _:any) :->
  743    true.
  744
  745expand_node(_, _:any) :->
  746    true.
  747
  748update(FL) :->
  749    get(FL, expanded_ids, Chain),
  750    send(FL, clear),
  751    send(FL, report, progress, 'Building source tree ...'),
  752    send(FL, append_all_sourcefiles),
  753    send(FL, expand_ids, Chain),
  754    send(@display, synchronise),
  755    send(FL, report, progress, 'Flagging files ...'),
  756    send(FL, set_flags),
  757    send(FL, report, done).
  758
  759append_all_sourcefiles(FL) :->
  760    "Append all files loaded into Prolog"::
  761    forall(source_file(File),
  762           send(FL, append, File)),
  763    send(FL, sort).
  764
  765clear(Tree) :->
  766    "Remove all nodes, recreate the toplevel"::
  767    send_super(Tree, clear),
  768    send(Tree, root, new(Root, toc_folder(project, project))),
  769    forall(top_node(Name, Class),
  770           (   New =.. [Class, Name, Name],
  771               send(Tree, son, project, New))),
  772    send(Root, for_all, message(@arg1, collapsed, @off)).
  773
  774append(Tree, File:name) :->
  775    "Add Prolog source file"::
  776    send(Tree, append_node, new(prolog_file_node(File))).
  777
  778append_node(Tree, Node:toc_node) :->
  779    "Append a given node to the tree"::
  780    get(Node, parent_id, ParentId),
  781    (   get(Tree, node, ParentId, Parent)
  782    ->  true
  783    ;   send(Tree, append_node,
  784             new(Parent, prolog_directory_node(ParentId)))
  785    ),
  786    send(Parent, son, Node).
  787
  788sort(Tree) :->
  789    forall(top_node(Name, _),
  790           (   get(Tree, node, Name, Node),
  791               send(Node, sort_sons, ?(@arg1, compare, @arg2)),
  792               send(Node?sons, for_all, message(@arg1, sort))
  793           )).
  794
  795select_node(Tree, File:name) :->
  796    "User selected a node"::
  797    (   exists_file(File)
  798    ->  send(Tree?frame, file_info, File)
  799    ;   true
  800    ).
  801
  802set_flags(Tree) :->
  803    "Set alert-flags on all nodes"::
  804    forall(top_node(Name, _),
  805           (   get(Tree, node, Name, Node),
  806               (   send(Node, instance_of, prolog_directory_node)
  807               ->  send(Node, set_flags)
  808               ;   send(Node?sons, for_all, message(@arg1, set_flags))
  809               )
  810           )).
  811
  812top_node('.',           prolog_directory_node).
  813top_node('alias',       toc_folder).
  814top_node('/',           prolog_directory_node).
  815
  816
  817:- pce_group(filter).
  818
  819filter_file_name(Tree, Regex:regex*) :->
  820    "Only show files that match Regex"::
  821    (   Regex == @nil
  822    ->  send(Tree, filter_files, @nil)
  823    ;   send(Tree, filter_files,
  824             message(Regex, search, @arg1?base_name))
  825    ).
  826
  827filter_files(Tree, Filter:code*) :->
  828    "Highlight files that match Filter"::
  829    send(Tree, collapse_all),
  830    send(Tree, selection, @nil),
  831    (   Filter == @nil
  832    ->  send(Tree, expand_id, '.'),
  833        send(Tree, expand_id, project)
  834    ;   new(Count, number(0)),
  835        get(Tree?tree, root, Root),
  836        send(Root, for_all,
  837             if(and(message(@arg1, instance_of, prolog_file_node),
  838                    message(Filter, forward, @arg1)),
  839                and(message(Tree, show_node_path, @arg1),
  840                    message(Count, plus, 1)))),
  841        send(Tree, report, status, 'Filter on file name: %d hits', Count)
  842    ),
  843    send(Tree, scroll_to, point(0,0)).
  844
  845show_node_path(Tree, Node:node) :->
  846    "Select Node and make sure all parents are expanded"::
  847    send(Node, selected, @on),
  848    send(Tree, expand_parents, Node).
  849
  850expand_parents(Tree, Node:node) :->
  851    (   get(Node, collapsed, @nil)
  852    ->  true
  853    ;   send(Node, collapsed, @off)
  854    ),
  855    send(Node?parents, for_all, message(Tree, expand_parents, @arg1)).
  856
  857collapse_all(Tree) :->
  858    "Collapse all nodes"::
  859    get(Tree?tree, root, Root),
  860    send(Root, for_all,
  861         if(@arg1?collapsed == @off,
  862            message(@arg1, collapsed, @on))).
  863
  864:- pce_end_class(xref_file_tree).
  865
  866
  867:- pce_begin_class(prolog_directory_node, toc_folder,
  868                   "Represent a directory").
  869
  870variable(flags, name*, get, "Warning status").
  871
  872initialise(DN, Dir:name, Label:[name]) :->
  873    "Create a directory node"::
  874    (   Label \== @default
  875    ->  Name = Label
  876    ;   file_alias_path(Name, Dir)
  877    ->  true
  878    ;   file_base_name(Dir, Name)
  879    ),
  880    send_super(DN, initialise, xref_directory_text(Dir, Name), Dir).
  881
  882parent_id(FN, ParentId:name) :<-
  883    "Get id for the parent"::
  884    get(FN, identifier, Path),
  885    (   file_alias_path(_, Path)
  886    ->  ParentId = alias
  887    ;   file_directory_name(Path, ParentId)
  888    ).
  889
  890sort(DN) :->
  891    "Sort my sons"::
  892    send(DN, sort_sons, ?(@arg1, compare, @arg2)),
  893    send(DN?sons, for_all, message(@arg1, sort)).
  894
  895compare(DN, Node:toc_node, Diff:{smaller,equal,larger}) :<-
  896    "Compare for sorting children"::
  897    (   send(Node, instance_of, prolog_file_node)
  898    ->  Diff = smaller
  899    ;   get(DN, label, L1),
  900        get(Node, label, L2),
  901        get(L1, compare, L2, Diff)
  902    ).
  903
  904set_flags(DN) :->
  905    "Set alert images"::
  906    send(DN?sons, for_all, message(@arg1, set_flags)),
  907    (   get(DN?sons, find, @arg1?flags \== ok, _Node)
  908    ->  send(DN, collapsed_image, @xref_alert_closedir),
  909        send(DN, expanded_image, @xref_alert_opendir),
  910        send(DN, slot, flags, alert)
  911    ;   send(DN, collapsed_image, @xref_ok_closedir),
  912        send(DN, expanded_image, @xref_ok_opendir),
  913        send(DN, slot, flags, ok)
  914    ),
  915    send(@display, synchronise).
  916
  917:- pce_end_class(prolog_directory_node).
  918
  919
  920:- pce_begin_class(prolog_file_node, toc_file,
  921                   "Represent a file").
  922
  923variable(flags,         name*, get, "Warning status").
  924variable(base_name,     name,  get, "Base-name of file").
  925
  926initialise(FN, File:name) :->
  927    "Create from a file"::
  928    absolute_file_name(File, Path),
  929    send_super(FN, initialise, new(T, xref_file_text(Path)), Path),
  930    file_base_name(File, Base),
  931    send(FN, slot, base_name, Base),
  932    send(T, default_action, info).
  933
  934basename(FN, BaseName:name) :<-
  935    "Get basename of the file for sorting"::
  936    get(FN, identifier, File),
  937    file_base_name(File, BaseName).
  938
  939parent_id(FN, ParentId:name) :<-
  940    "Get id for the parent"::
  941    get(FN, identifier, Path),
  942    file_directory_name(Path, Dir),
  943    (   file_alias_path('.', Dir)
  944    ->  ParentId = '.'
  945    ;   ParentId = Dir
  946    ).
  947
  948sort(_) :->
  949    true.
  950
  951compare(FN, Node:toc_node, Diff:{smaller,equal,larger}) :<-
  952    "Compare for sorting children"::
  953    (   send(Node, instance_of, prolog_directory_node)
  954    ->  Diff = larger
  955    ;   get(FN, basename, L1),
  956        get(Node, basename, L2),
  957        get(L1, compare, L2, Diff)
  958    ).
  959
  960set_flags(FN) :->
  961    "Set alert images"::
  962    get(FN, identifier, File),
  963    (   file_warnings(File, _)
  964    ->  send(FN, image, @xref_alert_file),
  965        send(FN, slot, flags, alert)
  966    ;   send(FN, image, @xref_ok_file),
  967        send(FN, slot, flags, ok)
  968    ),
  969    send(@display, synchronise).
  970
  971:- pce_global(@xref_ok_file,
  972              make_xref_image([ image('16x16/doc.xpm'),
  973                                image('16x16/ok.xpm')
  974                              ])).  975:- pce_global(@xref_alert_file,
  976              make_xref_image([ image('16x16/doc.xpm'),
  977                                image('16x16/alert.xpm')
  978                              ])).  979
  980:- pce_global(@xref_ok_opendir,
  981              make_xref_image([ image('16x16/opendir.xpm'),
  982                                image('16x16/ok.xpm')
  983                              ])).  984:- pce_global(@xref_alert_opendir,
  985              make_xref_image([ image('16x16/opendir.xpm'),
  986                                image('16x16/alert.xpm')
  987                              ])).  988
  989:- pce_global(@xref_ok_closedir,
  990              make_xref_image([ image('16x16/closedir.xpm'),
  991                                image('16x16/ok.xpm')
  992                              ])).  993:- pce_global(@xref_alert_closedir,
  994              make_xref_image([ image('16x16/closedir.xpm'),
  995                                image('16x16/alert.xpm')
  996                              ])).  997
  998make_xref_image([First|More], Image) :-
  999    new(Image, image(@nil, 0, 0, pixmap)),
 1000    send(Image, copy, First),
 1001    forall(member(I2, More),
 1002           send(Image, draw_in, bitmap(I2))).
 1003
 1004:- pce_end_class(prolog_file_node).
 1005
 1006
 1007
 1008
 1009                 /*******************************
 1010                 *           FILE INFO          *
 1011                 *******************************/
 1012
 1013
 1014:- pce_begin_class(prolog_file_info, window,
 1015                   "Show information on File").
 1016:- use_class_template(arm).
 1017
 1018variable(tabular,     tabular, get, "Displayed table").
 1019variable(prolog_file, name*,   get, "Displayed Prolog file").
 1020
 1021initialise(W, File:[name]*) :->
 1022    send_super(W, initialise),
 1023    send(W, pen, 0),
 1024    send(W, scrollbars, vertical),
 1025    send(W, display, new(T, tabular)),
 1026    send(T, rules, all),
 1027    send(T, cell_spacing, -1),
 1028    send(W, slot, tabular, T),
 1029    (   atom(File)
 1030    ->  send(W, prolog_file, File)
 1031    ;   true
 1032    ).
 1033
 1034resize(W) :->
 1035    send_super(W, resize),
 1036    get(W?visible, width, Width),
 1037    send(W?tabular, table_width, Width-3).
 1038
 1039
 1040file(V, File0:name*) :->
 1041    "Set vizualized file"::
 1042    (   File0 == @nil
 1043    ->  File = File0
 1044    ;   absolute_file_name(File0, File)
 1045    ),
 1046    (   get(V, prolog_file, File)
 1047    ->  true
 1048    ;   send(V, slot, prolog_file, File),
 1049        send(V, update)
 1050    ).
 1051
 1052
 1053clear(W) :->
 1054    send(W?tabular, clear).
 1055
 1056
 1057update(V) :->
 1058    "Show information on the current file"::
 1059    send(V, clear),
 1060    send(V, scroll_to, point(0,0)),
 1061    (   get(V, prolog_file, File),
 1062        File \== @nil
 1063    ->  send(V?frame, xref_file, File), % Make sure data is up-to-date
 1064        send(V, show_info)
 1065    ;   true
 1066    ).
 1067
 1068
 1069module(W, Module:name) :<-
 1070    "Module associated with this file"::
 1071    get(W, prolog_file, File),
 1072    (   xref_module(File, Module)
 1073    ->  true
 1074    ;   Module = user               % TBD: does not need to be true!
 1075    ).
 1076
 1077:- pce_group(info).
 1078
 1079show_info(W) :->
 1080    get(W, tabular, T),
 1081    BG = (background := khaki1),
 1082    get(W, prolog_file, File),
 1083    new(FG, xref_file_text(File)),
 1084    send(FG, font, huge),
 1085    send(T, append, FG, halign := center, colspan := 2, BG),
 1086    send(T, next_row),
 1087    send(W, show_module),
 1088    send(W, show_modified),
 1089    send(W, show_undefined),
 1090    send(W, show_not_called),
 1091    send(W, show_exports),
 1092    send(W, show_imports),
 1093    true.
 1094
 1095show_module(W) :->
 1096    "Show basic module info"::
 1097    get(W, prolog_file, File),
 1098    get(W, tabular, T),
 1099    (   xref_module(File, Module)
 1100    ->  send(T, append, 'Module:', bold, right),
 1101        send(T, append, Module),
 1102        send(T, next_row)
 1103    ;   true
 1104    ).
 1105
 1106show_modified(W) :->
 1107    get(W, prolog_file, File),
 1108    get(W, tabular, T),
 1109    time_file(File, Stamp),
 1110    format_time(string(Modified), '%+', Stamp),
 1111    send(T, append, 'Modified:', bold, right),
 1112    send(T, append, Modified),
 1113    send(T, next_row).
 1114
 1115show_exports(W) :->
 1116    get(W, prolog_file, File),
 1117    (   xref_module(File, Module),
 1118        findall(E, xref_exported(File, E), Exports),
 1119        Exports \== []
 1120    ->  send(W, show_export_header, export, imported_by),
 1121        sort_callables(Exports, Sorted),
 1122        forall(member(Callable, Sorted),
 1123               send(W, show_module_export, File, Module, Callable))
 1124    ;   true
 1125    ),
 1126    (   findall(C-Fs,
 1127                ( setof(F, export_link_1(File, F, C), Fs),
 1128                  \+ xref_exported(File, C)),
 1129                Pairs0),
 1130        Pairs0 \== []
 1131    ->  send(W, show_export_header, defined, used_by),
 1132        keysort(Pairs0, Pairs),     % TBD
 1133        forall(member(Callable-ImportFiles, Pairs),
 1134               send(W, show_file_export, Callable, ImportFiles))
 1135    ;   true
 1136    ).
 1137
 1138show_export_header(W, Left:name, Right:name) :->
 1139    get(W, tabular, T),
 1140    BG = (background := khaki1),
 1141    send(T, append, Left?label_name, bold, center, BG),
 1142    send(T, append, Right?label_name, bold, center, BG),
 1143    send(T, next_row).
 1144
 1145show_module_export(W, File:name, Module:name, Callable:prolog) :->
 1146    get(W, prolog_file, File),
 1147    get(W, tabular, T),
 1148    send(T, append, xref_predicate_text(Module:Callable, @default, File)),
 1149    findall(In, exported_to(File, Callable, In), InL),
 1150    send(T, append, new(XL, xref_graphical_list)),
 1151    (   InL == []
 1152    ->  true
 1153    ;   sort_files(InL, Sorted),
 1154        forall(member(F, Sorted),
 1155               send(XL, append, xref_imported_by(F, Callable)))
 1156    ),
 1157    send(T, next_row).
 1158
 1159show_file_export(W, Callable:prolog, ImportFiles:prolog) :->
 1160    get(W, prolog_file, File),
 1161    get(W, tabular, T),
 1162    send(T, append, xref_predicate_text(Callable, @default, File)),
 1163    send(T, append, new(XL, xref_graphical_list)),
 1164    sort_files(ImportFiles, Sorted),
 1165    qualify_from_file(Callable, File, QCall),
 1166    forall(member(F, Sorted),
 1167           send(XL, append, xref_imported_by(F, QCall))),
 1168    send(T, next_row).
 1169
 1170qualify_from_file(Callable, _, Callable) :-
 1171    Callable = _:_,
 1172    !.
 1173qualify_from_file(Callable, File, M:Callable) :-
 1174    xref_module(File, M),
 1175    !.
 1176qualify_from_file(Callable, _, Callable).
 exported_to(+ExportFile, +Callable, -ImportFile)
ImportFile imports Callable from ExportFile. The second clause deals with auto-import.

TBD: Make sure the autoload library is loaded before we begin.

 1186exported_to(ExportFile, Callable, ImportFile) :-
 1187    xref_defined(ImportFile, Callable, imported(ExportFile)),
 1188    atom(ImportFile).               % avoid XPCE buffers.
 1189exported_to(ExportFile, Callable, ImportFile) :-
 1190    '$autoload':library_index(Callable, _, ExportFileNoExt),
 1191    file_name_extension(ExportFileNoExt, _, ExportFile),
 1192    xref_called(ImportFile, Callable),
 1193    atom(ImportFile),
 1194    \+ xref_defined(ImportFile, Callable, _).
 1195
 1196show_imports(W) :->
 1197    "Show predicates we import"::
 1198    get(W, prolog_file, File),
 1199    findall(E-Cs,
 1200            setof(C, export_link_1(E, File, C), Cs),
 1201            Pairs),
 1202    (   Pairs \== []
 1203    ->  sort(Pairs, Sorted),        % TBD: use sort_files/2
 1204        (   xref_module(File, _)
 1205        ->  send(W, show_export_header, from, imports)
 1206        ;   send(W, show_export_header, from, uses)
 1207        ),
 1208        forall(member(E-Cs, Sorted),
 1209               send(W, show_import, E, Cs))
 1210    ;   true
 1211    ).
 1212
 1213show_import(W, File:name, Callables:prolog) :->
 1214    "Show imports from file"::
 1215    get(W, tabular, T),
 1216    send(T, append, xref_file_text(File)),
 1217    send(T, append, new(XL, xref_graphical_list)),
 1218    sort_callables(Callables, Sorted),
 1219    forall(member(C, Sorted),
 1220           send(XL, append, xref_predicate_text(C, @default, File))),
 1221    send(T, next_row).
 1222
 1223
 1224show_undefined(W) :->
 1225    "Add underfined predicates to table"::
 1226    get(W, prolog_file, File),
 1227    findall(Undef, undefined(File, Undef), UndefList),
 1228    (   UndefList == []
 1229    ->  true
 1230    ;   BG = (background := khaki1),
 1231        get(W, tabular, T),
 1232        (   setting(warn_autoload, true)
 1233        ->  Label = 'Undefined/autoload'
 1234        ;   Label = 'Undefined'
 1235        ),
 1236        send(T, append, Label, bold, center, BG),
 1237        send(T, append, 'Called by', bold, center, BG),
 1238        send(T, next_row),
 1239        sort_callables(UndefList, Sorted),
 1240        forall(member(Callable, Sorted),
 1241               send(W, show_undef, Callable))
 1242    ).
 1243
 1244show_undef(W, Callable:prolog) :->
 1245    "Show undefined predicate"::
 1246    get(W, prolog_file, File),
 1247    get(W, module, Module),
 1248    get(W, tabular, T),
 1249    send(T, append,
 1250         xref_predicate_text(Module:Callable, undefined, File)),
 1251    send(T, append, new(L, xref_graphical_list)),
 1252    findall(By, xref_called(File, Callable, By), By),
 1253    sort_callables(By, Sorted),
 1254    forall(member(P, Sorted),
 1255           send(L, append, xref_predicate_text(Module:P, called_by, File))),
 1256    send(T, next_row).
 1257
 1258
 1259show_not_called(W) :->
 1260    "Show predicates that are not called"::
 1261    get(W, prolog_file, File),
 1262    findall(NotCalled, not_called(File, NotCalled), NotCalledList),
 1263    (   NotCalledList == []
 1264    ->  true
 1265    ;   BG = (background := khaki1),
 1266        get(W, tabular, T),
 1267        send(T, append, 'Not called', bold, center, colspan := 2, BG),
 1268         send(T, next_row),
 1269        sort_callables(NotCalledList, Sorted),
 1270        forall(member(Callable, Sorted),
 1271               send(W, show_not_called_pred, Callable))
 1272    ).
 1273
 1274show_not_called_pred(W, Callable:prolog) :->
 1275    "Show a not-called predicate"::
 1276    get(W, prolog_file, File),
 1277    get(W, module, Module),
 1278    get(W, tabular, T),
 1279    send(T, append,
 1280         xref_predicate_text(Module:Callable, not_called, File),
 1281         colspan := 2),
 1282    send(T, next_row).
 1283
 1284:- pce_end_class(prolog_file_info).
 1285
 1286
 1287:- pce_begin_class(xref_predicate_text, text,
 1288                   "Text representing a predicate").
 1289
 1290class_variable(colour, colour, dark_green).
 1291
 1292variable(callable,       prolog, get, "Predicate indicator").
 1293variable(classification, [name], get, "Classification of the predicate").
 1294variable(file,           name*,  get, "File of predicate").
 1295
 1296initialise(T, Callable0:prolog,
 1297           Class:[{undefined,called_by,not_called}],
 1298           File:[name]) :->
 1299    "Create from callable or predicate indicator"::
 1300    single_qualify(Callable0, Callable),
 1301    send(T, slot, callable, Callable),
 1302    callable_to_label(Callable, File, Label),
 1303    send_super(T, initialise, Label),
 1304    (   File \== @default
 1305    ->  send(T, slot, file, File)
 1306    ;   true
 1307    ),
 1308    send(T, classification, Class).
 single_qualify(+Term, -Qualified)
Strip redundant M: from the term, leaving at most one qualifier.
 1314single_qualify(_:Q0, Q) :-
 1315    is_qualified(Q0),
 1316    !,
 1317    single_qualify(Q0, Q).
 1318single_qualify(Q, Q).
 1319
 1320is_qualified(M:_) :-
 1321    atom(M).
 1322
 1323pi(IT, PI:prolog) :<-
 1324    "Get predicate as predicate indicator (Name/Arity)"::
 1325    get(IT, callable, Callable),
 1326    to_predicate_indicator(Callable, PI).
 1327
 1328classification(T, Class:[name]) :->
 1329    send(T, slot, classification, Class),
 1330    (   Class == undefined
 1331    ->  get(T, callable, Callable),
 1332        strip_module(Callable, _, Plain),
 1333        (   autoload_predicate(Plain)
 1334        ->  send(T, colour, navy_blue),
 1335            send(T, slot, classification, autoload)
 1336        ;   global_predicate(Plain)
 1337        ->  send(T, colour, navy_blue),
 1338            send(T, slot, classification, global)
 1339        ;   send(T, colour, red)
 1340        )
 1341    ;   Class == not_called
 1342    ->  send(T, colour, red)
 1343    ;   true
 1344    ).
 1345
 1346:- pce_global(@xref_predicate_text_recogniser,
 1347              new(handler_group(@arm_recogniser,
 1348                                click_gesture(left, '', single,
 1349                                              message(@receiver, edit))))).
 1350
 1351event(T, Ev:event) :->
 1352    (   send_super(T, event, Ev)
 1353    ->  true
 1354    ;   send(@xref_predicate_text_recogniser, event, Ev)
 1355    ).
 1356
 1357
 1358arm(TF, Val:bool) :->
 1359    "Preview activiity"::
 1360    (   Val == @on
 1361    ->  send(TF, underline, @on),
 1362        (   get(TF, classification, Class),
 1363            Class \== @default
 1364        ->  send(TF, report, status,
 1365                 '%s predicate %s', Class?capitalise, TF?string)
 1366        ;   send(TF, report, status,
 1367                 'Predicate %s', TF?string)
 1368        )
 1369    ;   send(TF, underline, @off),
 1370        send(TF, report, status, '')
 1371    ).
 1372
 1373edit(T) :->
 1374    get(T, file, File),
 1375    get(T, callable, Callable),
 1376    edit_callable(Callable, File).
 1377
 1378:- pce_end_class(xref_predicate_text).
 1379
 1380
 1381:- pce_begin_class(xref_file_text, text,
 1382                   "Represent a file-name").
 1383
 1384variable(path,           name,         get, "Filename represented").
 1385variable(default_action, name := edit, both, "Default on click").
 1386
 1387initialise(TF, File:name) :->
 1388    absolute_file_name(File, Path),
 1389    file_name_on_path(Path, ShortId),
 1390    short_file_name_to_atom(ShortId, Label),
 1391    send_super(TF, initialise, Label),
 1392    send(TF, name, Path),
 1393    send(TF, slot, path, Path).
 1394
 1395:- pce_global(@xref_file_text_recogniser,
 1396              make_xref_file_text_recogniser). 1397
 1398make_xref_file_text_recogniser(G) :-
 1399    new(C, click_gesture(left, '', single,
 1400                         message(@receiver, run_default_action))),
 1401    new(P, popup_gesture(@arg1?popup)),
 1402    new(D, drag_and_drop_gesture(left)),
 1403    send(D, cursor, @default),
 1404    new(G, handler_group(C, D, P, @arm_recogniser)).
 1405
 1406popup(_, Popup:popup) :<-
 1407    new(Popup, popup),
 1408    send_list(Popup, append,
 1409              [ menu_item(edit, message(@arg1, edit)),
 1410                menu_item(info, message(@arg1, info)),
 1411                menu_item(header, message(@arg1, header))
 1412              ]).
 1413
 1414event(T, Ev:event) :->
 1415    (   send_super(T, event, Ev)
 1416    ->  true
 1417    ;   send(@xref_file_text_recogniser, event, Ev)
 1418    ).
 1419
 1420arm(TF, Val:bool) :->
 1421    "Preview activity"::
 1422    (   Val == @on
 1423    ->  send(TF, underline, @on),
 1424        send(TF, report, status, 'File %s', TF?path)
 1425    ;   send(TF, underline, @off),
 1426        send(TF, report, status, '')
 1427    ).
 1428
 1429run_default_action(T) :->
 1430    get(T, default_action, Def),
 1431    send(T, Def).
 1432
 1433edit(T) :->
 1434    get(T, path, Path),
 1435    edit(file(Path)).
 1436
 1437info(T) :->
 1438    get(T, path, Path),
 1439    send(T?frame, file_info, Path).
 1440
 1441header(T) :->
 1442    get(T, path, Path),
 1443    send(T?frame, file_header, Path).
 1444
 1445prolog_source(T, Src:string) :<-
 1446    "Import declarations"::
 1447    get(T, path, File),
 1448    new(V, xref_view),
 1449    send(V, file_header, File),
 1450    get(V?text_buffer, contents, Src),
 1451    send(V, destroy).
 1452
 1453:- pce_end_class(xref_file_text).
 1454
 1455
 1456:- pce_begin_class(xref_directory_text, text,
 1457                   "Represent a directory-name").
 1458
 1459variable(path,           name,         get, "Filename represented").
 1460
 1461initialise(TF, Dir:name, Label:[name]) :->
 1462    absolute_file_name(Dir, Path),
 1463    (   Label == @default
 1464    ->  file_base_name(Path, TheLabel)
 1465    ;   TheLabel = Label
 1466    ),
 1467    send_super(TF, initialise, TheLabel),
 1468    send(TF, slot, path, Path).
 1469
 1470files(DT, Files:chain) :<-
 1471    "List of files that belong to this directory"::
 1472    new(Files, chain),
 1473    get(DT, path, Path),
 1474    (   source_file(File),
 1475        sub_atom(File, 0, _, _, Path),
 1476        send(Files, append, File),
 1477        fail ; true
 1478    ).
 1479
 1480:- pce_global(@xref_directory_text_recogniser,
 1481              make_xref_directory_text_recogniser). 1482
 1483make_xref_directory_text_recogniser(G) :-
 1484    new(D, drag_and_drop_gesture(left)),
 1485    send(D, cursor, @default),
 1486    new(G, handler_group(D, @arm_recogniser)).
 1487
 1488event(T, Ev:event) :->
 1489    (   send_super(T, event, Ev)
 1490    ->  true
 1491    ;   send(@xref_directory_text_recogniser, event, Ev)
 1492    ).
 1493
 1494arm(TF, Val:bool) :->
 1495    "Preview activiity"::
 1496    (   Val == @on
 1497    ->  send(TF, underline, @on),
 1498        send(TF, report, status, 'Directory %s', TF?path)
 1499    ;   send(TF, underline, @off),
 1500        send(TF, report, status, '')
 1501    ).
 1502
 1503:- pce_end_class(xref_directory_text).
 1504
 1505
 1506:- pce_begin_class(xref_imported_by, figure,
 1507                   "Indicate import of callable into file").
 1508
 1509variable(callable, prolog, get, "Callable term of imported predicate").
 1510
 1511:- pce_global(@xref_horizontal_format,
 1512              make_xref_horizontal_format). 1513
 1514make_xref_horizontal_format(F) :-
 1515    new(F, format(vertical, 1, @on)),
 1516    send(F, row_sep, 3),
 1517    send(F, column_sep, 0).
 1518
 1519initialise(IT, File:name, Imported:prolog) :->
 1520    send_super(IT, initialise),
 1521    send(IT, format, @xref_horizontal_format),
 1522    send(IT, display, new(F, xref_file_text(File))),
 1523    send(F, name, file_text),
 1524    send(IT, slot, callable, Imported),
 1525    send(IT, show_called_by).
 1526
 1527path(IT, Path:name) :<-
 1528    "Represented file"::
 1529    get(IT, member, file_text, Text),
 1530    get(Text, path, Path).
 1531
 1532show_called_by(IT) :->
 1533    "Add number indicating calls"::
 1534    get(IT, called_by, List),
 1535    length(List, N),
 1536    send(IT, display, new(T, text(string('(%d)', N)))),
 1537    send(T, name, called_count),
 1538    (   N > 0
 1539    ->  send(T, underline, @on),
 1540        send(T, colour, blue),
 1541        send(T, recogniser, @xref_called_by_recogniser)
 1542    ;   send(T, colour, grey60)
 1543    ).
 1544
 1545called_by(IT, ByList:prolog) :<-
 1546    "Return list of callables satisfied by the import"::
 1547    get(IT, path, Source),
 1548    get(IT, callable, Callable),
 1549    findall(By, used_in(Source, Callable, By), ByList).
 used_in(+Source, +QCallable, -CalledBy)
Determine which the callers for QCallable in Source. QCallable is qualified with the module of the exporting file (if any).
 1556used_in(Source, M:Callable, By) :-              % we are the same module
 1557    xref_module(Source, M),
 1558    !,
 1559    xref_called(Source, Callable, By).
 1560used_in(Source, _:Callable, By) :-              % we imported
 1561    xref_defined(Source, Callable, imported(_)),
 1562    !,
 1563    xref_called(Source, Callable, By).
 1564used_in(Source, Callable, By) :-
 1565    xref_called(Source, Callable, By).
 1566used_in(Source, Callable, '<export>') :-
 1567    xref_exported(Source, Callable).
 1568
 1569:- pce_group(event).
 1570
 1571:- pce_global(@xref_called_by_recogniser,
 1572              new(popup_gesture(@receiver?device?called_by_popup, left))).
 1573
 1574called_by_popup(IT, P:popup) :<-
 1575    "Show called where import is called"::
 1576    new(P, popup(called_by, message(IT, edit_called_by, @arg1))),
 1577    get(IT, called_by, ByList),
 1578    sort_callables(ByList, Sorted),
 1579    forall(member(C, Sorted),
 1580           ( callable_to_label(C, Label),
 1581             send(P, append, menu_item(prolog(C), @default, Label)))).
 1582
 1583edit_called_by(IT, Called:prolog) :->
 1584    "Edit file on the predicate Called"::
 1585    get(IT, path, Source),
 1586    edit_callable(Called, Source).
 1587
 1588:- pce_end_class(xref_imported_by).
 1589
 1590
 1591:- pce_begin_class(xref_graphical_list, figure,
 1592                   "Show list of exports to files").
 1593
 1594variable(wrap, {extend,wrap,wrap_fixed_width,clip} := extend, get,
 1595         "Wrapping mode").
 1596
 1597initialise(XL) :->
 1598    send_super(XL, initialise),
 1599    send(XL, margin, 500, wrap).
 1600
 1601append(XL, I:graphical) :->
 1602    (   send(XL?graphicals, empty)
 1603    ->  true
 1604    ;   send(XL, display, text(', '))
 1605    ),
 1606    send(XL, display, I).
 1607
 1608:- pce_group(layout).
 1609
 1610:- pce_global(@xref_graphical_list_format,
 1611              make_xref_graphical_list_format). 1612
 1613make_xref_graphical_list_format(F) :-
 1614    new(F, format(horizontal, 500, @off)),
 1615    send(F, column_sep, 0),
 1616    send(F, row_sep, 0).
 1617
 1618margin(T, Width:int*, How:[{wrap,wrap_fixed_width,clip}]) :->
 1619    "Wrap items to indicated width"::
 1620    (   Width == @nil
 1621    ->  send(T, slot, wrap, extend),
 1622        send(T, format, @rdf_composite_format)
 1623    ;   send(T, slot, wrap, How),
 1624        How == wrap
 1625    ->  FmtWidth is max(10, Width),
 1626        new(F, format(horizontal, FmtWidth, @off)),
 1627        send(F, column_sep, 0),
 1628        send(F, row_sep, 0),
 1629        send(T, format, F)
 1630    ;   throw(tbd)
 1631    ).
 1632
 1633:- pce_end_class(xref_graphical_list).
 1634
 1635
 1636
 1637                 /*******************************
 1638                 *          PREDICATES          *
 1639                 *******************************/
 1640
 1641:- pce_begin_class(xref_predicate_browser, browser,
 1642                 "Show loaded files").
 1643
 1644initialise(PL) :->
 1645    send_super(PL, initialise),
 1646    send(PL, popup, new(P, popup)),
 1647    send_list(P, append,
 1648              [ menu_item(edit, message(@arg1, edit))
 1649              ]).
 1650
 1651update(PL) :->
 1652    send(PL, clear),
 1653    forall((defined(File, Callable), atom(File), \+ library_file(File)),
 1654           send(PL, append, Callable, @default, File)),
 1655    forall((xref_current_source(File), atom(File), \+library_file(File)),
 1656           forall(undefined(File, Callable),
 1657                  send(PL, append, Callable, undefined, File))),
 1658    send(PL, sort).
 1659
 1660append(PL, Callable:prolog, Class:[name], File:[name]) :->
 1661    send_super(PL, append, xref_predicate_dict_item(Callable, Class, File)).
 1662
 1663:- pce_end_class(xref_predicate_browser).
 1664
 1665
 1666:- pce_begin_class(xref_predicate_dict_item, dict_item,
 1667                   "Represent a Prolog predicate").
 1668
 1669variable(callable, prolog, get, "Callable term").
 1670variable(file,     name*,  get, "Origin file").
 1671
 1672initialise(PI, Callable0:prolog, _Class:[name], File:[name]) :->
 1673    "Create from callable, class and file"::
 1674    single_qualify(Callable0, Callable),
 1675    send(PI, slot, callable, Callable),
 1676    callable_to_label(Callable, Label),
 1677    send_super(PI, initialise, Label),
 1678    (   File \== @default
 1679    ->  send(PI, slot, file, File)
 1680    ;   true
 1681    ).
 1682
 1683edit(PI) :->
 1684    "Edit Associated prediate"::
 1685    get(PI, file, File),
 1686    get(PI, callable, Callable),
 1687    edit_callable(Callable, File).
 1688
 1689:- pce_end_class(xref_predicate_dict_item).
 1690
 1691
 1692                 /*******************************
 1693                 *         UTIL CLASSES         *
 1694                 *******************************/
 1695
 1696:- pce_begin_class(xref_view, view,
 1697                   "View with additional facilities for formatting").
 1698
 1699initialise(V) :->
 1700    send_super(V, initialise),
 1701    send(V, font, fixed).
 1702
 1703update(_) :->
 1704    true.                           % or ->clear?  ->destroy?
 1705
 1706file_header(View, File:name) :->
 1707    "Create import/export fileheader for File"::
 1708    (   xref_module(File, _)
 1709    ->  Decls = Imports
 1710    ;   xref_file_exports(File, Export),
 1711        Decls = [Export|Imports]
 1712    ),
 1713    xref_file_imports(File, Imports),
 1714    send(View, clear),
 1715    send(View, declarations, Decls),
 1716    (   (   nonvar(Export)
 1717        ->  send(View, report, status,
 1718                 'Created module header for non-module file %s', File)
 1719        ;   send(View, report, status,
 1720                 'Created import header for module file %s', File)
 1721        )
 1722    ->  true
 1723    ;   true
 1724    ).
 1725
 1726declarations(V, Decls:prolog) :->
 1727    pce_open(V, append, Out),
 1728    call_cleanup(print_decls(Decls, Out), close(Out)).
 1729
 1730print_decls([], _) :- !.
 1731print_decls([H|T], Out) :-
 1732    !,
 1733    print_decls(H, Out),
 1734    print_decls(T, Out).
 1735print_decls(Term, Out) :-
 1736    portray_clause(Out, Term).
 1737
 1738:- pce_end_class(xref_view).
 1739
 1740
 1741                 /*******************************
 1742                 *        FILE-NAME LOGIC       *
 1743                 *******************************/
 short_file_name_to_atom(+ShortId, -Atom)
Convert a short filename into an atom
 1749short_file_name_to_atom(Atom, Atom) :-
 1750    atomic(Atom),
 1751    !.
 1752short_file_name_to_atom(Term, Atom) :-
 1753    term_to_atom(Term, Atom).
 library_file(+Path)
True if Path comes from the Prolog tree and must be considered a library.
 1761library_file(Path) :-
 1762    current_prolog_flag(home, Home),
 1763    sub_atom(Path, 0, _, _, Home).
 profile_file(+Path)
True if path is a personalisation file. This is a bit hairy.
 1769profile_file(Path) :-
 1770    file_name_on_path(Path, user_profile(File)),
 1771    known_profile_file(File).
 1772
 1773known_profile_file('.swiplrc').
 1774known_profile_file('swipl.ini').
 1775known_profile_file('.pceemacsrc').
 1776known_profile_file(File) :-
 1777    sub_atom(File, 0, _, _, 'lib/xpce/emacs').
 sort_files(+Files, -Sorted)
Sort files, keeping groups comming from the same alias together.
 1783sort_files(Files0, Sorted) :-
 1784    sort(Files0, Files),            % remove duplicates
 1785    maplist(key_file, Files, Keyed),
 1786    keysort(Keyed, KSorted),
 1787    unkey(KSorted, Sorted).
 1788
 1789key_file(File, Key-File) :-
 1790    file_name_on_path(File, Key).
 1791
 1792
 1793                 /*******************************
 1794                 *           PREDICATES         *
 1795                 *******************************/
 available(+File, +Callable, -HowDefined)
True if Callable is available in File.
 1801available(File, Called, How) :-
 1802    xref_defined(File, Called, How0),
 1803    !,
 1804    How = How0.
 1805available(_, Called, How) :-
 1806    built_in_predicate(Called),
 1807    !,
 1808    How = builtin.
 1809available(_, Called, How) :-
 1810    setting(warn_autoload, false),
 1811    autoload_predicate(Called),
 1812    !,
 1813    How = autoload.
 1814available(_, Called, How) :-
 1815    setting(warn_autoload, false),
 1816    global_predicate(Called),
 1817    !,
 1818    How = global.
 1819available(_, Called, How) :-
 1820    Called = _:_,
 1821    defined(_, Called),
 1822    !,
 1823    How = module_qualified.
 1824available(_, M:G, How) :-
 1825    defined(ExportFile, G),
 1826    xref_module(ExportFile, M),
 1827    !,
 1828    How = module_overruled.
 1829available(_, Called, How) :-
 1830    defined(ExportFile, Called),
 1831    \+ xref_module(ExportFile, _),
 1832    !,
 1833    How == plain_file.
 built_in_predicate(+Callable)
True if Callable is a built-in
 1840built_in_predicate(Goal) :-
 1841    strip_module(Goal, _, Plain),
 1842    xref_built_in(Plain).
 autoload_predicate(+Callable) is semidet
 autoload_predicate(+Callable, -File) is semidet
True if Callable can be autoloaded. TBD: make sure the autoload index is up-to-date.
 1850autoload_predicate(Goal) :-
 1851    '$autoload':library_index(Goal, _, _).
 1852
 1853
 1854autoload_predicate(Goal, File) :-
 1855    '$autoload':library_index(Goal, _, FileNoExt),
 1856    file_name_extension(FileNoExt, pl, File).
 global_predicate(+Callable)
True if Callable can be auto-imported from the global user module.
 1864global_predicate(Goal) :-
 1865    predicate_property(user:Goal, _),
 1866    !.
 to_predicate_indicator(+Term, -PI)
Convert to a predicate indicator.
 1872to_predicate_indicator(PI, PI) :-
 1873    is_predicate_indicator(PI),
 1874    !.
 1875to_predicate_indicator(Callable, PI) :-
 1876    callable(Callable),
 1877    predicate_indicator(Callable, PI).
 is_predicate_indicator(+PI) is semidet
True if PI is a predicate indicator.
 1883is_predicate_indicator(Name/Arity) :-
 1884    atom(Name),
 1885    integer(Arity).
 1886is_predicate_indicator(Module:Name/Arity) :-
 1887    atom(Module),
 1888    atom(Name),
 1889    integer(Arity).
 predicate_indicator(+Callable, -Name)
Generate a human-readable predicate indicator
 1895predicate_indicator(Module:Goal, PI) :-
 1896    atom(Module),
 1897    !,
 1898    predicate_indicator(Goal, PI0),
 1899    (   hidden_module(Module)
 1900    ->  PI = PI0
 1901    ;   PI = Module:PI0
 1902    ).
 1903predicate_indicator(Goal, Name/Arity) :-
 1904    callable(Goal),
 1905    !,
 1906    functor(Goal, Name, Arity).
 1907predicate_indicator(Goal, Goal).
 1908
 1909hidden_module(user) :- !.
 1910hidden_module(system) :- !.
 1911hidden_module(M) :-
 1912    sub_atom(M, 0, _, _, $).
 sort_callables(+List, -Sorted)
Sort list of callable terms.
 1918sort_callables(Callables, Sorted) :-
 1919    key_callables(Callables, Tagged),
 1920    keysort(Tagged, KeySorted),
 1921    unkey(KeySorted, SortedList),
 1922    ord_list_to_set(SortedList, Sorted).
 1923
 1924key_callables([], []).
 1925key_callables([H0|T0], [Key-H0|T]) :-
 1926    key_callable(H0, Key),
 1927    key_callables(T0, T).
 1928
 1929key_callable(Callable, k(Name, Arity, Module)) :-
 1930    predicate_indicator(Callable, PI),
 1931    (   PI = Name/Arity
 1932    ->  Module = user
 1933    ;   PI = Module:Name/Arity
 1934    ).
 1935
 1936unkey([], []).
 1937unkey([_-H|T0], [H|T]) :-
 1938    unkey(T0, T).
 ord_list_to_set(+OrdList, -OrdSet)
Removed duplicates (after unification) from an ordered list, creating a set.
 1945ord_list_to_set([], []).
 1946ord_list_to_set([H|T0], [H|T]) :-
 1947    ord_remove_same(H, T0, T1),
 1948    ord_list_to_set(T1, T).
 1949
 1950ord_remove_same(H, [H|T0], T) :-
 1951    !,
 1952    ord_remove_same(H, T0, T).
 1953ord_remove_same(_, L, L).
 callable_to_label(+Callable, +File, -Label:atom) is det
 callable_to_label(+Callable, -Label:atom) is det
Label is a textual label representing Callable in File.
 1961callable_to_label(Callable, Label) :-
 1962    callable_to_label(Callable, @nil, Label).
 1963
 1964callable_to_label(pce_principal:send_implementation(Id,_,_), _, Id) :-
 1965    atom(Id),
 1966    !.
 1967callable_to_label(pce_principal:get_implementation(Id,_,_,_), _, Id) :-
 1968    atom(Id),
 1969    !.
 1970callable_to_label('<export>', _, '<export>') :- !.
 1971callable_to_label('<directive>'(Line), _, Label) :-
 1972    !,
 1973    atom_concat('<directive>@', Line, Label).
 1974callable_to_label(_:'<directive>'(Line), _, Label) :-
 1975    !,
 1976    atom_concat('<directive>@', Line, Label).
 1977callable_to_label(Callable, File, Label) :-
 1978    to_predicate_indicator(Callable, PI0),
 1979    (   PI0 = M:PI1
 1980    ->  (   atom(File),
 1981            xref_module(File, M)
 1982        ->  PI = PI1
 1983        ;   PI = PI0
 1984        )
 1985    ;   PI = PI0
 1986    ),
 1987    term_to_atom(PI, Label).
 edit_callable(+Callable, +File)
 1991edit_callable('<export>', File) :-
 1992    !,
 1993    edit(file(File)).
 1994edit_callable(Callable, File) :-
 1995    local_callable(Callable, File, Local),
 1996    (   xref_defined(File, Local, How),
 1997        xref_definition_line(How, Line)
 1998    ->  edit(file(File, line(Line)))
 1999    ;   autoload_predicate(Local)
 2000    ->  functor(Local, Name, Arity),
 2001        edit(Name/Arity)
 2002    ).
 2003edit_callable(pce_principal:send_implementation(Id,_,_), _) :-
 2004    atom(Id),
 2005    atomic_list_concat([Class,Method], ->, Id),
 2006    !,
 2007    edit(send(Class, Method)).
 2008edit_callable(pce_principal:get_implementation(Id,_,_,_), _) :-
 2009    atom(Id),
 2010    atomic_list_concat([Class,Method], <-, Id),
 2011    !,
 2012    edit(get(Class, Method)).
 2013edit_callable('<directive>'(Line), File) :-
 2014    File \== @nil,
 2015    !,
 2016    edit(file(File, line(Line))).
 2017edit_callable(_:'<directive>'(Line), File) :-
 2018    File \== @nil,
 2019    !,
 2020    edit(file(File, line(Line))).
 2021edit_callable(Callable, _) :-
 2022    to_predicate_indicator(Callable, PI),
 2023    edit(PI).
 2024
 2025local_callable(M:Callable, File, Callable) :-
 2026    xref_module(File, M),
 2027    !.
 2028local_callable(Callable, _, Callable).
 2029
 2030
 2031                 /*******************************
 2032                 *            WARNINGS          *
 2033                 *******************************/
 file_warnings(+File:atom, -Warnings:list(atom))
Unify Warnings with a list of dubious things found in File. Intended to create icons. Fails if the file is totally ok.
 2040file_warnings(File, Warnings) :-
 2041    setof(W, file_warning(File, W), Warnings).
 2042
 2043file_warning(File, undefined) :-
 2044    undefined(File, _) -> true.
 2045file_warning(File, not_called) :-
 2046    setting(warn_not_called, true),
 2047    not_called(File, _) -> true.
 not_called(+File, -Callable)
Callable is a term defined in File, and for which no callers can be found.
 2055not_called(File, NotCalled) :-          % module version
 2056    xref_module(File, Module),
 2057    !,
 2058    defined(File, NotCalled),
 2059    \+ (   xref_called(File, NotCalled)
 2060       ;   xref_exported(File, NotCalled)
 2061       ;   xref_hook(NotCalled)
 2062       ;   xref_hook(Module:NotCalled)
 2063       ;   NotCalled = _:Goal,
 2064           xref_hook(Goal)
 2065       ;   xref_called(_, Module:NotCalled)
 2066       ;   NotCalled = _:_,
 2067           xref_called(_, NotCalled)
 2068       ;   NotCalled = M:G,
 2069           xref_called(ModFile, G),
 2070           xref_module(ModFile, M)
 2071       ;   generated_callable(Module:NotCalled)
 2072       ).
 2073not_called(File, NotCalled) :-          % non-module version
 2074    defined(File, NotCalled),
 2075    \+ (   xref_called(ImportFile, NotCalled),
 2076           \+ xref_module(ImportFile, _)
 2077       ;   NotCalled = _:_,
 2078           xref_called(_, NotCalled)
 2079       ;   NotCalled = M:G,
 2080           xref_called(ModFile, G),
 2081           xref_module(ModFile, M)
 2082       ;   xref_called(AutoImportFile, NotCalled),
 2083           \+ defined(AutoImportFile, NotCalled),
 2084           global_predicate(NotCalled)
 2085       ;   xref_hook(NotCalled)
 2086       ;   xref_hook(user:NotCalled)
 2087       ;   generated_callable(user:NotCalled)
 2088       ).
 2089
 2090generated_callable(M:Term) :-
 2091    functor(Term, Name, Arity),
 2092    prolog:generated_predicate(M:Name/Arity).
 xref_called(?Source, ?Callable) is nondet
True if Callable is called in Source, after removing recursive calls and calls made to predicates where the condition says that the predicate should not exist.
 2100xref_called(Source, Callable) :-
 2101    xref_called_cond(Source, Callable, _).
 2102
 2103xref_called_cond(Source, Callable, Cond) :-
 2104    xref_called(Source, Callable, By, Cond),
 2105    By \= Callable.                 % recursive calls
 defined(?File, ?Callable)
True if Callable is defined in File and not imported.
 2111defined(File, Callable) :-
 2112    xref_defined(File, Callable, How),
 2113    atom(File),
 2114    How \= imported(_),
 2115    How \= (multifile).
 undefined(+File, -Callable)
Callable is called in File, but no definition can be found. If File is not a module file we consider other files that are not module files.
 2123undefined(File, Undef) :-
 2124    xref_module(File, _),
 2125    !,
 2126    xref_called_cond(File, Undef, Cond),
 2127    \+ (   available(File, Undef, How),
 2128           How \== plain_file
 2129       ),
 2130    included_if_defined(Cond, Undef).
 2131undefined(File, Undef) :-
 2132    xref_called_cond(File, Undef, Cond),
 2133    \+ available(File, Undef, _),
 2134    included_if_defined(Cond, Undef).
 included_if_defined(+Condition, +Callable) is semidet
 2138included_if_defined(true, _)  :- !.
 2139included_if_defined(false, _) :- !, fail.
 2140included_if_defined(fail, _)  :- !, fail.
 2141included_if_defined(current_predicate(Name/Arity), Callable) :-
 2142    \+ functor(Callable, Name, Arity),
 2143    !.
 2144included_if_defined(\+ Cond, Callable) :-
 2145    !,
 2146    \+ included_if_defined(Cond, Callable).
 2147included_if_defined((A,B), Callable) :-
 2148    !,
 2149    included_if_defined(A, Callable),
 2150    included_if_defined(B, Callable).
 2151included_if_defined((A;B), Callable) :-
 2152    !,
 2153    (   included_if_defined(A, Callable)
 2154    ;   included_if_defined(B, Callable)
 2155    ).
 2156
 2157
 2158                 /*******************************
 2159                 *    IMPORT/EXPORT HEADERS     *
 2160                 *******************************/
 file_imports(+File, -Imports)
Determine which modules must be imported into this one. It considers all called predicates that are not covered by system predicates. Next, we have three sources to resolve the remaining predicates, which are tried in the order below. The latter two is dubious.
We first resolve all imports to absolute files. Localizing is done afterwards. Imports is a list of

! use_module(FileSpec, Callables)

 2179xref_file_imports(FileSpec, Imports) :-
 2180    canonical_filename(FileSpec, File),
 2181    findall(Called, called_no_builtin(File, Called), Resolve0),
 2182    resolve_old_imports(Resolve0, File, Resolve1, Imports0),
 2183    find_new_imports(Resolve1, File, Imports1),
 2184    disambiguate_imports(Imports1, File, Imports2),
 2185    flatten([Imports0, Imports2], ImportList),
 2186    keysort(ImportList, SortedByFile),
 2187    merge_by_key(SortedByFile, ImportsByFile),
 2188    maplist(make_import(File), ImportsByFile, Imports).
 2189
 2190canonical_filename(FileSpec, File) :-
 2191    absolute_file_name(FileSpec,
 2192                       [ file_type(prolog),
 2193                         access(read),
 2194                         file_errors(fail)
 2195                       ],
 2196                       File).
 2197
 2198called_no_builtin(File, Callable) :-
 2199    xref_called(File, Callable),
 2200    \+ defined(File, Callable),
 2201    \+ built_in_predicate(Callable).
 2202
 2203resolve_old_imports([], _, [], []).
 2204resolve_old_imports([H|T0], File, UnRes, [From-H|T]) :-
 2205    xref_defined(File, H, imported(From)),
 2206    !,
 2207    resolve_old_imports(T0, File, UnRes, T).
 2208resolve_old_imports([H|T0], File, [H|UnRes], Imports) :-
 2209    resolve_old_imports(T0, File, UnRes, Imports).
 2210
 2211find_new_imports([], _, []).
 2212find_new_imports([H|T0], File, [FL-H|T]) :-
 2213    findall(F, resolve(H, F), FL0),
 2214    sort(FL0, FL),
 2215    find_new_imports(T0, File, T).
 2216
 2217disambiguate_imports(Imports0, File, Imports) :-
 2218    ambiguous_imports(Imports0, Ambig, UnAmbig, _Undef),
 2219    (   Ambig == []
 2220    ->  Imports = UnAmbig
 2221    ;   new(D, xref_disambiguate_import_dialog(File, Ambig)),
 2222        get(D, confirm_centered, Result),
 2223        (   Result == ok
 2224        ->  get(D, result, List),
 2225            send(D, destroy),
 2226            append(UnAmbig, List, Imports)
 2227        )
 2228    ).
 2229
 2230ambiguous_imports([], [], [], []).
 2231ambiguous_imports([[]-C|T0], Ambig, UnAmbig, [C|T]) :-
 2232    !,
 2233    ambiguous_imports(T0, Ambig, UnAmbig, T).
 2234ambiguous_imports([[F]-C|T0], Ambig, [F-C|T], Undef) :-
 2235    !,
 2236    ambiguous_imports(T0, Ambig, T, Undef).
 2237ambiguous_imports([A-C|T0], [A-C|T], UnAmbig, Undef) :-
 2238    is_list(A),
 2239    !,
 2240    ambiguous_imports(T0, T, UnAmbig, Undef).
 resolve(+Callable, -File)
Try to find files from which to resolve Callable.
 2247resolve(Callable, File) :-              % Export from module files
 2248    xref_exported(File, Callable),
 2249    atom(File).
 2250resolve(Callable, File) :-              % Non-module files
 2251    defined(File, Callable),
 2252    atom(File),
 2253    \+ xref_module(File, _).
 2254resolve(Callable, File) :-              % The Prolog autoload library
 2255    autoload_predicate(Callable, File).
 merge_by_key(+KeyedList, -ListOfKeyValues) is det
Example: [a-x, a-y, b-z] --> [a-[x,y], b-[z]]
 2262merge_by_key([], []).
 2263merge_by_key([K-V|T0], [K-[V|Vs]|T]) :-
 2264    same_key(K, T0, Vs, T1),
 2265    merge_by_key(T1, T).
 2266
 2267same_key(K, [K-V|T0], [V|VT], T) :-
 2268    !,
 2269    same_key(K, T0, VT, T).
 2270same_key(_, L, [], L).
 make_import(+RefFile, +ImportList, -UseModules)
Glues it all together to make a list of directives.
 2277make_import(RefFile, File-Imports, (:-use_module(ShortPath, PIs))) :-
 2278    local_filename(File, RefFile, ShortPath),
 2279    sort_callables(Imports, SortedImports),
 2280    maplist(predicate_indicator, SortedImports, PIs).
 2281
 2282local_filename(File, RefFile, ShortPath) :-
 2283    atom(RefFile),
 2284    file_directory_name(File, Dir),
 2285    file_directory_name(RefFile, Dir),     % i.e. same dir
 2286    !,
 2287    file_base_name(File, Base),
 2288    remove_extension(Base, ShortPath).
 2289local_filename(File, _RefFile, ShortPath) :-
 2290    file_name_on_path(File, ShortPath0),
 2291    remove_extension(ShortPath0, ShortPath).
 2292
 2293
 2294remove_extension(Term0, Term) :-
 2295    Term0 =.. [Alias,ShortPath0],
 2296    file_name_extension(ShortPath, pl, ShortPath0),
 2297    !,
 2298    Term  =.. [Alias,ShortPath].
 2299remove_extension(ShortPath0, ShortPath) :-
 2300    atom(ShortPath0),
 2301    file_name_extension(ShortPath, pl, ShortPath0),
 2302    !.
 2303remove_extension(Path, Path).
 2304
 2305:- pce_begin_class(xref_disambiguate_import_dialog, auto_sized_dialog,
 2306                   "Prompt for alternative sources").
 2307
 2308initialise(D, File:name, Ambig:prolog) :->
 2309    send_super(D, initialise, string('Disambiguate calls for %s', File)),
 2310    forall(member(Files-Callable, Ambig),
 2311           send(D, append_row, File, Callable, Files)),
 2312    send(D, append, button(ok)),
 2313    send(D, append, button(cancel)).
 2314
 2315append_row(D, File:name, Callable:prolog, Files:prolog) :->
 2316    send(D, append, xref_predicate_text(Callable, @default, File)),
 2317    send(D, append, new(FM, menu(file, cycle)), right),
 2318    send(FM, append, menu_item(@nil, @default, '-- Select --')),
 2319    forall(member(Path, Files),
 2320           (   file_name_on_path(Path, ShortId),
 2321               short_file_name_to_atom(ShortId, Label),
 2322               send(FM, append, menu_item(Path, @default, Label))
 2323           )).
 2324
 2325result(D, Disam:prolog) :<-
 2326    "Get disambiguated files"::
 2327    get_chain(D, graphicals, Grs),
 2328    selected_files(Grs, Disam).
 2329
 2330selected_files([], []).
 2331selected_files([PreText,Menu|T0], [File-Callable|T]) :-
 2332    send(PreText, instance_of, xref_predicate_text),
 2333    send(Menu, instance_of, menu),
 2334    get(Menu, selection, File),
 2335    atom(File),
 2336    !,
 2337    get(PreText, callable, Callable),
 2338    selected_files(T0, T).
 2339selected_files([_|T0], T) :-
 2340    selected_files(T0, T).
 2341
 2342
 2343ok(D) :->
 2344    send(D, return, ok).
 2345
 2346cancel(D) :->
 2347    send(D, destroy).
 2348
 2349:- pce_end_class(xref_disambiguate_import_dialog).
 xref_file_exports(+File, -Exports)
Produce the export-header for non-module files. Fails if the file is already a module file.
 2356xref_file_exports(FileSpec, (:- module(Module, Exports))) :-
 2357    canonical_filename(FileSpec, File),
 2358    \+ xref_module(File, _),
 2359    findall(C, export_link_1(File, _, C), Cs),
 2360    sort_callables(Cs, Sorted),
 2361    file_base_name(File, Base),
 2362    file_name_extension(Module, _, Base),
 2363    maplist(predicate_indicator, Sorted, Exports)