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).