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    send(B, tab_stops, vector(W-80)),
  258    send_super(B, resize).
  259
  260load_profile(B, Nodes:prolog) :->
  261    "Load stored profile from the Prolog database"::
  262    get(B, frame, Frame),
  263    get(B, sort_by, SortBy),
  264    forall(member(Node, Nodes),
  265           send(B, append, prof_dict_item(Node, SortBy, Frame))),
  266    send(B, sort).
  267
  268update_label(B) :->
  269    get(B, sort_by, Sort),
  270    sort_by(Human, Sort, _How),
  271    send(B, label, Human?label_name).
  272
  273sort_by(B, SortBy:name, Order:[{normal,reverse}]) :->
  274    "Define key on which to sort"::
  275    send(B, slot, sort_by, SortBy),
  276    send(B, update_label),
  277    send(B, sort, Order),
  278    send(B, update_labels).
  279
  280sort(B, Order:[{normal,reverse}]) :->
  281    get(B, sort_by, Sort),
  282    (   Order == @default
  283    ->  sort_by(_, Sort, TheOrder)
  284    ;   TheOrder = Order
  285    ),
  286    send_super(B, sort, ?(@arg1, compare, @arg2, Sort, TheOrder)).
  287
  288update_labels(B) :->
  289    "Update labels of predicates"::
  290    get(B, sort_by, SortBy),
  291    get(B, frame, F),
  292    send(B?dict, for_all, message(@arg1, update_label, SortBy, F)).
  293
  294:- pce_end_class(prof_browser).
  295
  296:- pce_begin_class(prof_dict_item, dict_item,
  297                   "Show entry of Prolog flat profile").
  298
  299variable(data,         prolog, get, "Predicate data").
  300
  301initialise(DI, Node:prolog, SortBy:name, F:prof_frame) :->
  302    "Create from predicate head"::
  303    send(DI, slot, data, Node),
  304    pce_predicate_label(Node.predicate, Key),
  305    send_super(DI, initialise, Key),
  306    send(DI, update_label, SortBy, F).
  307
  308value(DI, Name:name, Value:prolog) :<-
  309    "Get associated value"::
  310    get(DI, data, Data),
  311    value(Name, Data, Value).
  312
  313has_predicate(DI, Test:prolog) :->
  314    get(DI, data, Data),
  315    same_pred(Test, Data.predicate).
  316
  317same_pred(X, X) :- !.
  318same_pred(QP1, QP2) :-
  319    unqualify(QP1, P1),
  320    unqualify(QP2, P2),
  321    same_pred_(P1, P2).
  322
  323unqualify(user:X, X) :- !.
  324unqualify(X, X).
  325
  326same_pred_(X, X) :- !.
  327same_pred_(Head, Name/Arity) :-
  328    pi_head(Name/Arity, Head).
  329same_pred_(Head, user:Name/Arity) :-
  330    pi_head(Name/Arity, Head).
  331
  332compare(DI, DI2:prof_dict_item,
  333        SortBy:name, Order:{normal,reverse},
  334        Result:name) :<-
  335    "Compare two predicate items on given key"::
  336    get(DI, value, SortBy, K1),
  337    get(DI2, value, SortBy, K2),
  338    (   Order == normal
  339    ->  get(K1, compare, K2, Result)
  340    ;   get(K2, compare, K1, Result)
  341    ).
  342
  343update_label(DI, SortBy:name, F:prof_frame) :->
  344    "Update label considering sort key and frame"::
  345    get(DI, key, Key),
  346    (   SortBy == name
  347    ->  send(DI, update_label, ticks_self, F)
  348    ;   get(DI, value, SortBy, Value),
  349        (   time_key(SortBy)
  350        ->  get(F, render_time, Value, Rendered)
  351        ;   Rendered = Value
  352        ),
  353        send(DI, label, string('%s\t%s', Key, Rendered))
  354    ).
  355
  356time_key(ticks).
  357time_key(ticks_self).
  358time_key(ticks_children).
  359
  360details(DI) :->
  361    "Show details"::
  362    get(DI, data, Data),
  363    send(DI?dict?browser?frame, details, Data).
  364
  365:- pce_end_class(prof_dict_item).
  366
  367
  368                 /*******************************
  369                 *         DETAIL WINDOW        *
  370                 *******************************/
  371
  372:- pce_begin_class(prof_details, window,
  373                   "Table showing profile details").
  374
  375variable(tabular, tabular, get, "Displayed table").
  376variable(node,    prolog,  get, "Currently shown node").
  377
  378initialise(W) :->
  379    send_super(W, initialise),
  380    send(W, pen, 0),
  381    send(W, label, 'Details'),
  382    send(W, background, colour(grey80)),
  383    send(W, scrollbars, vertical),
  384    send(W, display, new(T, tabular)),
  385    send(T, rules, all),
  386    send(T, cell_spacing, -1),
  387    send(W, slot, tabular, T).
  388
  389resize(W) :->
  390    send_super(W, resize),
  391    get(W?visible, width, Width),
  392    send(W?tabular, table_width, Width-3).
  393
  394title(W) :->
  395    "Show title-rows"::
  396    get(W, tabular, T),
  397    BG = (background := khaki1),
  398    send(T, append, 'Time',   bold, center, colspan := 2, BG),
  399    (   get(W?frame, ports, false)
  400    ->  send(T, append, '# Calls', bold, center, colspan := 1,
  401             valign := center, BG, rowspan := 2)
  402    ;   send(T, append, 'Port',    bold, center, colspan := 4, BG)
  403    ),
  404    send(T, append, 'Predicate', bold, center,
  405         valign := center, BG,
  406         rowspan := 2),
  407    send(T, next_row),
  408    send(T, append, 'Self',   bold, center, BG),
  409    send(T, append, 'Children',   bold, center, BG),
  410    (   get(W?frame, ports, false)
  411    ->  true
  412    ;   send(T, append, 'Call',   bold, center, BG),
  413        send(T, append, 'Redo',   bold, center, BG),
  414        send(T, append, 'Exit',   bold, center, BG),
  415        send(T, append, 'Fail',   bold, center, BG)
  416    ),
  417    send(T, next_row).
  418
  419cluster_title(W, Cycle:int) :->
  420    get(W, tabular, T),
  421    (   get(W?frame, ports, false)
  422    ->  Colspan = 4
  423    ;   Colspan = 7
  424    ),
  425    send(T, append, string('Cluster <%d>', Cycle),
  426         bold, center, colspan := Colspan,
  427         background := navyblue, colour := yellow),
  428    send(T, next_row).
  429
  430refresh(W) :->
  431    "Refresh to accomodate visualisation change"::
  432    (   get(W, node, Data),
  433        Data \== @nil
  434    ->  send(W, node, Data)
  435    ;   true
  436    ).
  437
  438node(W, Data:prolog) :->
  439    "Visualise a node"::
  440    send(W, slot, node, Data),
  441    send(W?tabular, clear),
  442    send(W, scroll_to, point(0,0)),
  443    send(W, title),
  444    clusters(Data.callers, CallersCycles),
  445    clusters(Data.callees, CalleesCycles),
  446    (   CallersCycles = [_]
  447    ->  show_clusters(CallersCycles, CalleesCycles, Data, 0, W)
  448    ;   show_clusters(CallersCycles, CalleesCycles, Data, 1, W)
  449    ).
  450
  451show_clusters([], [], _, _, _) :- !.
  452show_clusters([P|PT], [C|CT], Data, Cycle, W) :-
  453    show_cluster(P, C, Data, Cycle, W),
  454    Next is Cycle+1,
  455    show_clusters(PT, CT, Data, Next, W).
  456show_clusters([P|PT], [], Data, Cycle, W) :-
  457    show_cluster(P, [], Data, Cycle, W),
  458    Next is Cycle+1,
  459    show_clusters(PT, [], Data, Next, W).
  460show_clusters([], [C|CT], Data, Cycle, W) :-
  461    show_cluster([], C, Data, Cycle, W),
  462    Next is Cycle+1,
  463    show_clusters([], CT, Data, Next, W).
  464
  465
  466show_cluster(Callers, Callees, Data, Cycle, W) :-
  467    (   Cycle == 0
  468    ->  true
  469    ;   send(W, cluster_title, Cycle)
  470    ),
  471    sort_relatives(Callers, Callers1),
  472    show_relatives(Callers1, parent, W),
  473    ticks(Callers1, Self, Children, Call, Redo, Exit),
  474    send(W, show_predicate, Data, Self, Children, Call, Redo, Exit),
  475    sort_relatives(Callees, Callees1),
  476    reverse(Callees1, Callees2),
  477    show_relatives(Callees2, child, W).
  478
  479ticks(Callers, Self, Children, Call, Redo, Exit) :-
  480    ticks(Callers, 0, Self, 0, Children, 0, Call, 0, Redo, 0, Exit).
  481
  482ticks([], Self, Self, Sibl, Sibl, Call, Call, Redo, Redo, Exit, Exit).
  483ticks([H|T],
  484      Self0, Self, Sibl0, Sibl, Call0, Call, Redo0, Redo, Exit0, Exit) :-
  485    arg(1, H, '<recursive>'),
  486    !,
  487    ticks(T, Self0, Self, Sibl0, Sibl, Call0, Call, Redo0, Redo, Exit0, Exit).
  488ticks([H|T], Self0, Self, Sibl0, Sibl, Call0, Call, Redo0, Redo, Exit0, Exit) :-
  489    arg(3, H, ThisSelf),
  490    arg(4, H, ThisSibings),
  491    arg(5, H, ThisCall),
  492    arg(6, H, ThisRedo),
  493    arg(7, H, ThisExit),
  494    Self1 is ThisSelf + Self0,
  495    Sibl1 is ThisSibings + Sibl0,
  496    Call1 is ThisCall + Call0,
  497    Redo1 is ThisRedo + Redo0,
  498    Exit1 is ThisExit + Exit0,
  499    ticks(T, Self1, Self, Sibl1, Sibl, Call1, Call, Redo1, Redo, Exit1, Exit).
  500
  501
  502%       clusters(+Relatives, -Cycles)
  503%
  504%       Organise the relatives by cluster.
  505
  506clusters(Relatives, Cycles) :-
  507    clusters(Relatives, 0, Cycles).
  508
  509clusters([], _, []).
  510clusters(R, C, [H|T]) :-
  511    cluster(R, C, H, T0),
  512    C2 is C + 1,
  513    clusters(T0, C2, T).
  514
  515cluster([], _, [], []).
  516cluster([H|T0], C, [H|TC], R) :-
  517    arg(2, H, C),
  518    !,
  519    cluster(T0, C, TC, R).
  520cluster([H|T0], C, TC, [H|T]) :-
  521    cluster(T0, C, TC, T).
  522
  523%       sort_relatives(+Relatives, -Sorted)
  524%
  525%       Sort relatives in ascending number of calls.
  526
  527sort_relatives(List, Sorted) :-
  528    key_with_calls(List, Keyed),
  529    keysort(Keyed, KeySorted),
  530    unkey(KeySorted, Sorted).
  531
  532key_with_calls([], []).
  533key_with_calls([H|T0], [0-H|T]) :-      % get recursive on top
  534    arg(1, H, '<recursive>'),
  535    !,
  536    key_with_calls(T0, T).
  537key_with_calls([H|T0], [K-H|T]) :-
  538    arg(4, H, Calls),
  539    arg(5, H, Redos),
  540    K is Calls+Redos,
  541    key_with_calls(T0, T).
  542
  543unkey([], []).
  544unkey([_-H|T0], [H|T]) :-
  545    unkey(T0, T).
  546
  547%       show_relatives(+Relatives, +Rolw, +Window)
  548%
  549%       Show list of relatives as table-rows.
  550
  551show_relatives([], _, _) :- !.
  552show_relatives([H|T], Role, W) :-
  553    send(W, show_relative, H, Role),
  554    show_relatives(T, Role, W).
  555
  556show_predicate(W, Data:prolog,
  557               Ticks:int, ChildTicks:int,
  558               Call:int, Redo:int, Exit:int) :->
  559    "Show the predicate we have details on"::
  560    Pred = Data.predicate,
  561    get(W, frame, Frame),
  562    get(Frame, render_time, Ticks, Self),
  563    get(Frame, render_time, ChildTicks, Children),
  564    get(W, tabular, T),
  565    BG = (background := khaki1),
  566    Fail is Call+Redo-Exit,
  567    send(T, append, Self, halign := right, BG),
  568    send(T, append, Children, halign := right, BG),
  569    (   get(W?frame, ports, false)
  570    ->  send(T, append, Call, halign := right, BG)
  571    ;   send(T, append, Call, halign := right, BG),
  572        send(T, append, Redo, halign := right, BG),
  573        send(T, append, Exit, halign := right, BG),
  574        send(T, append, Fail, halign := right, BG)
  575    ),
  576    (   object(Pred)
  577    ->  new(Txt, prof_node_text(Pred, self))
  578    ;   new(Txt, prof_predicate_text(Pred, self))
  579    ),
  580    send(T, append, Txt, BG),
  581    send(W, label, string('Details -- %s', Txt?string)),
  582    send(T, next_row).
  583
  584show_relative(W, Caller:prolog, Role:name) :->
  585    Caller = node(Pred, _Cluster, Ticks, ChildTicks, Calls, Redos, Exits),
  586    get(W, tabular, T),
  587    get(W, frame, Frame),
  588    (   Pred == '<recursive>'
  589    ->  send(T, append, new(graphical), colspan := 2),
  590        send(T, append, Calls, halign := right),
  591        (   get(W?frame, ports, false)
  592        ->  true
  593        ;   send(T, append, new(graphical), colspan := 3)
  594        ),
  595        send(T, append, Pred, italic)
  596    ;   get(Frame, render_time, Ticks, Self),
  597        get(Frame, render_time, ChildTicks, Children),
  598        send(T, append, Self, halign := right),
  599        send(T, append, Children, halign := right),
  600        (   get(W?frame, ports, false)
  601        ->  send(T, append, Calls, halign := right)
  602        ;   Fails is Calls+Redos-Exits,
  603            send(T, append, Calls, halign := right),
  604            send(T, append, Redos, halign := right),
  605            send(T, append, Exits, halign := right),
  606            send(T, append, Fails, halign := right)
  607        ),
  608        (   Pred == '<spontaneous>'
  609        ->  send(T, append, Pred, italic)
  610        ;   object(Pred)
  611        ->  send(T, append, prof_node_text(Pred, Role))
  612        ;   send(T, append, prof_predicate_text(Pred, Role))
  613        )
  614    ),
  615    send(T, next_row).
  616
  617
  618:- pce_end_class(prof_details).
  619
  620
  621:- pce_begin_class(prof_node_text, text,
  622                   "Show executable object").
  623
  624variable(context,   any,                 get, "Represented executable").
  625variable(role,      {parent,self,child}, get, "Represented role").
  626
  627initialise(T, Context:any, Role:{parent,self,child}, Cycle:[int]) :->
  628    send(T, slot, context, Context),
  629    send(T, slot, role, Role),
  630    get(T, label, Label),
  631    (   (   Cycle == 0
  632        ;   Cycle == @default
  633        )
  634    ->  TheLabel = Label
  635    ;   N is Cycle+1,               % people like counting from 1
  636        TheLabel = string('%s <%d>', Label, N)
  637    ),
  638    send_super(T, initialise, TheLabel),
  639    send(T, colour, blue),
  640    send(T, underline, @on),
  641    (   Role == self
  642    ->  send(T, font, bold)
  643    ;   true
  644    ).
  645
  646
  647label(T, Label:char_array) :<-
  648    get(T?context, print_name, Label).
  649
  650
  651:- free(@prof_node_text_recogniser).  652:- pce_global(@prof_node_text_recogniser,
  653              make_prof_node_text_recogniser).  654
  655make_prof_node_text_recogniser(G) :-
  656    Text = @arg1,
  657    Pred = @arg1?context,
  658    new(P, popup),
  659    send_list(P, append,
  660              [ menu_item(details,
  661                          message(Text, details),
  662                          condition := Text?role \== self),
  663                menu_item(edit,
  664                          message(Pred, edit),
  665                          condition := Pred?source),
  666                menu_item(documentation,
  667                          message(Pred, help),
  668                          condition := message(Text, has_help))
  669              ]),
  670    new(C, click_gesture(left, '', single,
  671                         message(@receiver, details))),
  672    new(G, handler_group(C, popup_gesture(P))).
  673
  674
  675event(T, Ev:event) :->
  676    (   send_super(T, event, Ev)
  677    ->  true
  678    ;   send(@prof_node_text_recogniser, event, Ev)
  679    ).
  680
  681has_help(T) :->
  682    get(T, context, Ctx),
  683    (   send(Ctx, instance_of, method) % hack
  684    ->  auto_call(manpce)
  685    ;   true
  686    ),
  687    send(Ctx, has_send_method, has_help),
  688    send(Ctx, has_help).
  689
  690details(T) :->
  691    "Show details of clicked predicate"::
  692    get(T, context, Context),
  693    send(T?frame, details, Context).
  694
  695:- pce_end_class(prof_node_text).
  696
  697
  698:- pce_begin_class(prof_predicate_text, prof_node_text,
  699                   "Show a predicate").
  700
  701initialise(T, Pred:prolog, Role:{parent,self,child}, Cycle:[int]) :->
  702    send_super(T, initialise, prolog_predicate(Pred), Role, Cycle).
  703
  704details(T) :->
  705    "Show details of clicked predicate"::
  706    get(T?context, pi, @on, Head),
  707    send(T?frame, details, Head).
  708
  709:- pce_end_class(prof_predicate_text).
  710
  711
  712                 /*******************************
  713                 *              UTIL            *
  714                 *******************************/
  715
  716value(name, Data, Name) :-
  717    !,
  718    predicate_sort_key(Data.predicate, Name).
  719value(label, Data, Label) :-
  720    !,
  721    pce_predicate_label(Data.predicate, Label).
  722value(ticks, Data, Ticks) :-
  723    !,
  724    Ticks is Data.ticks_self + Data.ticks_siblings.
  725value(Name, Data, Value) :-
  726    Value = Data.Name.
  727
  728sort_by(cumulative_profile_by_time,          ticks,          reverse).
  729sort_by(flat_profile_by_time_self,           ticks_self,     reverse).
  730sort_by(cumulative_profile_by_time_children, ticks_siblings, reverse).
  731sort_by(flat_profile_by_number_of_calls,     call,           reverse).
  732sort_by(flat_profile_by_number_of_redos,     redo,           reverse).
  733sort_by(flat_profile_by_name,                name,           normal).

 pce_predicate_label(+PI, -Label)

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

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