1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org/packages/xpce/
    6    Copyright (c)  2003-2019, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(pce_profile,
   37          [ pce_show_profile/0
   38          ]).   39:- use_module(library(pce)).   40:- use_module(library(lists)).   41:- use_module(library(persistent_frame)).   42:- use_module(library(toolbar)).   43:- use_module(library(pce_report)).   44:- use_module(library(tabular)).   45:- use_module(library(prolog_predicate)).   46
   47:- require([ auto_call/1,
   48	     reset_profiler/0,
   49	     is_dict/1,
   50	     profile_data/1,
   51	     www_open_url/1,
   52	     pi_head/2,
   53	     predicate_label/2,
   54	     predicate_sort_key/2,
   55	     get_chain/3,
   56	     send_list/3
   57	   ]).

 pce_show_profile is det

Show already collected profile using a graphical browser.

   69pce_show_profile :-
   70    profile_data(Data),
   71    in_pce_thread(show_profile(Data)).
   72
   73show_profile(Data) :-
   74    send(new(F, prof_frame), open),
   75    send(F, wait),
   76    send(F, load_profile, Data).
   77
   78
   79                 /*******************************
   80                 *             FRAME            *
   81                 *******************************/
   82
   83:- pce_begin_class(prof_frame, persistent_frame,
   84                   "Show Prolog profile data").
   85
   86variable(samples,          int,  get, "Total # samples").
   87variable(ticks,            int,  get, "Total # ticks").
   88variable(accounting_ticks, int,  get, "# ticks while accounting").
   89variable(time,             real, get, "Total time").
   90variable(nodes,            int,  get, "Nodes created").
   91variable(ports,            {true,false,classic},  get, "Port mode").
   92variable(time_view,        {percentage,seconds} := percentage,
   93                                 get, "How time is displayed").
   94
   95class_variable(auto_reset, bool, @on, "Reset profiler after collecting").
   96
   97initialise(F) :->
   98    send_super(F, initialise, 'SWI-Prolog profiler'),
   99    send(F, append, new(TD, tool_dialog(F))),
  100    send(new(B, prof_browser), left, new(prof_details)),
  101    send(B, below, TD),
  102    send(new(report_dialog), below, B),
  103    send(F, fill_dialog, TD).
  104
  105fill_dialog(F, TD:tool_dialog) :->
  106    send(TD, append, new(File, popup(file))),
  107    send(TD, append, new(Sort, popup(sort))),
  108    send(TD, append, new(Time, popup(time))),
  109    send(TD, append, new(Help, popup(help))),
  110    send_list(File, append,
  111              [ menu_item(statistics,
  112                          message(F, show_statistics)),
  113                gap,
  114                menu_item(exit,
  115                          message(F, destroy))
  116              ]),
  117    forall(sort_by(Label, Field, Order),
  118           send(Sort, append,
  119                menu_item(Label, message(F, sort_by, Field, Order)))),
  120    get(F?class, instance_variable, time_view, TV),
  121    get(TV, type, Type),
  122    get_chain(Type, value_set, Values),
  123    forall(member(TimeView, Values),
  124           send(Time, append,
  125                menu_item(TimeView, message(F, time_view, TimeView)))),
  126    send_list(Help, append,
  127              [ menu_item(about,
  128                          message(F, about)),
  129                menu_item(help,
  130                          message(F, help))
  131              ]).
  132
  133
  134load_profile(F, ProfData0:[prolog]) :->
  135    "Load stored profile from the Prolog database"::
  136    (   is_dict(ProfData0)
  137    ->  ProfData = ProfData0
  138    ;   profile_data(ProfData)
  139    ),
  140    Summary = ProfData.summary,
  141    send(F, slot, samples, Summary.samples),
  142    send(F, slot, ticks, Summary.ticks),
  143    send(F, slot, accounting_ticks, Summary.accounting),
  144    send(F, slot, time, Summary.time),
  145    send(F, slot, nodes, Summary.nodes),
  146    send(F, slot, ports, Summary.ports),
  147    get(F, member, prof_browser, B),
  148    send(F, report, progress, 'Loading profile data ...'),
  149    send(B, load_profile, ProfData.nodes),
  150    send(F, report, done),
  151    send(F, show_statistics),
  152    (   get(F, auto_reset, @on)
  153    ->  reset_profiler
  154    ;   true
  155    ).
  156
  157
  158show_statistics(F) :->
  159    "Show basic statistics on profile"::
  160    get(F, samples, Samples),
  161    get(F, ticks, Ticks),
  162    get(F, accounting_ticks, Account),
  163    get(F, time, Time),
  164    get(F, slot, nodes, Nodes),
  165    get(F, member, prof_browser, B),
  166    get(B?dict?members, size, Predicates),
  167    (   Ticks == 0
  168    ->  Distortion = 0.0
  169    ;   Distortion is 100.0*(Account/Ticks)
  170    ),
  171    send(F, report, inform,
  172         '%d samples in %.2f sec; %d predicates; \c
  173              %d nodes in call-graph; distortion %.0f%%',
  174         Samples, Time, Predicates, Nodes, Distortion).
  175
  176
  177details(F, From:prolog) :->
  178    "Show details on node or predicate"::
  179    get(F, member, prof_details, W),
  180    (   is_dict(From)
  181    ->  send(W, node, From)
  182    ;   get(F, member, prof_browser, B),
  183        get(B?dict, find,
  184            message(@arg1, has_predicate, prolog(From)),
  185            DI)
  186    ->  get(DI, data, Node),
  187        send(W, node, Node)
  188    ).
  189
  190sort_by(F, SortBy:name, Order:[{normal,reverse}]) :->
  191    "Define the key for sorting the flat profile"::
  192    get(F, member, prof_browser, B),
  193    send(B, sort_by, SortBy, Order).
  194
  195time_view(F, TV:name) :->
  196    send(F, slot, time_view, TV),
  197    get(F, member, prof_browser, B),
  198    get(F, member, prof_details, W),
  199    send(B, update_labels),
  200    send(W, refresh).
  201
  202render_time(F, Ticks:int, Rendered:any) :<-
  203    "Render a time constant"::
  204    get(F, time_view, View),
  205    (   View == percentage
  206    ->  get(F, ticks, Total),
  207        get(F, accounting_ticks, Accounting),
  208        (   Total-Accounting =:= 0
  209        ->  Rendered = '0.0%'
  210        ;   Percentage is 100.0 * (Ticks/(Total-Accounting)),
  211            new(Rendered, string('%.1f%%', Percentage))
  212        )
  213    ;   View == seconds
  214    ->  get(F, ticks, Total),
  215        (   Total == 0
  216        ->  Rendered = '0.0 s.'
  217        ;   get(F, time, TotalTime),
  218            Time is TotalTime*(Ticks/float(Total)),
  219            new(Rendered, string('%.2f s.', Time))
  220        )
  221    ).
  222
  223about(_F) :->
  224    send(@display, inform,
  225         'SWI-Prolog execution profile viewer\n\c
  226             By Jan Wielemaker').
  227
  228help(_F) :->
  229    send(@display, confirm,
  230         'No online help yet\n\c
  231              The profiler is described in the SWI-Prolog Reference Manual\n\c
  232              available from www.swi-prolog.org\n\n\c
  233              Press OK to open the manual in your browser'),
  234    www_open_url('http://www.swi.psy.uva.nl/projects/SWI-Prolog/Manual/profile.html').
  235
  236:- pce_end_class(prof_frame).
  237
  238
  239                 /*******************************
  240                 *     FLAT PROFILE BROWSER     *
  241                 *******************************/
  242
  243:- pce_begin_class(prof_browser, browser,
  244                   "Show flat profile in browser").
  245
  246class_variable(size, size, size(40,20)).
  247
  248variable(sort_by,  name := ticks, get, "How the items are sorted").
  249
  250initialise(B) :->
  251    send_super(B, initialise),
  252    send(B, update_label),
  253    send(B, select_message, message(@arg1, details)).
  254
  255resize(B) :->
  256    get(B?visible, width, W),
  257    get(B?font, ex, Ex),
  258    send(B, tab_stops, vector(W-10*Ex)),
  259    send_super(B, resize).
  260
  261load_profile(B, Nodes:prolog) :->
  262    "Load stored profile from the Prolog database"::
  263    get(B, frame, Frame),
  264    get(B, sort_by, SortBy),
  265    forall(member(Node, Nodes),
  266           send(B, append, prof_dict_item(Node, SortBy, Frame))),
  267    send(B, sort).
  268
  269update_label(B) :->
  270    get(B, sort_by, Sort),
  271    sort_by(Human, Sort, _How),
  272    send(B, label, Human?label_name).
  273
  274sort_by(B, SortBy:name, Order:[{normal,reverse}]) :->
  275    "Define key on which to sort"::
  276    send(B, slot, sort_by, SortBy),
  277    send(B, update_label),
  278    send(B, sort, Order),
  279    send(B, update_labels).
  280
  281sort(B, Order:[{normal,reverse}]) :->
  282    get(B, sort_by, Sort),
  283    (   Order == @default
  284    ->  sort_by(_, Sort, TheOrder)
  285    ;   TheOrder = Order
  286    ),
  287    send_super(B, sort, ?(@arg1, compare, @arg2, Sort, TheOrder)).
  288
  289update_labels(B) :->
  290    "Update labels of predicates"::
  291    get(B, sort_by, SortBy),
  292    get(B, frame, F),
  293    send(B?dict, for_all, message(@arg1, update_label, SortBy, F)).
  294
  295:- pce_end_class(prof_browser).
  296
  297:- pce_begin_class(prof_dict_item, dict_item,
  298                   "Show entry of Prolog flat profile").
  299
  300variable(data,         prolog, get, "Predicate data").
  301
  302initialise(DI, Node:prolog, SortBy:name, F:prof_frame) :->
  303    "Create from predicate head"::
  304    send(DI, slot, data, Node),
  305    pce_predicate_label(Node.predicate, Key),
  306    send_super(DI, initialise, Key),
  307    send(DI, update_label, SortBy, F).
  308
  309value(DI, Name:name, Value:prolog) :<-
  310    "Get associated value"::
  311    get(DI, data, Data),
  312    value(Name, Data, Value).
  313
  314has_predicate(DI, Test:prolog) :->
  315    get(DI, data, Data),
  316    same_pred(Test, Data.predicate).
  317
  318same_pred(X, X) :- !.
  319same_pred(QP1, QP2) :-
  320    unqualify(QP1, P1),
  321    unqualify(QP2, P2),
  322    same_pred_(P1, P2).
  323
  324unqualify(user:X, X) :- !.
  325unqualify(X, X).
  326
  327same_pred_(X, X) :- !.
  328same_pred_(Head, Name/Arity) :-
  329    pi_head(Name/Arity, Head).
  330same_pred_(Head, user:Name/Arity) :-
  331    pi_head(Name/Arity, Head).
  332
  333compare(DI, DI2:prof_dict_item,
  334        SortBy:name, Order:{normal,reverse},
  335        Result:name) :<-
  336    "Compare two predicate items on given key"::
  337    get(DI, value, SortBy, K1),
  338    get(DI2, value, SortBy, K2),
  339    (   Order == normal
  340    ->  get(K1, compare, K2, Result)
  341    ;   get(K2, compare, K1, Result)
  342    ).
  343
  344update_label(DI, SortBy:name, F:prof_frame) :->
  345    "Update label considering sort key and frame"::
  346    get(DI, key, Key),
  347    (   SortBy == name
  348    ->  send(DI, update_label, ticks_self, F)
  349    ;   get(DI, value, SortBy, Value),
  350        (   time_key(SortBy)
  351        ->  get(F, render_time, Value, Rendered)
  352        ;   Rendered = Value
  353        ),
  354        send(DI, label, string('%s\t%s', Key, Rendered))
  355    ).
  356
  357time_key(ticks).
  358time_key(ticks_self).
  359time_key(ticks_children).
  360
  361details(DI) :->
  362    "Show details"::
  363    get(DI, data, Data),
  364    send(DI?dict?browser?frame, details, Data).
  365
  366:- pce_end_class(prof_dict_item).
  367
  368
  369                 /*******************************
  370                 *         DETAIL WINDOW        *
  371                 *******************************/
  372
  373:- pce_begin_class(prof_details, window,
  374                   "Table showing profile details").
  375
  376variable(tabular, tabular, get, "Displayed table").
  377variable(node,    prolog,  get, "Currently shown node").
  378
  379initialise(W) :->
  380    send_super(W, initialise),
  381    send(W, pen, 0),
  382    send(W, label, 'Details'),
  383    send(W, background, colour(grey80)),
  384    send(W, scrollbars, vertical),
  385    send(W, display, new(T, tabular)),
  386    send(T, rules, all),
  387    send(T, cell_spacing, -1),
  388    send(W, slot, tabular, T).
  389
  390resize(W) :->
  391    send_super(W, resize),
  392    get(W?visible, width, Width),
  393    send(W?tabular, table_width, Width-3).
  394
  395title(W) :->
  396    "Show title-rows"::
  397    get(W, tabular, T),
  398    BG = (background := khaki1),
  399    send(T, append, 'Time',   bold, center, colspan := 2, BG),
  400    (   get(W?frame, ports, false)
  401    ->  send(T, append, '# Calls', bold, center, colspan := 1,
  402             valign := center, BG, rowspan := 2)
  403    ;   send(T, append, 'Port',    bold, center, colspan := 4, BG)
  404    ),
  405    send(T, append, 'Predicate', bold, center,
  406         valign := center, BG,
  407         rowspan := 2),
  408    send(T, next_row),
  409    send(T, append, 'Self',   bold, center, BG),
  410    send(T, append, 'Children',   bold, center, BG),
  411    (   get(W?frame, ports, false)
  412    ->  true
  413    ;   send(T, append, 'Call',   bold, center, BG),
  414        send(T, append, 'Redo',   bold, center, BG),
  415        send(T, append, 'Exit',   bold, center, BG),
  416        send(T, append, 'Fail',   bold, center, BG)
  417    ),
  418    send(T, next_row).
  419
  420cluster_title(W, Cycle:int) :->
  421    get(W, tabular, T),
  422    (   get(W?frame, ports, false)
  423    ->  Colspan = 4
  424    ;   Colspan = 7
  425    ),
  426    send(T, append, string('Cluster <%d>', Cycle),
  427         bold, center, colspan := Colspan,
  428         background := navyblue, colour := yellow),
  429    send(T, next_row).
  430
  431refresh(W) :->
  432    "Refresh to accomodate visualisation change"::
  433    (   get(W, node, Data),
  434        Data \== @nil
  435    ->  send(W, node, Data)
  436    ;   true
  437    ).
  438
  439node(W, Data:prolog) :->
  440    "Visualise a node"::
  441    send(W, slot, node, Data),
  442    send(W?tabular, clear),
  443    send(W, scroll_to, point(0,0)),
  444    send(W, title),
  445    clusters(Data.callers, CallersCycles),
  446    clusters(Data.callees, CalleesCycles),
  447    (   CallersCycles = [_]
  448    ->  show_clusters(CallersCycles, CalleesCycles, Data, 0, W)
  449    ;   show_clusters(CallersCycles, CalleesCycles, Data, 1, W)
  450    ).
  451
  452show_clusters([], [], _, _, _) :- !.
  453show_clusters([P|PT], [C|CT], Data, Cycle, W) :-
  454    show_cluster(P, C, Data, Cycle, W),
  455    Next is Cycle+1,
  456    show_clusters(PT, CT, Data, Next, W).
  457show_clusters([P|PT], [], Data, Cycle, W) :-
  458    show_cluster(P, [], Data, Cycle, W),
  459    Next is Cycle+1,
  460    show_clusters(PT, [], Data, Next, W).
  461show_clusters([], [C|CT], Data, Cycle, W) :-
  462    show_cluster([], C, Data, Cycle, W),
  463    Next is Cycle+1,
  464    show_clusters([], CT, Data, Next, W).
  465
  466
  467show_cluster(Callers, Callees, Data, Cycle, W) :-
  468    (   Cycle == 0
  469    ->  true
  470    ;   send(W, cluster_title, Cycle)
  471    ),
  472    sort_relatives(Callers, Callers1),
  473    show_relatives(Callers1, parent, W),
  474    ticks(Callers1, Self, Children, Call, Redo, Exit),
  475    send(W, show_predicate, Data, Self, Children, Call, Redo, Exit),
  476    sort_relatives(Callees, Callees1),
  477    reverse(Callees1, Callees2),
  478    show_relatives(Callees2, child, W).
  479
  480ticks(Callers, Self, Children, Call, Redo, Exit) :-
  481    ticks(Callers, 0, Self, 0, Children, 0, Call, 0, Redo, 0, Exit).
  482
  483ticks([], Self, Self, Sibl, Sibl, Call, Call, Redo, Redo, Exit, Exit).
  484ticks([H|T],
  485      Self0, Self, Sibl0, Sibl, Call0, Call, Redo0, Redo, Exit0, Exit) :-
  486    arg(1, H, '<recursive>'),
  487    !,
  488    ticks(T, Self0, Self, Sibl0, Sibl, Call0, Call, Redo0, Redo, Exit0, Exit).
  489ticks([H|T], Self0, Self, Sibl0, Sibl, Call0, Call, Redo0, Redo, Exit0, Exit) :-
  490    arg(3, H, ThisSelf),
  491    arg(4, H, ThisSibings),
  492    arg(5, H, ThisCall),
  493    arg(6, H, ThisRedo),
  494    arg(7, H, ThisExit),
  495    Self1 is ThisSelf + Self0,
  496    Sibl1 is ThisSibings + Sibl0,
  497    Call1 is ThisCall + Call0,
  498    Redo1 is ThisRedo + Redo0,
  499    Exit1 is ThisExit + Exit0,
  500    ticks(T, Self1, Self, Sibl1, Sibl, Call1, Call, Redo1, Redo, Exit1, Exit).
  501
  502
  503%       clusters(+Relatives, -Cycles)
  504%
  505%       Organise the relatives by cluster.
  506
  507clusters(Relatives, Cycles) :-
  508    clusters(Relatives, 0, Cycles).
  509
  510clusters([], _, []).
  511clusters(R, C, [H|T]) :-
  512    cluster(R, C, H, T0),
  513    C2 is C + 1,
  514    clusters(T0, C2, T).
  515
  516cluster([], _, [], []).
  517cluster([H|T0], C, [H|TC], R) :-
  518    arg(2, H, C),
  519    !,
  520    cluster(T0, C, TC, R).
  521cluster([H|T0], C, TC, [H|T]) :-
  522    cluster(T0, C, TC, T).
  523
  524%       sort_relatives(+Relatives, -Sorted)
  525%
  526%       Sort relatives in ascending number of calls.
  527
  528sort_relatives(List, Sorted) :-
  529    key_with_calls(List, Keyed),
  530    keysort(Keyed, KeySorted),
  531    unkey(KeySorted, Sorted).
  532
  533key_with_calls([], []).
  534key_with_calls([H|T0], [0-H|T]) :-      % get recursive on top
  535    arg(1, H, '<recursive>'),
  536    !,
  537    key_with_calls(T0, T).
  538key_with_calls([H|T0], [K-H|T]) :-
  539    arg(4, H, Calls),
  540    arg(5, H, Redos),
  541    K is Calls+Redos,
  542    key_with_calls(T0, T).
  543
  544unkey([], []).
  545unkey([_-H|T0], [H|T]) :-
  546    unkey(T0, T).
  547
  548%       show_relatives(+Relatives, +Rolw, +Window)
  549%
  550%       Show list of relatives as table-rows.
  551
  552show_relatives([], _, _) :- !.
  553show_relatives([H|T], Role, W) :-
  554    send(W, show_relative, H, Role),
  555    show_relatives(T, Role, W).
  556
  557show_predicate(W, Data:prolog,
  558               Ticks:int, ChildTicks:int,
  559               Call:int, Redo:int, Exit:int) :->
  560    "Show the predicate we have details on"::
  561    Pred = Data.predicate,
  562    get(W, frame, Frame),
  563    get(Frame, render_time, Ticks, Self),
  564    get(Frame, render_time, ChildTicks, Children),
  565    get(W, tabular, T),
  566    BG = (background := khaki1),
  567    Fail is Call+Redo-Exit,
  568    send(T, append, Self, halign := right, BG),
  569    send(T, append, Children, halign := right, BG),
  570    (   get(W?frame, ports, false)
  571    ->  send(T, append, Call, halign := right, BG)
  572    ;   send(T, append, Call, halign := right, BG),
  573        send(T, append, Redo, halign := right, BG),
  574        send(T, append, Exit, halign := right, BG),
  575        send(T, append, Fail, halign := right, BG)
  576    ),
  577    (   object(Pred)
  578    ->  new(Txt, prof_node_text(Pred, self))
  579    ;   new(Txt, prof_predicate_text(Pred, self))
  580    ),
  581    send(T, append, Txt, BG),
  582    send(W, label, string('Details -- %s', Txt?string)),
  583    send(T, next_row).
  584
  585show_relative(W, Caller:prolog, Role:name) :->
  586    Caller = node(Pred, _Cluster, Ticks, ChildTicks, Calls, Redos, Exits),
  587    get(W, tabular, T),
  588    get(W, frame, Frame),
  589    (   Pred == '<recursive>'
  590    ->  send(T, append, new(graphical), colspan := 2),
  591        send(T, append, Calls, halign := right),
  592        (   get(W?frame, ports, false)
  593        ->  true
  594        ;   send(T, append, new(graphical), colspan := 3)
  595        ),
  596        send(T, append, Pred, italic)
  597    ;   get(Frame, render_time, Ticks, Self),
  598        get(Frame, render_time, ChildTicks, Children),
  599        send(T, append, Self, halign := right),
  600        send(T, append, Children, halign := right),
  601        (   get(W?frame, ports, false)
  602        ->  send(T, append, Calls, halign := right)
  603        ;   Fails is Calls+Redos-Exits,
  604            send(T, append, Calls, halign := right),
  605            send(T, append, Redos, halign := right),
  606            send(T, append, Exits, halign := right),
  607            send(T, append, Fails, halign := right)
  608        ),
  609        (   Pred == '<spontaneous>'
  610        ->  send(T, append, Pred, italic)
  611        ;   object(Pred)
  612        ->  send(T, append, prof_node_text(Pred, Role))
  613        ;   send(T, append, prof_predicate_text(Pred, Role))
  614        )
  615    ),
  616    send(T, next_row).
  617
  618
  619:- pce_end_class(prof_details).
  620
  621
  622:- pce_begin_class(prof_node_text, text,
  623                   "Show executable object").
  624
  625variable(context,   any,                 get, "Represented executable").
  626variable(role,      {parent,self,child}, get, "Represented role").
  627
  628initialise(T, Context:any, Role:{parent,self,child}, Cycle:[int]) :->
  629    send(T, slot, context, Context),
  630    send(T, slot, role, Role),
  631    get(T, label, Label),
  632    (   (   Cycle == 0
  633        ;   Cycle == @default
  634        )
  635    ->  TheLabel = Label
  636    ;   N is Cycle+1,               % people like counting from 1
  637        TheLabel = string('%s <%d>', Label, N)
  638    ),
  639    send_super(T, initialise, TheLabel),
  640    send(T, colour, blue),
  641    send(T, underline, @on),
  642    (   Role == self
  643    ->  send(T, font, bold)
  644    ;   true
  645    ).
  646
  647
  648label(T, Label:char_array) :<-
  649    get(T?context, print_name, Label).
  650
  651
  652:- free(@prof_node_text_recogniser).  653:- pce_global(@prof_node_text_recogniser,
  654              make_prof_node_text_recogniser).  655
  656make_prof_node_text_recogniser(G) :-
  657    Text = @arg1,
  658    Pred = @arg1?context,
  659    new(P, popup),
  660    send_list(P, append,
  661              [ menu_item(details,
  662                          message(Text, details),
  663                          condition := Text?role \== self),
  664                menu_item(edit,
  665                          message(Pred, edit),
  666                          condition := Pred?source),
  667                menu_item(documentation,
  668                          message(Pred, help),
  669                          condition := message(Text, has_help))
  670              ]),
  671    new(C, click_gesture(left, '', single,
  672                         message(@receiver, details))),
  673    new(G, handler_group(C, popup_gesture(P))).
  674
  675
  676event(T, Ev:event) :->
  677    (   send_super(T, event, Ev)
  678    ->  true
  679    ;   send(@prof_node_text_recogniser, event, Ev)
  680    ).
  681
  682has_help(T) :->
  683    get(T, context, Ctx),
  684    (   send(Ctx, instance_of, method) % hack
  685    ->  auto_call(manpce)
  686    ;   true
  687    ),
  688    send(Ctx, has_send_method, has_help),
  689    send(Ctx, has_help).
  690
  691details(T) :->
  692    "Show details of clicked predicate"::
  693    get(T, context, Context),
  694    send(T?frame, details, Context).
  695
  696:- pce_end_class(prof_node_text).
  697
  698
  699:- pce_begin_class(prof_predicate_text, prof_node_text,
  700                   "Show a predicate").
  701
  702initialise(T, Pred:prolog, Role:{parent,self,child}, Cycle:[int]) :->
  703    send_super(T, initialise, prolog_predicate(Pred), Role, Cycle).
  704
  705details(T) :->
  706    "Show details of clicked predicate"::
  707    get(T?context, pi, @on, Head),
  708    send(T?frame, details, Head).
  709
  710:- pce_end_class(prof_predicate_text).
  711
  712
  713                 /*******************************
  714                 *              UTIL            *
  715                 *******************************/
  716
  717value(name, Data, Name) :-
  718    !,
  719    predicate_sort_key(Data.predicate, Name).
  720value(label, Data, Label) :-
  721    !,
  722    pce_predicate_label(Data.predicate, Label).
  723value(ticks, Data, Ticks) :-
  724    !,
  725    Ticks is Data.ticks_self + Data.ticks_siblings.
  726value(Name, Data, Value) :-
  727    Value = Data.Name.
  728
  729sort_by(cumulative_profile_by_time,          ticks,          reverse).
  730sort_by(flat_profile_by_time_self,           ticks_self,     reverse).
  731sort_by(cumulative_profile_by_time_children, ticks_siblings, reverse).
  732sort_by(flat_profile_by_number_of_calls,     call,           reverse).
  733sort_by(flat_profile_by_number_of_redos,     redo,           reverse).
  734sort_by(flat_profile_by_name,                name,           normal).

 pce_predicate_label(+PI, -Label)

Label is the human-readable identification for Head. Calls the hook prolog_predicate_name/2.

  742pce_predicate_label(Obj, Label) :-
  743    object(Obj),
  744    !,
  745    get(Obj, print_name, Label).
  746pce_predicate_label(PI, Label) :-
  747    predicate_label(PI, Label)