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