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