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