/* Part of XPCE --- The SWI-Prolog GUI toolkit Author: Jan Wielemaker and Anjo Anjewierden E-mail: wielemak@science.uva.nl WWW: http://www.swi-prolog.org/packages/xpce/ Copyright (c) 2006-2015, University of Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ :- module(pce_xref_gui, [ gxref/0, xref_file_imports/2, % +File, -Imports xref_file_exports/2 % +File, -Exports ]). :- use_module(pce). :- use_module(persistent_frame). :- use_module(tabbed_window). :- use_module(toolbar). :- use_module(pce_report). :- use_module(pce_util). :- use_module(pce_toc). :- use_module(pce_arm). :- use_module(pce_tagged_connection). :- use_module(dragdrop). :- use_module(pce_prolog_xref). :- use_module(print_graphics). :- use_module(tabular). :- use_module(library(lists)). :- use_module(library(debug)). :- use_module(library(autowin)). :- use_module(library(broadcast)). :- use_module(library(prolog_source)). version('0.1.1'). :- dynamic setting/2. setting_menu([ warn_autoload, warn_not_called ]). setting(warn_autoload, false). setting(warn_not_called, true). setting(hide_system_files, true). setting(hide_profile_files, true). /** Cross-referencer front-end XPCE based font-end of the Prolog cross-referencer. Tasks: * Cross-reference currently loaded program OK * Generate module-dependency graph OK * Information on - Syntax and other encountered errors - Export/Import relation between modules OK - Undefined predicates OK - Unused predicates OK * Summary information - Syntax and other encountered errors - Exports never used (not for libs!) - Undefined predicates - Unused predicates * Export module import and export header - Using require/1 - Using use_module/1 - Using use_module/2 OK - Export header for non-module files OK @bug Tool produces an error if a file that has been xref'ed is deleted. Paulo Moura. @see library(prolog_xref) holds the actual data-collection. */ %! gxref % % Start graphical cross-referencer on loaded program. The GUI % is started in the XPCE thread. gxref :- in_pce_thread(xref_gui). xref_gui :- send(new(XREF, xref_frame), open), send(XREF, wait), send(XREF, update). :- pce_begin_class(xref_frame, persistent_frame, "GUI for the Prolog cross-referencer"). initialise(F) :-> send_super(F, initialise, 'Prolog XREF'), new(FilterDialog, xref_filter_dialog), send(new(BrowserTabs, tabbed_window), below, FilterDialog), send(BrowserTabs, left, new(WSTabs, tabbed_window)), send(BrowserTabs, name, browsers), send(BrowserTabs, hor_shrink, 10), send(BrowserTabs, hor_stretch, 10), send(WSTabs, name, workspaces), send_list([BrowserTabs, WSTabs], label_popup, F?tab_popup), send(new(TD, tool_dialog(F)), above, BrowserTabs), send(new(report_dialog), below, BrowserTabs), send(F, append, BrowserTabs), send_list(BrowserTabs, [ append(new(xref_file_tree), files), append(new(xref_predicate_browser), predicates) ]), send_list(WSTabs, [ append(new(xref_depgraph), dependencies) ]), send(F, fill_toolbar, TD). tab_popup(_F, P:popup) :<- "Popup for tab labels":: new(P, popup), send_list(P, append, [ menu_item(close, message(@arg1, destroy)), menu_item(detach, message(@arg1, untab)) ]). fill_toolbar(F, TD:tool_dialog) :-> send(TD, append, new(File, popup(file))), send(TD, append, new(Settings, popup(settings, message(F, setting, @arg1, @arg2)))), send(TD, append, new(View, popup(view))), send(TD, append, new(Help, popup(help))), send_list(File, append, [ menu_item(exit, message(F, destroy)) ]), send_list(View, append, [ menu_item(refresh, message(F, update)) ]), send_list(Help, append, [ menu_item(about, message(F, about)) ]), send(Settings, show_current, @on), send(Settings, multiple_selection, @on), send(F, update_setting_menu). about(_F) :-> version(Version), send(@display, inform, string('SWI-Prolog cross-referencer version %s\n\c By Jan Wielemaker', Version)). :- pce_group(parts). workspace(F, Which:name, Create:[bool], Expose:bool, WS:window) :<- "Find named workspace":: get(F, member, workspaces, Tabs), ( get(Tabs, member, Which, WS) -> true ; Create == @on -> workspace_term(Which, New), new(WS, New), send(WS, name, Which), send(Tabs, append, WS) ), ( Expose == @on -> send(Tabs, on_top, WS?name) ; true ). workspace_term(file_info, prolog_file_info). workspace_term(header, xref_view). browser(F, Which:name, Browser:browser) :<- "Find named browser":: get(F, member, browsers, Tabs), get(Tabs, member, Which, Browser). update(F) :-> "Update all windows":: send(F, xref_all), get(F, member, browsers, Tabs), send(Tabs?members, for_some, message(@arg1, update)), get(F, member, workspaces, WSs), send(WSs?members, for_some, message(@arg1, update)). xref_all(F) :-> "Run X-referencer on all files":: forall(source_file(File), send(F, xref_file, File)). xref_file(F, File:name) :-> "XREF a single file if not already done":: ( xref_done(File, Time), catch(time_file(File, Modified), _, fail), Modified == Time -> true ; send(F, report, progress, 'XREF %s', File), xref_source(File, [silent(true)]), send(F, report, done) ). :- pce_group(actions). file_info(F, File:name) :-> "Show summary info on File":: get(F, workspace, file_info, @on, @on, Window), send(Window, file, File), broadcast(xref_refresh_file(File)). file_header(F, File:name) :-> "Create import/export header":: get(F, workspace, header, @on, @on, View), send(View, file_header, File). :- pce_group(settings). update_setting_menu(F) :-> "Update the menu for the settings with the current values":: get(F, member, tool_dialog, TD), get(TD, member, menu_bar, MB), get(MB, member, settings, Popup), send(Popup, clear), setting_menu(Entries), ( member(Name, Entries), setting(Name, Value), send(Popup, append, new(MI, menu_item(Name))), ( Value == true -> send(MI, selected, @on) ; true ), fail ; true ). setting(F, S:name, PceVal:bool) :-> "Update setting and redo analysis":: pce_to_prolog_bool(PceVal, Val), retractall(setting(S, _)), assert(setting(S, Val)), send(F, update). pce_to_prolog_bool(@on, true). pce_to_prolog_bool(@off, false). :- pce_end_class(xref_frame). /******************************* * WORKSPACE * *******************************/ :- pce_begin_class(xref_depgraph, picture, "Workspace showing dependecies"). :- use_class_template(arm). :- use_class_template(print_graphics). initialise(W) :-> send_super(W, initialise), send(W, popup, new(P, popup)), send_list(P, append, [ menu_item(layout, message(W, layout)), gap, menu_item(view_whole_project, message(W, show_project)), gap, menu_item(clear, message(W, clear, destroy)), gap, menu_item(print, message(W, print)) ]). update(P) :-> "Initial screen":: send(P, display, new(T, text('Drag files or directories to dependency view\n\c or use background menu to show the whole project')), point(10,10)), send(T, name, intro_text), send(T, colour, grey50). remove_intro_text(P) :-> "Remove the introductionary text":: ( get(P, member, intro_text, Text) -> send(Text, destroy) ; true ). show_project(P) :-> get(P, sources, Sources), send(P, clear, destroy), forall(member(Src, Sources), send(P, append, Src)), send(P, update_links), send(P, layout). sources(_, Sources:prolog) :<- findall(S, dep_source(S), Sources). %! dep_source(?Src) % % Generate all sources for the dependecy graph one-by-one. dep_source(Src) :- source_file(Src), ( setting(hide_system_files, true) -> \+ library_file(Src) ; true ), ( setting(hide_profile_files, true) -> \+ profile_file(Src) ; true ). append(P, File:name, Create:[bool|{always}]) :-> "Append File. If Create == always also if a system file":: default(Create, @on, C), get(P, node, File, C, _). node(G, File:name, Create:[bool|{always}], Pos:[point], Gr:xref_file_graph_node) :<- "Get the node representing File":: ( get(G, member, File, Gr) -> true ; ( Create == @on -> dep_source(File) ; Create == always ), ( Pos == @default -> get(G?visible, center, At) ; At = Pos ), send(G, display, new(Gr, xref_file_graph_node(File)), At), send(G, remove_intro_text) ). update_links(G) :-> "Add all export links":: send(G?graphicals, for_all, if(message(@arg1, instance_of, xref_file_graph_node), message(@arg1, create_export_links))). layout(G, MoveOnly:[chain]) :-> "Do graph layout":: get(G?graphicals, find_all, message(@arg1, instance_of, xref_file_graph_node), Nodes), get(Nodes, find_all, not(@arg1?connections), UnConnected), send(Nodes, subtract, UnConnected), new(Pos, point(10,10)), send(UnConnected, for_all, and(message(@arg1, position, Pos), message(Pos, offset, 0, 25))), get(Nodes, head, First), send(First, layout, nominal := 100, iterations := 1000, network := Nodes, move_only := MoveOnly). :- pce_group(dragdrop). drop(G, Obj:object, Pos:point) :-> "Drop a file on the graph":: ( send(Obj, instance_of, xref_file_text) -> get(Obj, path, File), ( get(G, node, File, Node) -> send(Node, flash) ; get(G, node, File, always, Pos, _Node), send(G, update_links) ) ; send(Obj, instance_of, xref_directory_text) -> get(Obj, files, Files), layout_new(G, ( send(Files, for_all, message(G, append, @arg1, always)), send(G, update_links) )) ). preview_drop(G, Obj:object*, Pos:point) :-> "Show preview of drop":: ( Obj == @nil -> send(G, report, status, '') ; send(Obj, instance_of, xref_file_text) -> ( get(Obj, device, G) -> send(Obj, move, Pos) ; get(Obj, path, File), get(Obj, string, Label), ( get(G, node, File, _Node) -> send(G, report, status, '%s: already in graph', Label) ; send(G, report, status, 'Add %s to graph', Label) ) ) ; send(Obj, instance_of, xref_directory_text) -> get(Obj, path, Path), send(G, report, status, 'Add files from directory %s', Path) ). :- pce_end_class(xref_depgraph). :- pce_begin_class(xref_file_graph_node, xref_file_text). :- send(@class, handle, handle(w/2, 0, link, north)). :- send(@class, handle, handle(w, h/2, link, west)). :- send(@class, handle, handle(w/2, h, link, south)). :- send(@class, handle, handle(0, h/2, link, east)). initialise(N, File:name) :-> send_super(N, initialise, File), send(N, font, bold), send(N, background, grey80). create_export_links(N, Add:[bool]) :-> "Create the export links to other files":: get(N, path, Exporter), forall(export_link(Exporter, Importer, Callables), create_export_link(N, Add, Importer, Callables)). create_export_link(From, Add, Importer, Callables) :- ( get(From?device, node, Importer, Add, INode) -> send(From, link, INode, Callables) ; true ). create_import_links(N, Add:[bool]) :-> "Create the import links from other files":: get(N, path, Importer), forall(export_link(Exporter, Importer, Callables), create_import_link(N, Add, Exporter, Callables)). create_import_link(From, Add, Importer, Callables) :- ( get(From?device, node, Importer, Add, INode) -> send(INode, link, From, Callables) ; true ). link(N, INode:xref_file_graph_node, Callables:prolog) :-> "Create export link to INode":: ( get(N, connections, INode, CList), get(CList, find, @arg1?from == N, C) -> send(C, callables, Callables) ; new(L, xref_export_connection(N, INode, Callables)), send(L, hide) ). :- pce_global(@xref_file_graph_node_recogniser, make_xref_file_graph_node_recogniser). make_xref_file_graph_node_recogniser(G) :- new(G, move_gesture(left, '')). event(N, Ev:event) :-> "Add moving (overrule supreclass":: ( send(@xref_file_graph_node_recogniser, event, Ev) -> true ; send_super(N, event, Ev) ). popup(N, Popup:popup) :<- get_super(N, popup, Popup), send_list(Popup, append, [ gap, menu_item(show_exports, message(@arg1, show_import_exports, export)), menu_item(show_imports, message(@arg1, show_import_exports, import)), gap, menu_item(hide, message(@arg1, destroy)) ]). show_import_exports(N, Which:{import,export}) :-> "Show who I'm exporting to":: get(N, device, G), layout_new(G, ( ( Which == export -> send(N, create_export_links, @on) ; send(N, create_import_links, @on) ), send(G, update_links) )). layout_new(G, Goal) :- get(G?graphicals, find_all, message(@arg1, instance_of, xref_file_graph_node), Nodes0), Goal, get(G?graphicals, find_all, message(@arg1, instance_of, xref_file_graph_node), Nodes), send(Nodes, subtract, Nodes0), ( send(Nodes, empty) -> send(G, report, status, 'No nodes added') ; send(G, layout, Nodes), get(Nodes, size, Size), send(G, report, status, '%d nodes added', Size) ). :- pce_end_class(xref_file_graph_node). :- pce_begin_class(xref_export_connection, tagged_connection). variable(callables, prolog, get, "Callables in Import/export link"). initialise(C, From:xref_file_graph_node, To:xref_file_graph_node, Callables:prolog) :-> send_super(C, initialise, From, To), send(C, arrows, second), send(C, slot, callables, Callables), length(Callables, N), send(C, tag, xref_export_connection_tag(C, N)). callables(C, Callables:prolog) :-> send(C, slot, callables, Callables). % TBD: update tag? called_by_popup(Conn, P:popup) :<- "Create popup to show relating predicates":: new(P, popup(called_by, message(Conn, edit_callable, @arg1))), get(Conn, callables, Callables), get(Conn?from, path, ExportFile), get(Conn?to, path, ImportFile), sort_callables(Callables, Sorted), forall(member(C, Sorted), append_io_callable(P, ImportFile, ExportFile, C)). %! append_io_callable(+Popup, -ImportFile, +Callable) append_io_callable(P, ImportFile, ExportFile, Callable) :- callable_to_label(Callable, Label), send(P, append, new(MI, menu_item(@nil, @default, Label))), send(MI, popup, new(P2, popup)), send(P2, append, menu_item(prolog(''(Callable)), @default, definition?label_name)), send(P2, append, gap), qualify_from_file(Callable, ExportFile, QCall), findall(By, used_in(ImportFile, QCall, By), ByList0), sort_callables(ByList0, ByList), forall(member(C, ByList), ( callable_to_label(C, CLabel), send(P2, append, menu_item(prolog(C), @default, CLabel)))). edit_callable(C, Callable:prolog) :-> "Edit definition or callers":: ( Callable = ''(Def) -> get(C?from, path, ExportFile), edit_callable(Def, ExportFile) ; get(C?to, path, ImportFile), edit_callable(Callable, ImportFile) ). :- pce_end_class(xref_export_connection). :- pce_begin_class(xref_export_connection_tag, text, "Text showing import/export count"). variable(connection, xref_export_connection, get, "Related connection"). initialise(Tag, C:xref_export_connection, N:int) :-> send(Tag, slot, connection, C), send_super(Tag, initialise, string('(%d)', N)), send(Tag, colour, blue), send(Tag, underline, @on). :- pce_global(@xref_export_connection_tag_recogniser, new(popup_gesture(@receiver?connection?called_by_popup, left))). event(Tag, Ev:event) :-> ( send_super(Tag, event, Ev) -> true ; send(@xref_export_connection_tag_recogniser, event, Ev) ). :- pce_end_class(xref_export_connection_tag). %! export_link(+ExportingFile, -ImportingFile, -Callables) is det. %! export_link(-ExportingFile, +ImportingFile, -Callables) is det. % % Callables are exported from ExportingFile to ImportingFile. export_link(ExportFile, ImportingFile, Callables) :- setof(Callable, export_link_1(ExportFile, ImportingFile, Callable), Callables0), sort_callables(Callables0, Callables). export_link_1(ExportFile, ImportFile, Callable) :- % module export nonvar(ExportFile), xref_module(ExportFile, Module), !, ( xref_exported(ExportFile, Callable), xref_defined(ImportFile, Callable, imported(ExportFile)), xref_called(ImportFile, Callable) ; defined(ExportFile, Callable), single_qualify(Module:Callable, QCall), xref_called(ImportFile, QCall) ), ImportFile \== ExportFile, atom(ImportFile). export_link_1(ExportFile, ImportFile, Callable) :- % Non-module export nonvar(ExportFile), !, defined(ExportFile, Callable), xref_called(ImportFile, Callable), atom(ImportFile), ExportFile \== ImportFile. export_link_1(ExportFile, ImportFile, Callable) :- % module import nonvar(ImportFile), xref_module(ImportFile, Module), !, xref_called(ImportFile, Callable), ( xref_defined(ImportFile, Callable, imported(ExportFile)) ; single_qualify(Module:Callable, QCall), QCall = M:G, ( defined(ExportFile, G), xref_module(ExportFile, M) ; defined(ExportFile, QCall) ) ), ImportFile \== ExportFile, atom(ExportFile). export_link_1(ExportFile, ImportFile, Callable) :- % Non-module import xref_called(ImportFile, Callable), \+ ( xref_defined(ImportFile, Callable, How), How \= imported(_) ), % see also undefined/2 ( xref_defined(ImportFile, Callable, imported(ExportFile)) ; defined(ExportFile, Callable), \+ xref_module(ExportFile, _) ; Callable = _:_, defined(ExportFile, Callable) ; Callable = M:G, defined(ExportFile, G), xref_module(ExportFile, M) ). /******************************* * FILTER * *******************************/ :- pce_begin_class(xref_filter_dialog, dialog, "Show filter options"). class_variable(border, size, size(0,0)). initialise(D) :-> send_super(D, initialise), send(D, hor_stretch, 100), send(D, hor_shrink, 100), send(D, name, filter_dialog), send(D, append, xref_file_filter_item(filter_on_filename)). resize(D) :-> send(D, layout, D?visible?size). :- pce_end_class(xref_filter_dialog). :- pce_begin_class(xref_file_filter_item, text_item, "Filter files as you type"). typed(FFI, Id) :-> "Activate filter":: send_super(FFI, typed, Id), get(FFI, displayed_value, Current), get(FFI?frame, browser, files, Tree), ( send(Current, equal, '') -> send(Tree, filter_file_name, @nil) ; ( text_to_regex(Current, Filter) -> send(Tree, filter_file_name, Filter) ; send(FFI, report, status, 'Incomplete expression') ) ). %! text_to_regex(+Pattern, -Regex) is semidet. % % Convert text to a regular expression. Fail if the text % does not represent a valid regular expression. text_to_regex(Pattern, Regex) :- send(@pce, last_error, @nil), new(Regex, regex(Pattern)), ignore(pce_catch_error(_, send(Regex, search, ''))), get(@pce, last_error, @nil). :- pce_end_class(xref_file_filter_item). /******************************* * FILE TREE * *******************************/ :- pce_begin_class(xref_file_tree, toc_window, "Show loaded files as a tree"). :- use_class_template(arm). initialise(Tree) :-> send_super(Tree, initialise), send(Tree, clear), listen(Tree, xref_refresh_file(File), send(Tree, refresh_file, File)). unlink(Tree) :-> unlisten(Tree), send_super(Tree, unlink). refresh_file(Tree, File:name) :-> "Update given file":: ( get(Tree, node, File, Node) -> send(Node, set_flags) ; true ). collapse_node(_, _:any) :-> true. expand_node(_, _:any) :-> true. update(FL) :-> get(FL, expanded_ids, Chain), send(FL, clear), send(FL, report, progress, 'Building source tree ...'), send(FL, append_all_sourcefiles), send(FL, expand_ids, Chain), send(@display, synchronise), send(FL, report, progress, 'Flagging files ...'), send(FL, set_flags), send(FL, report, done). append_all_sourcefiles(FL) :-> "Append all files loaded into Prolog":: forall(source_file(File), send(FL, append, File)), send(FL, sort). clear(Tree) :-> "Remove all nodes, recreate the toplevel":: send_super(Tree, clear), send(Tree, root, new(Root, toc_folder(project, project))), forall(top_node(Name, Class), ( New =.. [Class, Name, Name], send(Tree, son, project, New))), send(Root, for_all, message(@arg1, collapsed, @off)). append(Tree, File:name) :-> "Add Prolog source file":: send(Tree, append_node, new(prolog_file_node(File))). append_node(Tree, Node:toc_node) :-> "Append a given node to the tree":: get(Node, parent_id, ParentId), ( get(Tree, node, ParentId, Parent) -> true ; send(Tree, append_node, new(Parent, prolog_directory_node(ParentId))) ), send(Parent, son, Node). sort(Tree) :-> forall(top_node(Name, _), ( get(Tree, node, Name, Node), send(Node, sort_sons, ?(@arg1, compare, @arg2)), send(Node?sons, for_all, message(@arg1, sort)) )). select_node(Tree, File:name) :-> "User selected a node":: ( exists_file(File) -> send(Tree?frame, file_info, File) ; true ). set_flags(Tree) :-> "Set alert-flags on all nodes":: forall(top_node(Name, _), ( get(Tree, node, Name, Node), ( send(Node, instance_of, prolog_directory_node) -> send(Node, set_flags) ; send(Node?sons, for_all, message(@arg1, set_flags)) ) )). top_node('.', prolog_directory_node). top_node('alias', toc_folder). top_node('/', prolog_directory_node). :- pce_group(filter). filter_file_name(Tree, Regex:regex*) :-> "Only show files that match Regex":: ( Regex == @nil -> send(Tree, filter_files, @nil) ; send(Tree, filter_files, message(Regex, search, @arg1?base_name)) ). filter_files(Tree, Filter:code*) :-> "Highlight files that match Filter":: send(Tree, collapse_all), send(Tree, selection, @nil), ( Filter == @nil -> send(Tree, expand_id, '.'), send(Tree, expand_id, project) ; new(Count, number(0)), get(Tree?tree, root, Root), send(Root, for_all, if(and(message(@arg1, instance_of, prolog_file_node), message(Filter, forward, @arg1)), and(message(Tree, show_node_path, @arg1), message(Count, plus, 1)))), send(Tree, report, status, 'Filter on file name: %d hits', Count) ), send(Tree, scroll_to, point(0,0)). show_node_path(Tree, Node:node) :-> "Select Node and make sure all parents are expanded":: send(Node, selected, @on), send(Tree, expand_parents, Node). expand_parents(Tree, Node:node) :-> ( get(Node, collapsed, @nil) -> true ; send(Node, collapsed, @off) ), send(Node?parents, for_all, message(Tree, expand_parents, @arg1)). collapse_all(Tree) :-> "Collapse all nodes":: get(Tree?tree, root, Root), send(Root, for_all, if(@arg1?collapsed == @off, message(@arg1, collapsed, @on))). :- pce_end_class(xref_file_tree). :- pce_begin_class(prolog_directory_node, toc_folder, "Represent a directory"). variable(flags, name*, get, "Warning status"). initialise(DN, Dir:name, Label:[name]) :-> "Create a directory node":: ( Label \== @default -> Name = Label ; file_alias_path(Name, Dir) -> true ; file_base_name(Dir, Name) ), send_super(DN, initialise, xref_directory_text(Dir, Name), Dir). parent_id(FN, ParentId:name) :<- "Get id for the parent":: get(FN, identifier, Path), ( file_alias_path(_, Path) -> ParentId = alias ; file_directory_name(Path, ParentId) ). sort(DN) :-> "Sort my sons":: send(DN, sort_sons, ?(@arg1, compare, @arg2)), send(DN?sons, for_all, message(@arg1, sort)). compare(DN, Node:toc_node, Diff:{smaller,equal,larger}) :<- "Compare for sorting children":: ( send(Node, instance_of, prolog_file_node) -> Diff = smaller ; get(DN, label, L1), get(Node, label, L2), get(L1, compare, L2, Diff) ). set_flags(DN) :-> "Set alert images":: send(DN?sons, for_all, message(@arg1, set_flags)), ( get(DN?sons, find, @arg1?flags \== ok, _Node) -> send(DN, collapsed_image, @xref_alert_closedir), send(DN, expanded_image, @xref_alert_opendir), send(DN, slot, flags, alert) ; send(DN, collapsed_image, @xref_ok_closedir), send(DN, expanded_image, @xref_ok_opendir), send(DN, slot, flags, ok) ), send(@display, synchronise). :- pce_end_class(prolog_directory_node). :- pce_begin_class(prolog_file_node, toc_file, "Represent a file"). variable(flags, name*, get, "Warning status"). variable(base_name, name, get, "Base-name of file"). initialise(FN, File:name) :-> "Create from a file":: absolute_file_name(File, Path), send_super(FN, initialise, new(T, xref_file_text(Path)), Path), file_base_name(File, Base), send(FN, slot, base_name, Base), send(T, default_action, info). basename(FN, BaseName:name) :<- "Get basename of the file for sorting":: get(FN, identifier, File), file_base_name(File, BaseName). parent_id(FN, ParentId:name) :<- "Get id for the parent":: get(FN, identifier, Path), file_directory_name(Path, Dir), ( file_alias_path('.', Dir) -> ParentId = '.' ; ParentId = Dir ). sort(_) :-> true. compare(FN, Node:toc_node, Diff:{smaller,equal,larger}) :<- "Compare for sorting children":: ( send(Node, instance_of, prolog_directory_node) -> Diff = larger ; get(FN, basename, L1), get(Node, basename, L2), get(L1, compare, L2, Diff) ). set_flags(FN) :-> "Set alert images":: get(FN, identifier, File), ( file_warnings(File, _) -> send(FN, image, @xref_alert_file), send(FN, slot, flags, alert) ; send(FN, image, @xref_ok_file), send(FN, slot, flags, ok) ), send(@display, synchronise). :- pce_global(@xref_ok_file, make_xref_image([ image('16x16/doc.xpm'), image('16x16/ok.xpm') ])). :- pce_global(@xref_alert_file, make_xref_image([ image('16x16/doc.xpm'), image('16x16/alert.xpm') ])). :- pce_global(@xref_ok_opendir, make_xref_image([ image('16x16/opendir.xpm'), image('16x16/ok.xpm') ])). :- pce_global(@xref_alert_opendir, make_xref_image([ image('16x16/opendir.xpm'), image('16x16/alert.xpm') ])). :- pce_global(@xref_ok_closedir, make_xref_image([ image('16x16/closedir.xpm'), image('16x16/ok.xpm') ])). :- pce_global(@xref_alert_closedir, make_xref_image([ image('16x16/closedir.xpm'), image('16x16/alert.xpm') ])). make_xref_image([First|More], Image) :- new(Image, image(@nil, 0, 0, pixmap)), send(Image, copy, First), forall(member(I2, More), send(Image, draw_in, bitmap(I2))). :- pce_end_class(prolog_file_node). /******************************* * FILE INFO * *******************************/ :- pce_begin_class(prolog_file_info, window, "Show information on File"). :- use_class_template(arm). variable(tabular, tabular, get, "Displayed table"). variable(prolog_file, name*, get, "Displayed Prolog file"). initialise(W, File:[name]*) :-> send_super(W, initialise), send(W, pen, 0), send(W, scrollbars, vertical), send(W, display, new(T, tabular)), send(T, rules, all), send(T, cell_spacing, -1), send(W, slot, tabular, T), ( atom(File) -> send(W, prolog_file, File) ; true ). resize(W) :-> send_super(W, resize), get(W?visible, width, Width), send(W?tabular, table_width, Width-3). file(V, File0:name*) :-> "Set vizualized file":: ( File0 == @nil -> File = File0 ; absolute_file_name(File0, File) ), ( get(V, prolog_file, File) -> true ; send(V, slot, prolog_file, File), send(V, update) ). clear(W) :-> send(W?tabular, clear). update(V) :-> "Show information on the current file":: send(V, clear), send(V, scroll_to, point(0,0)), ( get(V, prolog_file, File), File \== @nil -> send(V?frame, xref_file, File), % Make sure data is up-to-date send(V, show_info) ; true ). module(W, Module:name) :<- "Module associated with this file":: get(W, prolog_file, File), ( xref_module(File, Module) -> true ; Module = user % TBD: does not need to be true! ). :- pce_group(info). show_info(W) :-> get(W, tabular, T), BG = (background := khaki1), get(W, prolog_file, File), new(FG, xref_file_text(File)), send(FG, font, huge), send(T, append, FG, halign := center, colspan := 2, BG), send(T, next_row), send(W, show_module), send(W, show_modified), send(W, show_undefined), send(W, show_not_called), send(W, show_exports), send(W, show_imports), true. show_module(W) :-> "Show basic module info":: get(W, prolog_file, File), get(W, tabular, T), ( xref_module(File, Module) -> send(T, append, 'Module:', bold, right), send(T, append, Module), send(T, next_row) ; true ). show_modified(W) :-> get(W, prolog_file, File), get(W, tabular, T), time_file(File, Stamp), format_time(string(Modified), '%+', Stamp), send(T, append, 'Modified:', bold, right), send(T, append, Modified), send(T, next_row). show_exports(W) :-> get(W, prolog_file, File), ( xref_module(File, Module), findall(E, xref_exported(File, E), Exports), Exports \== [] -> send(W, show_export_header, export, imported_by), sort_callables(Exports, Sorted), forall(member(Callable, Sorted), send(W, show_module_export, File, Module, Callable)) ; true ), ( findall(C-Fs, ( setof(F, export_link_1(File, F, C), Fs), \+ xref_exported(File, C)), Pairs0), Pairs0 \== [] -> send(W, show_export_header, defined, used_by), keysort(Pairs0, Pairs), % TBD forall(member(Callable-ImportFiles, Pairs), send(W, show_file_export, Callable, ImportFiles)) ; true ). show_export_header(W, Left:name, Right:name) :-> get(W, tabular, T), BG = (background := khaki1), send(T, append, Left?label_name, bold, center, BG), send(T, append, Right?label_name, bold, center, BG), send(T, next_row). show_module_export(W, File:name, Module:name, Callable:prolog) :-> get(W, prolog_file, File), get(W, tabular, T), send(T, append, xref_predicate_text(Module:Callable, @default, File)), findall(In, exported_to(File, Callable, In), InL), send(T, append, new(XL, xref_graphical_list)), ( InL == [] -> true ; sort_files(InL, Sorted), forall(member(F, Sorted), send(XL, append, xref_imported_by(F, Callable))) ), send(T, next_row). show_file_export(W, Callable:prolog, ImportFiles:prolog) :-> get(W, prolog_file, File), get(W, tabular, T), send(T, append, xref_predicate_text(Callable, @default, File)), send(T, append, new(XL, xref_graphical_list)), sort_files(ImportFiles, Sorted), qualify_from_file(Callable, File, QCall), forall(member(F, Sorted), send(XL, append, xref_imported_by(F, QCall))), send(T, next_row). qualify_from_file(Callable, _, Callable) :- Callable = _:_, !. qualify_from_file(Callable, File, M:Callable) :- xref_module(File, M), !. qualify_from_file(Callable, _, Callable). %! exported_to(+ExportFile, +Callable, -ImportFile) % % ImportFile imports Callable from ExportFile. The second clause % deals with auto-import. % % TBD: Make sure the autoload library is loaded before we begin. exported_to(ExportFile, Callable, ImportFile) :- xref_defined(ImportFile, Callable, imported(ExportFile)), atom(ImportFile). % avoid XPCE buffers. exported_to(ExportFile, Callable, ImportFile) :- '$autoload':library_index(Callable, _, ExportFileNoExt), file_name_extension(ExportFileNoExt, _, ExportFile), xref_called(ImportFile, Callable), atom(ImportFile), \+ xref_defined(ImportFile, Callable, _). show_imports(W) :-> "Show predicates we import":: get(W, prolog_file, File), findall(E-Cs, setof(C, export_link_1(E, File, C), Cs), Pairs), ( Pairs \== [] -> sort(Pairs, Sorted), % TBD: use sort_files/2 ( xref_module(File, _) -> send(W, show_export_header, from, imports) ; send(W, show_export_header, from, uses) ), forall(member(E-Cs, Sorted), send(W, show_import, E, Cs)) ; true ). show_import(W, File:name, Callables:prolog) :-> "Show imports from file":: get(W, tabular, T), send(T, append, xref_file_text(File)), send(T, append, new(XL, xref_graphical_list)), sort_callables(Callables, Sorted), forall(member(C, Sorted), send(XL, append, xref_predicate_text(C, @default, File))), send(T, next_row). show_undefined(W) :-> "Add underfined predicates to table":: get(W, prolog_file, File), findall(Undef, undefined(File, Undef), UndefList), ( UndefList == [] -> true ; BG = (background := khaki1), get(W, tabular, T), ( setting(warn_autoload, true) -> Label = 'Undefined/autoload' ; Label = 'Undefined' ), send(T, append, Label, bold, center, BG), send(T, append, 'Called by', bold, center, BG), send(T, next_row), sort_callables(UndefList, Sorted), forall(member(Callable, Sorted), send(W, show_undef, Callable)) ). show_undef(W, Callable:prolog) :-> "Show undefined predicate":: get(W, prolog_file, File), get(W, module, Module), get(W, tabular, T), send(T, append, xref_predicate_text(Module:Callable, undefined, File)), send(T, append, new(L, xref_graphical_list)), findall(By, xref_called(File, Callable, By), By), sort_callables(By, Sorted), forall(member(P, Sorted), send(L, append, xref_predicate_text(Module:P, called_by, File))), send(T, next_row). show_not_called(W) :-> "Show predicates that are not called":: get(W, prolog_file, File), findall(NotCalled, not_called(File, NotCalled), NotCalledList), ( NotCalledList == [] -> true ; BG = (background := khaki1), get(W, tabular, T), send(T, append, 'Not called', bold, center, colspan := 2, BG), send(T, next_row), sort_callables(NotCalledList, Sorted), forall(member(Callable, Sorted), send(W, show_not_called_pred, Callable)) ). show_not_called_pred(W, Callable:prolog) :-> "Show a not-called predicate":: get(W, prolog_file, File), get(W, module, Module), get(W, tabular, T), send(T, append, xref_predicate_text(Module:Callable, not_called, File), colspan := 2), send(T, next_row). :- pce_end_class(prolog_file_info). :- pce_begin_class(xref_predicate_text, text, "Text representing a predicate"). class_variable(colour, colour, dark_green). variable(callable, prolog, get, "Predicate indicator"). variable(classification, [name], get, "Classification of the predicate"). variable(file, name*, get, "File of predicate"). initialise(T, Callable0:prolog, Class:[{undefined,called_by,not_called}], File:[name]) :-> "Create from callable or predicate indicator":: single_qualify(Callable0, Callable), send(T, slot, callable, Callable), callable_to_label(Callable, File, Label), send_super(T, initialise, Label), ( File \== @default -> send(T, slot, file, File) ; true ), send(T, classification, Class). %! single_qualify(+Term, -Qualified) % % Strip redundant M: from the term, leaving at most one qualifier. single_qualify(_:Q0, Q) :- is_qualified(Q0), !, single_qualify(Q0, Q). single_qualify(Q, Q). is_qualified(M:_) :- atom(M). pi(IT, PI:prolog) :<- "Get predicate as predicate indicator (Name/Arity)":: get(IT, callable, Callable), to_predicate_indicator(Callable, PI). classification(T, Class:[name]) :-> send(T, slot, classification, Class), ( Class == undefined -> get(T, callable, Callable), strip_module(Callable, _, Plain), ( autoload_predicate(Plain) -> send(T, colour, navy_blue), send(T, slot, classification, autoload) ; global_predicate(Plain) -> send(T, colour, navy_blue), send(T, slot, classification, global) ; send(T, colour, red) ) ; Class == not_called -> send(T, colour, red) ; true ). :- pce_global(@xref_predicate_text_recogniser, new(handler_group(@arm_recogniser, click_gesture(left, '', single, message(@receiver, edit))))). event(T, Ev:event) :-> ( send_super(T, event, Ev) -> true ; send(@xref_predicate_text_recogniser, event, Ev) ). arm(TF, Val:bool) :-> "Preview activiity":: ( Val == @on -> send(TF, underline, @on), ( get(TF, classification, Class), Class \== @default -> send(TF, report, status, '%s predicate %s', Class?capitalise, TF?string) ; send(TF, report, status, 'Predicate %s', TF?string) ) ; send(TF, underline, @off), send(TF, report, status, '') ). edit(T) :-> get(T, file, File), get(T, callable, Callable), edit_callable(Callable, File). :- pce_end_class(xref_predicate_text). :- pce_begin_class(xref_file_text, text, "Represent a file-name"). variable(path, name, get, "Filename represented"). variable(default_action, name := edit, both, "Default on click"). initialise(TF, File:name) :-> absolute_file_name(File, Path), file_name_on_path(Path, ShortId), short_file_name_to_atom(ShortId, Label), send_super(TF, initialise, Label), send(TF, name, Path), send(TF, slot, path, Path). :- pce_global(@xref_file_text_recogniser, make_xref_file_text_recogniser). make_xref_file_text_recogniser(G) :- new(C, click_gesture(left, '', single, message(@receiver, run_default_action))), new(P, popup_gesture(@arg1?popup)), new(D, drag_and_drop_gesture(left)), send(D, cursor, @default), new(G, handler_group(C, D, P, @arm_recogniser)). popup(_, Popup:popup) :<- new(Popup, popup), send_list(Popup, append, [ menu_item(edit, message(@arg1, edit)), menu_item(info, message(@arg1, info)), menu_item(header, message(@arg1, header)) ]). event(T, Ev:event) :-> ( send_super(T, event, Ev) -> true ; send(@xref_file_text_recogniser, event, Ev) ). arm(TF, Val:bool) :-> "Preview activity":: ( Val == @on -> send(TF, underline, @on), send(TF, report, status, 'File %s', TF?path) ; send(TF, underline, @off), send(TF, report, status, '') ). run_default_action(T) :-> get(T, default_action, Def), send(T, Def). edit(T) :-> get(T, path, Path), edit(file(Path)). info(T) :-> get(T, path, Path), send(T?frame, file_info, Path). header(T) :-> get(T, path, Path), send(T?frame, file_header, Path). prolog_source(T, Src:string) :<- "Import declarations":: get(T, path, File), new(V, xref_view), send(V, file_header, File), get(V?text_buffer, contents, Src), send(V, destroy). :- pce_end_class(xref_file_text). :- pce_begin_class(xref_directory_text, text, "Represent a directory-name"). variable(path, name, get, "Filename represented"). initialise(TF, Dir:name, Label:[name]) :-> absolute_file_name(Dir, Path), ( Label == @default -> file_base_name(Path, TheLabel) ; TheLabel = Label ), send_super(TF, initialise, TheLabel), send(TF, slot, path, Path). files(DT, Files:chain) :<- "List of files that belong to this directory":: new(Files, chain), get(DT, path, Path), ( source_file(File), sub_atom(File, 0, _, _, Path), send(Files, append, File), fail ; true ). :- pce_global(@xref_directory_text_recogniser, make_xref_directory_text_recogniser). make_xref_directory_text_recogniser(G) :- new(D, drag_and_drop_gesture(left)), send(D, cursor, @default), new(G, handler_group(D, @arm_recogniser)). event(T, Ev:event) :-> ( send_super(T, event, Ev) -> true ; send(@xref_directory_text_recogniser, event, Ev) ). arm(TF, Val:bool) :-> "Preview activiity":: ( Val == @on -> send(TF, underline, @on), send(TF, report, status, 'Directory %s', TF?path) ; send(TF, underline, @off), send(TF, report, status, '') ). :- pce_end_class(xref_directory_text). :- pce_begin_class(xref_imported_by, figure, "Indicate import of callable into file"). variable(callable, prolog, get, "Callable term of imported predicate"). :- pce_global(@xref_horizontal_format, make_xref_horizontal_format). make_xref_horizontal_format(F) :- new(F, format(vertical, 1, @on)), send(F, row_sep, 3), send(F, column_sep, 0). initialise(IT, File:name, Imported:prolog) :-> send_super(IT, initialise), send(IT, format, @xref_horizontal_format), send(IT, display, new(F, xref_file_text(File))), send(F, name, file_text), send(IT, slot, callable, Imported), send(IT, show_called_by). path(IT, Path:name) :<- "Represented file":: get(IT, member, file_text, Text), get(Text, path, Path). show_called_by(IT) :-> "Add number indicating calls":: get(IT, called_by, List), length(List, N), send(IT, display, new(T, text(string('(%d)', N)))), send(T, name, called_count), ( N > 0 -> send(T, underline, @on), send(T, colour, blue), send(T, recogniser, @xref_called_by_recogniser) ; send(T, colour, grey60) ). called_by(IT, ByList:prolog) :<- "Return list of callables satisfied by the import":: get(IT, path, Source), get(IT, callable, Callable), findall(By, used_in(Source, Callable, By), ByList). %! used_in(+Source, +QCallable, -CalledBy) % % Determine which the callers for QCallable in Source. QCallable % is qualified with the module of the exporting file (if any). used_in(Source, M:Callable, By) :- % we are the same module xref_module(Source, M), !, xref_called(Source, Callable, By). used_in(Source, _:Callable, By) :- % we imported xref_defined(Source, Callable, imported(_)), !, xref_called(Source, Callable, By). used_in(Source, Callable, By) :- xref_called(Source, Callable, By). used_in(Source, Callable, '') :- xref_exported(Source, Callable). :- pce_group(event). :- pce_global(@xref_called_by_recogniser, new(popup_gesture(@receiver?device?called_by_popup, left))). called_by_popup(IT, P:popup) :<- "Show called where import is called":: new(P, popup(called_by, message(IT, edit_called_by, @arg1))), get(IT, called_by, ByList), sort_callables(ByList, Sorted), forall(member(C, Sorted), ( callable_to_label(C, Label), send(P, append, menu_item(prolog(C), @default, Label)))). edit_called_by(IT, Called:prolog) :-> "Edit file on the predicate Called":: get(IT, path, Source), edit_callable(Called, Source). :- pce_end_class(xref_imported_by). :- pce_begin_class(xref_graphical_list, figure, "Show list of exports to files"). variable(wrap, {extend,wrap,wrap_fixed_width,clip} := extend, get, "Wrapping mode"). initialise(XL) :-> send_super(XL, initialise), send(XL, margin, 500, wrap). append(XL, I:graphical) :-> ( send(XL?graphicals, empty) -> true ; send(XL, display, text(', ')) ), send(XL, display, I). :- pce_group(layout). :- pce_global(@xref_graphical_list_format, make_xref_graphical_list_format). make_xref_graphical_list_format(F) :- new(F, format(horizontal, 500, @off)), send(F, column_sep, 0), send(F, row_sep, 0). margin(T, Width:int*, How:[{wrap,wrap_fixed_width,clip}]) :-> "Wrap items to indicated width":: ( Width == @nil -> send(T, slot, wrap, extend), send(T, format, @rdf_composite_format) ; send(T, slot, wrap, How), How == wrap -> FmtWidth is max(10, Width), new(F, format(horizontal, FmtWidth, @off)), send(F, column_sep, 0), send(F, row_sep, 0), send(T, format, F) ; throw(tbd) ). :- pce_end_class(xref_graphical_list). /******************************* * PREDICATES * *******************************/ :- pce_begin_class(xref_predicate_browser, browser, "Show loaded files"). initialise(PL) :-> send_super(PL, initialise), send(PL, popup, new(P, popup)), send_list(P, append, [ menu_item(edit, message(@arg1, edit)) ]). update(PL) :-> send(PL, clear), forall((defined(File, Callable), atom(File), \+ library_file(File)), send(PL, append, Callable, @default, File)), forall((xref_current_source(File), atom(File), \+library_file(File)), forall(undefined(File, Callable), send(PL, append, Callable, undefined, File))), send(PL, sort). append(PL, Callable:prolog, Class:[name], File:[name]) :-> send_super(PL, append, xref_predicate_dict_item(Callable, Class, File)). :- pce_end_class(xref_predicate_browser). :- pce_begin_class(xref_predicate_dict_item, dict_item, "Represent a Prolog predicate"). variable(callable, prolog, get, "Callable term"). variable(file, name*, get, "Origin file"). initialise(PI, Callable0:prolog, _Class:[name], File:[name]) :-> "Create from callable, class and file":: single_qualify(Callable0, Callable), send(PI, slot, callable, Callable), callable_to_label(Callable, Label), send_super(PI, initialise, Label), ( File \== @default -> send(PI, slot, file, File) ; true ). edit(PI) :-> "Edit Associated prediate":: get(PI, file, File), get(PI, callable, Callable), edit_callable(Callable, File). :- pce_end_class(xref_predicate_dict_item). /******************************* * UTIL CLASSES * *******************************/ :- pce_begin_class(xref_view, view, "View with additional facilities for formatting"). initialise(V) :-> send_super(V, initialise), send(V, font, fixed). update(_) :-> true. % or ->clear? ->destroy? file_header(View, File:name) :-> "Create import/export fileheader for File":: ( xref_module(File, _) -> Decls = Imports ; xref_file_exports(File, Export), Decls = [Export|Imports] ), xref_file_imports(File, Imports), send(View, clear), send(View, declarations, Decls), ( ( nonvar(Export) -> send(View, report, status, 'Created module header for non-module file %s', File) ; send(View, report, status, 'Created import header for module file %s', File) ) -> true ; true ). declarations(V, Decls:prolog) :-> pce_open(V, append, Out), call_cleanup(print_decls(Decls, Out), close(Out)). print_decls([], _) :- !. print_decls([H|T], Out) :- !, print_decls(H, Out), print_decls(T, Out). print_decls(Term, Out) :- portray_clause(Out, Term). :- pce_end_class(xref_view). /******************************* * FILE-NAME LOGIC * *******************************/ %! short_file_name_to_atom(+ShortId, -Atom) % % Convert a short filename into an atom short_file_name_to_atom(Atom, Atom) :- atomic(Atom), !. short_file_name_to_atom(Term, Atom) :- term_to_atom(Term, Atom). %! library_file(+Path) % % True if Path comes from the Prolog tree and must be considered a % library. library_file(Path) :- current_prolog_flag(home, Home), sub_atom(Path, 0, _, _, Home). %! profile_file(+Path) % % True if path is a personalisation file. This is a bit hairy. profile_file(Path) :- file_name_on_path(Path, user_profile(File)), known_profile_file(File). known_profile_file('.swiplrc'). known_profile_file('swipl.ini'). known_profile_file('.pceemacsrc'). known_profile_file(File) :- sub_atom(File, 0, _, _, 'lib/xpce/emacs'). %! sort_files(+Files, -Sorted) % % Sort files, keeping groups comming from the same alias together. sort_files(Files0, Sorted) :- sort(Files0, Files), % remove duplicates maplist(key_file, Files, Keyed), keysort(Keyed, KSorted), unkey(KSorted, Sorted). key_file(File, Key-File) :- file_name_on_path(File, Key). /******************************* * PREDICATES * *******************************/ %! available(+File, +Callable, -HowDefined) % % True if Callable is available in File. available(File, Called, How) :- xref_defined(File, Called, How0), !, How = How0. available(_, Called, How) :- built_in_predicate(Called), !, How = builtin. available(_, Called, How) :- setting(warn_autoload, false), autoload_predicate(Called), !, How = autoload. available(_, Called, How) :- setting(warn_autoload, false), global_predicate(Called), !, How = global. available(_, Called, How) :- Called = _:_, defined(_, Called), !, How = module_qualified. available(_, M:G, How) :- defined(ExportFile, G), xref_module(ExportFile, M), !, How = module_overruled. available(_, Called, How) :- defined(ExportFile, Called), \+ xref_module(ExportFile, _), !, How == plain_file. %! built_in_predicate(+Callable) % % True if Callable is a built-in built_in_predicate(Goal) :- strip_module(Goal, _, Plain), xref_built_in(Plain). %! autoload_predicate(+Callable) is semidet. %! autoload_predicate(+Callable, -File) is semidet. % % True if Callable can be autoloaded. TBD: make sure the autoload % index is up-to-date. autoload_predicate(Goal) :- '$autoload':library_index(Goal, _, _). autoload_predicate(Goal, File) :- '$autoload':library_index(Goal, _, FileNoExt), file_name_extension(FileNoExt, pl, File). %! global_predicate(+Callable) % % True if Callable can be auto-imported from the global user % module. global_predicate(Goal) :- predicate_property(user:Goal, _), !. %! to_predicate_indicator(+Term, -PI) % % Convert to a predicate indicator. to_predicate_indicator(PI, PI) :- is_predicate_indicator(PI), !. to_predicate_indicator(Callable, PI) :- callable(Callable), predicate_indicator(Callable, PI). %! is_predicate_indicator(+PI) is semidet. % % True if PI is a predicate indicator. is_predicate_indicator(Name/Arity) :- atom(Name), integer(Arity). is_predicate_indicator(Module:Name/Arity) :- atom(Module), atom(Name), integer(Arity). %! predicate_indicator(+Callable, -Name) % % Generate a human-readable predicate indicator predicate_indicator(Module:Goal, PI) :- atom(Module), !, predicate_indicator(Goal, PI0), ( hidden_module(Module) -> PI = PI0 ; PI = Module:PI0 ). predicate_indicator(Goal, Name/Arity) :- callable(Goal), !, functor(Goal, Name, Arity). predicate_indicator(Goal, Goal). hidden_module(user) :- !. hidden_module(system) :- !. hidden_module(M) :- sub_atom(M, 0, _, _, $). %! sort_callables(+List, -Sorted) % % Sort list of callable terms. sort_callables(Callables, Sorted) :- key_callables(Callables, Tagged), keysort(Tagged, KeySorted), unkey(KeySorted, SortedList), ord_list_to_set(SortedList, Sorted). key_callables([], []). key_callables([H0|T0], [Key-H0|T]) :- key_callable(H0, Key), key_callables(T0, T). key_callable(Callable, k(Name, Arity, Module)) :- predicate_indicator(Callable, PI), ( PI = Name/Arity -> Module = user ; PI = Module:Name/Arity ). unkey([], []). unkey([_-H|T0], [H|T]) :- unkey(T0, T). %! ord_list_to_set(+OrdList, -OrdSet) % % Removed duplicates (after unification) from an ordered list, % creating a set. ord_list_to_set([], []). ord_list_to_set([H|T0], [H|T]) :- ord_remove_same(H, T0, T1), ord_list_to_set(T1, T). ord_remove_same(H, [H|T0], T) :- !, ord_remove_same(H, T0, T). ord_remove_same(_, L, L). %! callable_to_label(+Callable, +File, -Label:atom) is det. %! callable_to_label(+Callable, -Label:atom) is det. % % Label is a textual label representing Callable in File. callable_to_label(Callable, Label) :- callable_to_label(Callable, @nil, Label). callable_to_label(pce_principal:send_implementation(Id,_,_), _, Id) :- atom(Id), !. callable_to_label(pce_principal:get_implementation(Id,_,_,_), _, Id) :- atom(Id), !. callable_to_label('', _, '') :- !. callable_to_label(''(Line), _, Label) :- !, atom_concat('@', Line, Label). callable_to_label(_:''(Line), _, Label) :- !, atom_concat('@', Line, Label). callable_to_label(Callable, File, Label) :- to_predicate_indicator(Callable, PI0), ( PI0 = M:PI1 -> ( atom(File), xref_module(File, M) -> PI = PI1 ; PI = PI0 ) ; PI = PI0 ), term_to_atom(PI, Label). %! edit_callable(+Callable, +File) edit_callable('', File) :- !, edit(file(File)). edit_callable(Callable, File) :- local_callable(Callable, File, Local), ( xref_defined(File, Local, How), xref_definition_line(How, Line) -> edit(file(File, line(Line))) ; autoload_predicate(Local) -> functor(Local, Name, Arity), edit(Name/Arity) ). edit_callable(pce_principal:send_implementation(Id,_,_), _) :- atom(Id), atomic_list_concat([Class,Method], ->, Id), !, edit(send(Class, Method)). edit_callable(pce_principal:get_implementation(Id,_,_,_), _) :- atom(Id), atomic_list_concat([Class,Method], <-, Id), !, edit(get(Class, Method)). edit_callable(''(Line), File) :- File \== @nil, !, edit(file(File, line(Line))). edit_callable(_:''(Line), File) :- File \== @nil, !, edit(file(File, line(Line))). edit_callable(Callable, _) :- to_predicate_indicator(Callable, PI), edit(PI). local_callable(M:Callable, File, Callable) :- xref_module(File, M), !. local_callable(Callable, _, Callable). /******************************* * WARNINGS * *******************************/ %! file_warnings(+File:atom, -Warnings:list(atom)) % % Unify Warnings with a list of dubious things found in File. % Intended to create icons. Fails if the file is totally ok. file_warnings(File, Warnings) :- setof(W, file_warning(File, W), Warnings). file_warning(File, undefined) :- undefined(File, _) -> true. file_warning(File, not_called) :- setting(warn_not_called, true), not_called(File, _) -> true. %! not_called(+File, -Callable) % % Callable is a term defined in File, and for which no callers can % be found. not_called(File, NotCalled) :- % module version xref_module(File, Module), !, defined(File, NotCalled), \+ ( xref_called(File, NotCalled) ; xref_exported(File, NotCalled) ; xref_hook(NotCalled) ; xref_hook(Module:NotCalled) ; NotCalled = _:Goal, xref_hook(Goal) ; xref_called(_, Module:NotCalled) ; NotCalled = _:_, xref_called(_, NotCalled) ; NotCalled = M:G, xref_called(ModFile, G), xref_module(ModFile, M) ; generated_callable(Module:NotCalled) ). not_called(File, NotCalled) :- % non-module version defined(File, NotCalled), \+ ( xref_called(ImportFile, NotCalled), \+ xref_module(ImportFile, _) ; NotCalled = _:_, xref_called(_, NotCalled) ; NotCalled = M:G, xref_called(ModFile, G), xref_module(ModFile, M) ; xref_called(AutoImportFile, NotCalled), \+ defined(AutoImportFile, NotCalled), global_predicate(NotCalled) ; xref_hook(NotCalled) ; xref_hook(user:NotCalled) ; generated_callable(user:NotCalled) ). generated_callable(M:Term) :- functor(Term, Name, Arity), prolog:generated_predicate(M:Name/Arity). %! xref_called(?Source, ?Callable) is nondet. % % True if Callable is called in Source, after removing recursive % calls and calls made to predicates where the condition says that % the predicate should not exist. xref_called(Source, Callable) :- xref_called_cond(Source, Callable, _). xref_called_cond(Source, Callable, Cond) :- xref_called(Source, Callable, By, Cond), By \= Callable. % recursive calls %! defined(?File, ?Callable) % % True if Callable is defined in File and not imported. defined(File, Callable) :- xref_defined(File, Callable, How), atom(File), How \= imported(_), How \= (multifile). %! undefined(+File, -Callable) % % Callable is called in File, but no definition can be found. If % File is not a module file we consider other files that are not % module files. undefined(File, Undef) :- xref_module(File, _), !, xref_called_cond(File, Undef, Cond), \+ ( available(File, Undef, How), How \== plain_file ), included_if_defined(Cond, Undef). undefined(File, Undef) :- xref_called_cond(File, Undef, Cond), \+ available(File, Undef, _), included_if_defined(Cond, Undef). %! included_if_defined(+Condition, +Callable) is semidet. included_if_defined(true, _) :- !. included_if_defined(false, _) :- !, fail. included_if_defined(fail, _) :- !, fail. included_if_defined(current_predicate(Name/Arity), Callable) :- \+ functor(Callable, Name, Arity), !. included_if_defined(\+ Cond, Callable) :- !, \+ included_if_defined(Cond, Callable). included_if_defined((A,B), Callable) :- !, included_if_defined(A, Callable), included_if_defined(B, Callable). included_if_defined((A;B), Callable) :- !, ( included_if_defined(A, Callable) ; included_if_defined(B, Callable) ). /******************************* * IMPORT/EXPORT HEADERS * *******************************/ %! file_imports(+File, -Imports) % % Determine which modules must be imported into this one. It % considers all called predicates that are not covered by system % predicates. Next, we have three sources to resolve the remaining % predicates, which are tried in the order below. The latter two % is dubious. % % * Already existing imports % * Imports from other files in the project % * Imports from the (autoload) library % % We first resolve all imports to absolute files. Localizing is % done afterwards. Imports is a list of % %! use_module(FileSpec, Callables) xref_file_imports(FileSpec, Imports) :- canonical_filename(FileSpec, File), findall(Called, called_no_builtin(File, Called), Resolve0), resolve_old_imports(Resolve0, File, Resolve1, Imports0), find_new_imports(Resolve1, File, Imports1), disambiguate_imports(Imports1, File, Imports2), flatten([Imports0, Imports2], ImportList), keysort(ImportList, SortedByFile), merge_by_key(SortedByFile, ImportsByFile), maplist(make_import(File), ImportsByFile, Imports). canonical_filename(FileSpec, File) :- absolute_file_name(FileSpec, [ file_type(prolog), access(read), file_errors(fail) ], File). called_no_builtin(File, Callable) :- xref_called(File, Callable), \+ defined(File, Callable), \+ built_in_predicate(Callable). resolve_old_imports([], _, [], []). resolve_old_imports([H|T0], File, UnRes, [From-H|T]) :- xref_defined(File, H, imported(From)), !, resolve_old_imports(T0, File, UnRes, T). resolve_old_imports([H|T0], File, [H|UnRes], Imports) :- resolve_old_imports(T0, File, UnRes, Imports). find_new_imports([], _, []). find_new_imports([H|T0], File, [FL-H|T]) :- findall(F, resolve(H, F), FL0), sort(FL0, FL), find_new_imports(T0, File, T). disambiguate_imports(Imports0, File, Imports) :- ambiguous_imports(Imports0, Ambig, UnAmbig, _Undef), ( Ambig == [] -> Imports = UnAmbig ; new(D, xref_disambiguate_import_dialog(File, Ambig)), get(D, confirm_centered, Result), ( Result == ok -> get(D, result, List), send(D, destroy), append(UnAmbig, List, Imports) ) ). ambiguous_imports([], [], [], []). ambiguous_imports([[]-C|T0], Ambig, UnAmbig, [C|T]) :- !, ambiguous_imports(T0, Ambig, UnAmbig, T). ambiguous_imports([[F]-C|T0], Ambig, [F-C|T], Undef) :- !, ambiguous_imports(T0, Ambig, T, Undef). ambiguous_imports([A-C|T0], [A-C|T], UnAmbig, Undef) :- is_list(A), !, ambiguous_imports(T0, T, UnAmbig, Undef). %! resolve(+Callable, -File) % % Try to find files from which to resolve Callable. resolve(Callable, File) :- % Export from module files xref_exported(File, Callable), atom(File). resolve(Callable, File) :- % Non-module files defined(File, Callable), atom(File), \+ xref_module(File, _). resolve(Callable, File) :- % The Prolog autoload library autoload_predicate(Callable, File). %! merge_by_key(+KeyedList, -ListOfKeyValues) is det. % % Example: [a-x, a-y, b-z] --> [a-[x,y], b-[z]] merge_by_key([], []). merge_by_key([K-V|T0], [K-[V|Vs]|T]) :- same_key(K, T0, Vs, T1), merge_by_key(T1, T). same_key(K, [K-V|T0], [V|VT], T) :- !, same_key(K, T0, VT, T). same_key(_, L, [], L). %! make_import(+RefFile, +ImportList, -UseModules) % % Glues it all together to make a list of directives. make_import(RefFile, File-Imports, (:-use_module(ShortPath, PIs))) :- local_filename(File, RefFile, ShortPath), sort_callables(Imports, SortedImports), maplist(predicate_indicator, SortedImports, PIs). local_filename(File, RefFile, ShortPath) :- atom(RefFile), file_directory_name(File, Dir), file_directory_name(RefFile, Dir), % i.e. same dir !, file_base_name(File, Base), remove_extension(Base, ShortPath). local_filename(File, _RefFile, ShortPath) :- file_name_on_path(File, ShortPath0), remove_extension(ShortPath0, ShortPath). remove_extension(Term0, Term) :- Term0 =.. [Alias,ShortPath0], file_name_extension(ShortPath, pl, ShortPath0), !, Term =.. [Alias,ShortPath]. remove_extension(ShortPath0, ShortPath) :- atom(ShortPath0), file_name_extension(ShortPath, pl, ShortPath0), !. remove_extension(Path, Path). :- pce_begin_class(xref_disambiguate_import_dialog, auto_sized_dialog, "Prompt for alternative sources"). initialise(D, File:name, Ambig:prolog) :-> send_super(D, initialise, string('Disambiguate calls for %s', File)), forall(member(Files-Callable, Ambig), send(D, append_row, File, Callable, Files)), send(D, append, button(ok)), send(D, append, button(cancel)). append_row(D, File:name, Callable:prolog, Files:prolog) :-> send(D, append, xref_predicate_text(Callable, @default, File)), send(D, append, new(FM, menu(file, cycle)), right), send(FM, append, menu_item(@nil, @default, '-- Select --')), forall(member(Path, Files), ( file_name_on_path(Path, ShortId), short_file_name_to_atom(ShortId, Label), send(FM, append, menu_item(Path, @default, Label)) )). result(D, Disam:prolog) :<- "Get disambiguated files":: get_chain(D, graphicals, Grs), selected_files(Grs, Disam). selected_files([], []). selected_files([PreText,Menu|T0], [File-Callable|T]) :- send(PreText, instance_of, xref_predicate_text), send(Menu, instance_of, menu), get(Menu, selection, File), atom(File), !, get(PreText, callable, Callable), selected_files(T0, T). selected_files([_|T0], T) :- selected_files(T0, T). ok(D) :-> send(D, return, ok). cancel(D) :-> send(D, destroy). :- pce_end_class(xref_disambiguate_import_dialog). %! xref_file_exports(+File, -Exports) % % Produce the export-header for non-module files. Fails if the % file is already a module file. xref_file_exports(FileSpec, (:- module(Module, Exports))) :- canonical_filename(FileSpec, File), \+ xref_module(File, _), findall(C, export_link_1(File, _, C), Cs), sort_callables(Cs, Sorted), file_base_name(File, Base), file_name_extension(Module, _, Base), maplist(predicate_indicator, Sorted, Exports).