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