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