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(Head)
  99    ->  functor(Head, 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).