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

  731pce_predicate_label(Obj, Label) :-
  732    object(Obj),
  733    !,
  734    get(Obj, print_name, Label).
  735pce_predicate_label(PI, Label) :-
  736    predicate_label(PI, Label)