1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
    2
    3    Author:        Jan Wielemaker and Anjo Anjewierden
    4    E-mail:        J.Wielemaker@cwi.nl
    5    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
    6    Copyright (c)  2001-2020, University of Amsterdam
    7                              CWI, 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(prolog_predicate, []).   37:- use_module(library(pce)).   38:- use_module(pce_arm).   39:- use_module(library(persistent_frame)).   40:- use_module(library(tabbed_window)).   41:- use_module(library(tabular)).   42:- require([ atomic_list_concat/2,
   43             term_to_atom/2,
   44             auto_call/1
   45           ]).   46
   47:- if(exists_source(library(pldoc/man_index))).   48:- autoload(library(pldoc/man_index), [man_object_property/2]).   49:- endif.   50
   51/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   52Class prolog_predicate represents the identity of a Prolog predicate. It
   53is used with predicate_item  for   locating  predicates and encapsulates
   54access to various parts of the development environment.
   55- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
   56
   57:- pce_begin_class(prolog_predicate, object,
   58                   "Represent a Prolog predicate").
   59
   60variable(module,        name*,   get, "Module of the predicate").
   61variable(name,          name,    get, "Name of predicate").
   62variable(arity,         ['0..'], get, "Arity of the predicate").
   63
   64initialise(P, Term:prolog) :->
   65    "Create from [Module]:Name/Arity"::
   66    (   Term = Module:Name/Arity
   67    ->  true
   68    ;   Term = Name/Arity
   69    ->  Module = @nil
   70    ;   Term = Module:Head,
   71        callable(Head)
   72    ->  functor(Head, Name, Arity)
   73    ;   callable(Term)
   74    ->  functor(Term, Name, Arity),
   75        Module = @nil
   76    ),
   77    (   var(Arity)
   78    ->  Arity = @default
   79    ;   true
   80    ),
   81    (   var(Module)
   82    ->  Module = @nil
   83    ;   true
   84    ),
   85    send(P, slot, module, Module),
   86    send(P, slot, name, Name),
   87    send(P, slot, arity, Arity).
   88
   89convert(_, From:name, P:prolog_predicate) :<-
   90    "Convert textual and Prolog term"::
   91    catch(term_to_atom(From, Term), _, fail),
   92    (   (   Term = _:_/_
   93        ;   Term = _/_
   94        )
   95    ->  new(P, prolog_predicate(Term))
   96    ;   Term = Module:Head,
   97        callable(Head)
   98    ->  functor(Head, Name, Arity),
   99        new(P, prolog_predicate(Module:Name/Arity))
  100    ;   callable(Term)
  101    ->  functor(Term, Name, Arity),
  102        new(P, prolog_predicate(Name/Arity))
  103    ).
  104
  105print_name(P, PN:name) :<-
  106    "Return as [Module:]Name/Arity"::
  107    get(P, name, Name),
  108    get(P, arity, Arity),
  109    get(P, module, Module),
  110    (   Module \== @nil,
  111        Arity \== @default
  112    ->  functor(Head, Name, Arity), % fully qualified
  113        (   user:prolog_predicate_name(Module:Head, PN)
  114        ->  true
  115        ;   \+ hidden_module(Module, Head)
  116        ->  atomic_list_concat([Module, :, Name, /, Arity], PN)
  117        ;   atomic_list_concat([Name, /, Arity], PN)
  118        )
  119    ;   (   Arity == @default
  120        ->  End = ['/_']
  121        ;   End = [/, Arity]
  122        )
  123    ->  (   Module == @nil
  124        ->  atomic_list_concat([Name|End], PN)
  125        ;   atomic_list_concat([Module, :, Name|End], PN)
  126        )
  127    ).
  128
  129hidden_module(system, _).
  130hidden_module(user, _).
  131hidden_module(M, H) :-
  132    predicate_property(system:H, imported_from(M)).
  133
  134head(P, Qualify:[bool], Head:prolog) :<-
  135    "Get a head-term"::
  136    get(P, module, Module),
  137    get(P, name, Name),
  138    get(P, arity, Arity),
  139    Arity \== @default,
  140    functor(Head0, Name, Arity),
  141    qualify(Qualify, Module, Head0, Head).
  142
  143qualify(Qualify, Module, Head0, Head) :-
  144    (   (   Qualify == @off
  145        ;   Qualify == @default,
  146            Module == @nil
  147        )
  148    ->  Head = Head0
  149    ;   Module \== @nil
  150    ->  Head = Module:Head0
  151    ;   Head = user:Head0
  152    ).
  153
  154pi(P, Qualify:[bool], PI:prolog) :<-
  155    "Get a predicate indicator"::
  156    get(P, module, Module),
  157    get(P, name, Name),
  158    get(P, arity, Arity),
  159    (   Arity == @default
  160    ->  PI0 = Name/_
  161    ;   PI0 = Name/Arity
  162    ),
  163    qualify(Qualify, Module, PI0, PI).
  164
  165
  166%       <-source:
  167%
  168%       Get the source-location for this predicate. If not available and
  169%       the autoload argument is not @off, try to autoload the predicate
  170%       and try again.
  171%
  172%       TBD: Deal with multiple solutions
  173
  174source(P, Autoload:[bool], Loc:source_location) :<-
  175    "Return source-location from Prolog DB"::
  176    get(P, head, Head0),
  177    (   Head0 = _:_
  178    ->  Head = Head0
  179    ;   Head = _:Head0
  180    ),
  181    (   predicate_property(Head, file(File))
  182    ->  true
  183    ;   Autoload \== @off,
  184        send(P, autoload),
  185        predicate_property(Head, file(File))
  186    ),
  187    (   predicate_property(Head, line_count(Line))
  188    ->  new(Loc, source_location(File, Line))
  189    ;   new(Loc, source_location(File))
  190    ).
  191
  192
  193edit(P) :->
  194    "Edit the predicate"::
  195    get(P, head, @on, Head),
  196    auto_call(edit(Head)).
  197
  198
  199autoload(P, Module:[name]) :->
  200    "Autoload the definition"::
  201    get(P, head, @off, Term),
  202    (   Module == @default
  203    ->  '$define_predicate'(Term)
  204    ;   '$define_predicate'(Module:Term)
  205    ).
  206
  207has_property(P, Prop:prolog) :->
  208    "Test predicate property"::
  209    get(P, head, Head),
  210    predicate_property(Head, Prop).
  211
  212help(P) :->
  213    "Activate the help-system"::
  214    get(P, head, @off, Head),
  215    functor(Head, Name, Arity),
  216    (   help(Name/Arity)
  217    ->  true
  218    ;   send(P, report, warning, 'Cannot find help for %s/%d', Name, Arity)
  219    ).
  220
  221has_help(P) :->
  222    "See if there is help around"::
  223    get(P, summary, _).
  224
  225summary(P, Summary:string) :<-
  226    get(P, name, Name),
  227    get(P, arity, Arity),
  228    (   man_predicate_summary(Name/Arity, Summary0),
  229        new(Summary, string('%s', Summary0))
  230    ->  true
  231    ;   (   get(P, module, M),
  232            M \== @nil
  233        ->  true
  234        ;   M = _
  235        ),
  236        summary(M:Name/Arity, Summary)
  237    ).
  238
  239:- if(current_predicate(man_object_property/2)).  240man_predicate_summary(PI, Summary) :-
  241    man_object_property(PI, summary(Summary)).
  242:- elif(current_predicate(predicate/5)).  243man_predicate_summary(Name/Arity, Summary) :-
  244    predicate(Name, Arity, Summary, _, _).
  245:- else.  246man_predicate_summary(_, _) :-
  247    fail.
  248:- endif.  249
  250:- multifile
  251    prolog:predicate_summary/2.  252
  253summary(PI, Summary) :-
  254    prolog:predicate_summary(PI, Summary).
  255
  256info(P) :->
  257    "Open information sheet on predicate"::
  258    (   get(P, head, Head),
  259        predicate_property(Head, imported_from(M2))
  260    ->  get(P, pi, @off, PI),
  261        send(prolog_predicate_frame(prolog_predicate(M2:PI)), open)
  262    ;   send(prolog_predicate_frame(P), open)
  263    ).
  264
  265:- pce_end_class(prolog_predicate).
  266
  267
  268:- pce_begin_class(prolog_predicate_frame, persistent_frame,
  269                   "Provide information about a predicate").
  270
  271variable(predicate, prolog_predicate, get, "Current predicate").
  272
  273initialise(F, P:prolog_predicate) :->
  274    "Create from a predicate"::
  275    send_super(F, initialise, string('Info for %s', P?print_name)),
  276    send(F, slot, predicate, P),
  277    send(F, append, new(tabbed_window)),
  278    send(F, add_general_info),
  279    send(F, add_documentation),
  280    send(F, add_callers).
  281
  282add_general_info(F) :->
  283    "Show general info on the predicate"::
  284    get(F, predicate, P),
  285    get(F, member, tabbed_window, TW),
  286    send(TW, append, prolog_predicate_info_window(P)).
  287
  288add_documentation(_F) :->
  289    "Show documentation about the predicate"::
  290    true.
  291
  292add_callers(_F) :->
  293    "Add window holding callers to the predicate"::
  294    true.
  295
  296:- pce_end_class(prolog_predicate_frame).
  297
  298
  299:- pce_begin_class(prolog_predicate_info_window, window,
  300                   "Show table with general properties of predicate").
  301:- use_class_template(arm).
  302
  303variable(tabular,   tabular,          get, "Displayed table").
  304variable(predicate, prolog_predicate, get, "Displayed predicate").
  305
  306initialise(W, P:prolog_predicate) :->
  307    "Create info sheet for P"::
  308    send_super(W, initialise),
  309    send(W, name, properties),
  310    send(W, pen, 0),
  311    send(W, scrollbars, vertical),
  312    send(W, display, new(T, tabular)),
  313    send(T, rules, all),
  314    send(T, cell_spacing, -1),
  315    send(W, slot, tabular, T),
  316    send(W, predicate, P).
  317
  318resize(W) :->
  319    send_super(W, resize),
  320    get(W?visible, width, Width),
  321    send(W?tabular, table_width, Width-3).
  322
  323clear(W) :->
  324    send(W?tabular, clear).
  325
  326predicate(W, P:prolog_predicate) :->
  327    send(W, slot, predicate, P),
  328    send(W, update).
  329
  330update(W) :->
  331    get(W, predicate, P),
  332    send(W, clear),
  333    get(P, pi, PI),
  334    (   PI = _:_
  335    ->  QPI = PI
  336    ;   QPI = _:PI
  337    ),
  338    forall(setof(Prop, pi_property(QPI, Prop), Props),
  339           send(W, properties, QPI, Props)).
  340
  341pi_property(M:Name/Arity, Prop) :-
  342    integer(Arity),
  343    functor(Head, Name, Arity),
  344    current_predicate(M:Name/Arity),
  345    \+ predicate_property(M:Head, imported_from(_)),
  346    predicate_property(M:Head, Prop).
  347pi_property(M:Name/_, Prop) :-
  348    current_predicate(M:Name, Head),
  349    \+ predicate_property(M:Head, imported_from(_)),
  350    predicate_property(M:Head, Prop).
  351
  352properties(W, QPI:prolog, Props:prolog) :->
  353    "Append property sheet or a specific definition"::
  354    get(W, tabular, T),
  355    format(atom(AQPI), '~q', [QPI]),
  356    BG = (background := khaki1),
  357    send(T, append, AQPI, halign := center, colspan := 2, BG),
  358    send(T, next_row),
  359    partition(atom, Props, Atomic, Valued),
  360    (   select(file(File), Valued, Valued1),
  361        select(line_count(Line), Valued1, Valued2)
  362    ->  send(T, append, 'Source:', bold, right),
  363        send(T, append, source_location_text(source_location(File,Line))),
  364        send(T, next_row)
  365    ;   Valued2 = Valued
  366    ),
  367    delete(Atomic, visible, Atomic1),
  368    (   memberchk(meta_predicate(_), Valued2)
  369    ->  delete(Atomic1, transparent, Atomic2)
  370    ;   Atomic2 = Atomic1
  371    ),
  372    forall(member(P, Valued2), send(W, property, P)),
  373    atomic_list_concat(Atomic2, ', ', AtomicText),
  374    send(T, append, 'Flags:', bold, right),
  375    send(T, append, AtomicText),
  376    send(T, next_row).
  377
  378property(W, Prop:prolog) :->
  379    "Append a property"::
  380    get(W, tabular, T),
  381    (   Prop =.. [Name,Value]
  382    ->  send(T, append, string('%s:', Name?label_name), bold, right),
  383        format(atom(AValue), '~q', [Value]),
  384        send(T, append, AValue)
  385    ;   send(T, append, Prop?label_name, colspan := 2)
  386    ),
  387    send(T, next_row).
  388
  389:- pce_end_class(prolog_predicate_info_window).
  390
  391
  392:- pce_begin_class(source_location_text, text,
  393                   "Indicate a source location").
  394
  395variable(location, source_location, get, "Represented location").
  396
  397initialise(T, Loc:source_location) :->
  398    "Create from source location"::
  399    send_super(T, initialise, Loc?print_name),
  400    send(T, slot, location, Loc).
  401
  402:- pce_global(@source_location_text_recogniser,
  403              new(handler_group(@arm_recogniser,
  404                                click_gesture(left, '', single,
  405                                              message(@receiver, edit))))).
  406
  407event(T, Ev:event) :->
  408    (   send_super(T, event, Ev)
  409    ->  true
  410    ;   send(@source_location_text_recogniser, event, Ev)
  411    ).
  412
  413
  414arm(TF, Val:bool) :->
  415    "Preview activiity"::
  416    (   Val == @on
  417    ->  send(TF, underline, @on)
  418    ;   send(TF, underline, @off)
  419    ).
  420
  421edit(T) :->
  422    get(T, location, Loc),
  423    send(@emacs, goto_source_location, Loc, tab).
  424
  425:- pce_end_class(source_location_text)