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