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)  1985-2002, 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(man_data,
36        [
37        ]).
38
39:- use_module(library(pce)).
40:- use_module(util).
41:- consult(classmap).
42:- require([ absolute_file_name/3
43           , append/3
44           , between/3
45           , term_to_atom/2
46           ]).
47
48%       find_module(+Name, +Create, -Module)
49%
50%       Find/create a manual module with the given name.  Bypasses
51%       @manual to avoid having to use the GUI.
52
53find_module(Name, Create, Module) :-
54    new(Space, man_space(reference)),
55    (   send(Space, ensure_loaded, Name)
56    ->  get(Space, module, Name, Module)
57    ;   Create == @on
58    ->  new(Module, man_module(Space, Name))
59    ;   fail
60    ).
61
62
63                /********************************
64                *     SPECIFIC MANUAL CARDS     *
65                ********************************/
66
67:- pce_begin_class(man_class_card(identifier), man_card,
68                   "Manual card of a class").
69
70variable(user_interface,        string*,        get,
71         "Description of user interface").
72variable(bugs,                  string*,        get,
73         "Known bugs/anomalities").
74
75
76initialise(C, Class:class) :->
77    "Initialise from class"::
78    send(C, send_super, initialise,
79         Class?man_module, Class?name, Class?man_id).
80
81
82object(C, Class:class) :<-
83    "Get associated class"::
84    get(C, identifier, Name),
85    name(Name, [0'C, 0'. | S0]),
86    name(ClassName, S0),
87    get(@classes, member, ClassName, Class).
88
89:- pce_end_class.
90
91
92:- pce_begin_class(man_variable_card(identifier), man_card,
93                   "Manual card of an instance variable").
94
95variable(defaults,      string*,        get, "Default value").
96
97initialise(C, Var:variable) :->
98    "Initialise from variable"::
99    send(C, send_super, initialise,
100         Var?man_module, Var?name, Var?man_id).
101
102object(C, Var:variable) :<-
103    "Get associated instance variable"::
104    get(C, identifier, Name),
105    name(Name, [0'V, 0'. |S0]),
106    append(S1, [0'.|S2], S0),
107    name(ClassName, S1),
108    name(VarName, S2),
109    get(@classes, member, ClassName, Class),
110    get(Class, instance_variable, VarName, Var).
111
112:- pce_end_class.
113
114
115:- pce_begin_class(man_method_card(identifier), man_card,
116                   "Manual card of a method").
117
118variable(diagnostics,   string*,        both,
119         "Possible error conditions/messages").
120variable(defaults,      string*,        get,
121         "Default value").
122variable(bugs,          string*,        get,
123         "Known problems").
124
125initialise(C, M:method) :->
126    "Initialise from method"::
127    send(C, send_super, initialise, M?man_module, M?name, M?man_id).
128
129object(C, Method:method) :<-
130    "Get associated method"::
131    get(C, identifier, Name),
132    name(Name, [0'M, 0'. |S0]),
133    append(S1, [0'.,T, 0'.|S2], S0),
134    name(ClassName, S1),
135    name(MethodName, S2),
136    get(@classes, member, ClassName, Class),
137    (   T == 0'S
138    ->  get(Class, send_method, MethodName, Method)
139    ;   get(Class, get_method, MethodName, Method)
140    ).
141
142:- pce_end_class.
143
144
145:- pce_begin_class(man_class_variable_card(identifier), man_card,
146                   "Manual card of a class variable").
147
148variable(defaults,      string*,        get,
149         "Default value").
150
151initialise(C, R:class_variable) :->
152    "Initialise from resource"::
153    send(C, send_super, initialise, R?man_module, R?name, R?man_id).
154
155object(C, R:class_variable) :<-
156    "Get associated resource"::
157    get(C, identifier, Name),
158    name(Name, [0'R, 0'. |S0]),
159    append(S1, [0'.|S2], S0),
160    name(ClassName, S1),
161    name(ResName, S2),
162    get(@classes, member, ClassName, Class),
163    get(Class, class_variable, ResName, R).
164
165:- pce_end_class.
166
167
168:- pce_begin_class(man_resource_card, man_class_variable_card,
169                   "Backward compatibility handling").
170:- pce_end_class.
171
172
173:- pce_begin_class(man_error_card(identifier), man_card,
174                   "Manual card of an error").
175
176
177initialise(C, E:error) :->
178    "Initialise from method"::
179    send(C, send_super, initialise, E?man_module, E?id, E?man_id).
180
181
182object(C, Error:error) :<-
183    "Get associated error"::
184    get(C, identifier, ManId),
185    atom_concat('!.', ErrId, ManId),
186    get(@pce, convert, ErrId, error, Error).
187
188:- pce_end_class.
189
190
191:- pce_begin_class(man_group_card(name), man_card,
192                   "Describe functional group of methods").
193
194variable(index, int, get, "Index to preserve the order").
195
196initialise(G, Module:man_module, Name:name, Idx:int, Summary:[string]) :->
197    "Initialise from group name"::
198    send(G, send_super, initialise, Module, Name, Name),
199    (   Summary \== @default
200    ->  send(G, store, summary, Summary)
201    ;   true
202    ),
203    send(G, store, index, Idx).
204
205
206object(G, Name:name) :<-
207    "Get associated group name"::
208    get(G, name, Name).
209
210:- pce_end_class.
211
212
213                /********************************
214                *      OTHER MANUAL CARDS       *
215                ********************************/
216
217:- pce_begin_class(man_topic_card(name), man_card,
218                   "Hierarchical organisation on topics").
219
220variable(super,         chain*,         get, "Super topic(s)").
221variable(subs,          chain*,         get, "Sub topics").
222
223man_id(_Card, Id) :<-
224    "Identifier of card type"::
225    Id = 'T'.
226
227:- pce_end_class.
228
229
230:- pce_begin_class(man_object_card(name), man_card,
231                   "Description of global PCE object").
232
233initialise(C, G:man_global) :->
234    "Initialise from global object holder"::
235    send(C, send_super, initialise, G?man_module, G?name, G?man_id).
236
237
238man_id(_Card, Id) :<-
239    "Identifier of card type"::
240    Id = 'O'.
241
242
243object(C, O:man_global) :<-
244    "Get associated global object"::
245    get(C, identifier, Name),
246    atom_concat('O.', Reference, Name),
247    new(O, man_global(Reference)).
248
249delete_unreferenced(C) :->
250    get(C, identifier, Name),
251    (   atom_concat('O.', Reference, Name),
252        object(@Reference)
253    ->  true
254    ;   format(user_error, 'Deleting card ~w~n', [Name]),
255        free(C)
256    ).
257
258:- pce_end_class.
259
260:- pce_begin_class(man_predicate_card(name), man_card,
261                   "Description of a Prolog predicate").
262
263variable(diagnostics,   string*,        both,
264         "Possible error conditions/messages").
265
266initialise(Card, M:man_module, Name:name) :->
267    "Define id to be the predicate name"::
268    send(Card, slot, name, Name),
269    get(Card, predicate_name, Id),
270    send(Card, send_super, initialise, M, Name, Id).
271
272
273store(Card, Slot:name, Value:any) :->
274    "Change id if name changes"::
275    send(Card, send_super, store, Slot, Value),
276    (   Slot == name
277    ->  get(Card, predicate_name, Id),
278        send(Card, identifier, Id)
279    ;   true
280    ).
281
282
283man_id(_Card, Id) :<-
284    "Identifier of card type"::
285    Id = 'P'.
286
287predicate_name(Card, PredName:name) :<-
288    get(Card, name, Name),
289    new(R, regex('(\\w+)')),
290    send(R, search, Name),
291    get(R, register_value, Name, 1, name, PredName).
292
293:- pce_end_class.
294
295:- pce_begin_class(man_example_card(name), man_card,
296                   "Example code").
297
298initialise(Card, M:man_module, Name:name) :->
299    "Define id to be the predicate name"::
300    send(Card, slot, name, Name),
301    get(Card, id, Id),
302    send(Card, send_super, initialise, M, Name, Id),
303    send(Card, store, description, 'Enter description here'),
304    send(Card, store, code, 'Enter code here').
305
306
307store(Card, Slot:name, Value:any) :->
308    "Change id if name changes"::
309    send(Card, send_super, store, Slot, Value),
310    (   Slot == name
311    ->  get(Card, id, Id),
312        send(Card, identifier, Id)
313    ;   true
314    ).
315
316
317man_id(_Card, Id) :<-
318    "Identifier of card type"::
319    Id = 'E'.
320
321variable(code,          string*,        both,
322         "Source code of example").
323
324id(Card, Id) :<-
325    get(Card, name, Name),
326    new(S, string('%s', Name)),
327    send(S, downcase),
328    send(S, translate, ' ', '_'),
329    get(S, value, Id).
330
331:- pce_end_class.
332
333:- pce_begin_class(man_browser_card(name), man_card,
334                   "Documentation of a Manual Browser").
335
336variable(tool_name,             name*,          both,
337         "Name of the tool documented").
338variable(user_interface,        string*,        get,
339         "Description of UI behaviour").
340variable(bugs,                  string*,        get,
341         "Known problems").
342
343man_id(_Card, Id) :<-
344    "Identifier of card type"::
345    Id = 'B'.
346
347:- pce_end_class.
348
349:- pce_begin_class(man_change_card(name), man_card,
350                   "Documentation of a change to PCE").
351
352man_id(_Card, Id) :<-
353    "Identifier of card type"::
354    Id = '~'.
355
356:- pce_end_class.
357
358
359:- pce_begin_class(man_bug_card(name), man_card,
360                   "Documentation of a bug fix to PCE").
361
362man_id(_Card, Id) :<-
363    "Identifier of card type"::
364    Id = '+'.
365
366:- pce_end_class.
367
368
369                /********************************
370                *           MAN_GLOBAL          *
371                ********************************/
372
373:- pce_global(@man_globals, new(hash_table)).
374
375:- pce_begin_class(man_global(reference), object).
376
377variable(reference,     name,    get,   "Reference name of object").
378variable(man_summary,   string,  get,   "Summary string (if available)").
379
380initialise(G, Name:name, Summary:[string]*) :->
381    "Create from name"::
382    send(G, slot, reference, Name),
383    (   (Summary == @default ; Summary == @nil)
384    ->  object_summary(Name, S)
385    ;   S = Summary
386    ),
387    class_name(@Name, ClassName),
388    send(G, slot, man_summary,
389         string('O\t@%s/%s\t%s', Name, ClassName, S)),
390    send(@man_globals, append, Name, G).
391
392lookup(_, Name:name, G) :<-
393    "Lookup existing one"::
394    get(@man_globals, member, Name, G).
395
396
397group(G, Group:name) :<-
398    "Group (class name)"::
399    get(G, reference, Reference),
400    get(@Reference, '_class_name', Group).
401
402
403summary(_G, _:string) :<-
404    fail.
405
406class_name(Ref, ClassName) :-
407    object(Ref),
408    !,
409    get(Ref, '_class_name', ClassName).
410
411object_summary(Name, Summary) :-
412    object(@Name),
413    !,
414    (   get(@Name, '_class', Class),
415        get(Class, get_method, summary, _),
416        get(@Name, summary, Summary)
417    ->  true
418    ;   object(@Name, Term),
419        term_to_atom(Term, Summary)
420    ).
421
422
423man_module(_G, Create:[bool], Module:man_module) :<-
424    "objects module"::
425    find_module(objects, Create, Module).
426
427man_id(G, Id:name) :<-
428    get('O.', append, G?reference, Id).
429
430
431name(G, Name:name) :<-
432    "@Reference"::
433    get(G, reference, Reference),
434    get(@, append, Reference, Name).
435
436
437man_name(G, Name:string) :<-
438    "Name for relation browser"::
439    new(Name, string('O\t@%s', G?reference)).
440
441
442man_card_class(_G, Class:class) :<-
443    "Name for documentation card"::
444    get(@pce, convert, man_object_card, class, Class).
445
446context(G, Class:class) :<-
447    "Return context class for jumping"::
448    get(G, reference, Id),
449    object(@Id),
450    get(@Id, '_class', Class).
451
452has_source(_G) :->
453    "Just fail"::
454    fail.
455
456:- pce_end_class.
457
458
459                /********************************
460                *           EXTENSIONS          *
461                ********************************/
462
463:- pce_extend_class(object).
464:- pce_group(manual).
465
466man_module_name(_Obj, Module) :<-
467    "Module name for global objects"::
468    Module = objects.
469
470
471man_module(Obj, Create:[bool], Module) :<-
472    "Module for global objects"::
473    new(Space, man_space(reference)),
474    get(Obj, man_module_name, ModuleName),
475    (   get(Space, module, ModuleName, @on, Module)
476    ->  true
477    ;   Create == @on
478    ->  new(Module, man_module(Space, ModuleName))
479    ).
480
481
482man_card(Obj, Create:[bool], Card) :<-
483    "Manual card for object"::
484    get(Obj, man_module, @on, Module),
485    (   get(Module, card, Obj?man_id, Card)
486    ->  true
487    ;   Create == @on
488    ->  get(Obj, man_create_card, Card)
489    ).
490
491
492has_help(Obj) :->
493    "Test if object is documented"::
494    (   get(Obj, man_card, Card),
495        (   get(Card, description, Description), Description \== @nil
496        ;   get(Card, related, see_also, _)
497        )
498    ;   get(Obj, man_inherited_attribute, description, _)
499    ).
500
501
502man_create_card(Obj, Card) :<-
503    "Create manual card for object"::
504    send(Obj, has_get_method, man_card_class),
505    get(Obj?man_card_class, instance, Obj, Card).
506
507
508man_attribute(Obj, Slot:name, Value:string*) :->
509    "Store a slot of the manual card"::
510    send(?(Obj, man_card, @on), store, Slot, Value).
511
512
513man_attribute(Obj, Slot:name, Value) :<-
514    "Fetch a manual attribute"::
515    (   get(Obj, man_card, Card),
516        get(Card, fetch, Slot, Value)
517    ->  true
518    ;   send(Obj, has_get_method, Slot),
519        get(Obj, Slot, Value)
520    ),
521    Value \== @nil.
522
523
524man_inherited_attribute(Obj, Att:name, Tuple:tuple) :<-
525    "Default inherited value"::
526    (   get(Obj, man_inherit_object, Att, From),
527        get(From, man_attribute, Att, Value)
528    ->  new(Tuple, tuple(From, Value))
529    ;   get(Obj, man_card, Card),
530        get(Card, inherited_fetch, Att, Tuple)
531    ).
532
533
534man_inherit_object(_Obj, _Att:name, _Obj2:object) :<-
535    "Object from which to inherit attribute"::
536    fail.
537
538
539man_relate(Obj1, Type:name, Obj2:object) :->
540    "Create a manual relation"::
541    send(?(Obj1, man_card, @on), relate,
542         Type, ?(Obj2, man_card, @on)).
543
544
545man_unrelate(Obj1, Type:name, Obj2:object) :->
546    "Destroy a manual relation"::
547    send(?(Obj1, man_card, @on), unrelate,
548         Type, ?(Obj2, man_card, @on)).
549
550
551man_related(Obj1, Type:name, Obj2:object) :->
552    "Create a manual relation"::
553    send(?(Obj1, man_card), related, Type, Obj2?man_card).
554
555
556man_related(Obj, Type:name, Chain) :<-
557    "New chain with related objects"::
558    get(?(?(Obj, man_card), related, Type), map,
559        new(?(@arg1, object)), Chain).
560
561
562man_name(Obj, Name) :<-
563    "Name for relation browser"::
564    new(Name, string),
565    send(Name, format, 'O\t@%s', Obj?object_reference).
566
567man_creator(_Obj, _) :<-
568    "Global default"::
569    fail.
570
571:- pce_end_class.
572
573:- pce_extend_class(class).
574:- pce_group(manual).
575
576man_module_name(Class, Module) :<-
577    "Manual module name for class"::
578    get(Class, name, Name),
579    (   mapped_class_name(Name, Mapped)
580    ;   Mapped = Name
581    ),
582    !,
583    atom_concat('class/', Mapped, Module).
584
585
586man_card_class(_Class, Class:class) :<-
587    "Manual card type"::
588    get(@pce, convert, man_class_card, class, Class).
589
590
591man_name(Class, Name:string) :<-
592    "Name for relation browser"::
593    new(Name, string('C\t%s', Class?name)).
594
595
596has_source(Class) :->
597    "Test if object may have associated sources"::
598    \+ get(Class, creator, built_in).
599
600
601source(Class, Loc:source_location) :<-
602    "Find souce location of class definition"::
603    get(Class, slot, source, Loc), Loc \== @nil,
604    get(Loc, line_no, LineNo), LineNo \== @nil,
605    fix_source_path(Loc, Class).
606
607
608%       fix_source_path(+SourceLocation, +Context)
609%
610%       Fixes  the  location  of  a  registered   source  due  to  moved
611%       installation. The 2nd and 3th clause exploit the Prolog database
612%       to re-locate the source. It is used to find the correct location
613%       if a class is  loaded  from  a   .QLF  file  and  the  installed
614%       hierarchy is moved.
615
616fix_source_path(Loc, _Ctx) :-
617    get(Loc, file_name, Name),
618    send(file(Name), exists, @on),
619    !.
620fix_source_path(Loc, Class) :-          % find from Prolog source-database
621    send(Class, instance_of, class),
622    get(Class, name, ClassName),
623    clause(pce_principal:pce_class(ClassName, _, _, _, _, _), true, Ref),
624    clause_property(Ref, file(File)),
625    !,
626    send(Loc, file_name, File).
627fix_source_path(Loc, SM) :-             % find from Prolog source-database
628    (   send(SM, instance_of, send_method)
629    ->  Head = pce_lazy_send_method(Name, ClassName, _)
630    ;   send(SM, instance_of, get_method)
631    ->  Head = pce_lazy_get_method(Name, ClassName, _)
632    ),
633    get(SM, context, Class),
634    get(Class, name, ClassName),
635    get(SM, name, Name),
636    clause(pce_principal:Head, true, Ref),
637    clause_property(Ref, file(File)),
638    !,
639    send(Loc, file_name, File).
640fix_source_path(Loc, _Ctx) :-
641    (   pce_host:property(system_source_prefix(Prefix)),
642        atom_codes(Prefix, PrefixChars),
643        get(Loc, file_name, Name),
644        atom_codes(Name, Chars),
645        append(_, S1, Chars),
646        append(PrefixChars, PwLocalChars, S1)
647    ->  atom_codes(PwLocal, PwLocalChars),
648        absolute_file_name(pce(PwLocal),
649                           [ access(read)
650                           ],
651                           Path),
652        send(Loc, slot, file_name, Path)
653    ).
654
655man_header(Class, Str:string) :<-
656    "Header for class browser"::
657    get(Class, name, ClassName),
658    new(Str, string('%s(', ClassName)),
659    get(Class, send_method, initialise, IM),
660    get(IM, types, Types),
661    get(Class, term_names, Names),
662    append_arguments(Types, Names, Str),
663    send(Str, append, ')').
664
665append_arguments(Types, Names, Str) :-
666    between(1, 10000, Idx),
667    (   get(Types, element, Idx, Type)
668    ->  (Idx \== 1 -> send(Str, append, ', ') ; true),
669        get(Type, name, TypeName),
670        (   get(Type, argument_name, ArgName),
671            ArgName \== @nil,
672            ArgName \== TypeName
673        ->  send(Str, append, string('%s=%s', ArgName, TypeName))
674        ;   Names \== @nil,
675            get(Names, element, Idx, ArgName)
676        ->  send(Str, append, string('%s=%s', ArgName, TypeName))
677        ;   send(Str, append, TypeName)
678        ),
679        fail
680    ;   !
681    ).
682
683man_delegate_header(Class, Str:string) :<-
684    "Description of delegation behaviour"::
685    new(Str, string),
686    (   get(Class, delegate, Chain),
687        Chain \== @nil,
688        \+ send(Chain, empty)
689    ->  send(Chain, for_all,
690             and(if(Chain?head \== @arg1,
691                    message(Str, append, ', ')),
692                 message(Str, append,
693                         create(string, '%s (%s)',
694                                @arg1?name, @arg1?type?name))))
695    ;   true
696    ).
697
698
699man_creator(Class, Creator:name) :<-
700    "Creator used by manual filters"::
701    get(Class, creator, Creator).
702
703:- pce_end_class.
704
705:- pce_extend_class(variable).
706:- pce_group(manual).
707
708man_module_name(Var, Module) :<-
709    "Manual module name for variable"::
710    get(Var?context, man_module_name, Module).
711
712man_card_class(_Var, Class:class) :<-
713    "Manual card type"::
714    get(@pce, convert, man_variable_card, class, Class).
715
716man_name(Var, ManName:string) :<-
717    "Name for relation browser"::
718    get(Var, context_name, ClassName),
719    get(Var, access_arrow, Arrow),
720    get(Var, name, Name),
721    new(ManName, string('V\t%s %s%s', ClassName, Arrow, Name)).
722
723
724man_header(Var, Header:string) :<-
725    "Header for card viewer"::
726    get(Var, context_name, ClassName),
727    get(Var, access_arrow, Arrow),
728    get(Var, name, Name),
729    get(Var, type, Type),
730    get(Type, name, TypeName),
731    new(Header, string('V\t%s %s%s: %s',
732                       ClassName, Arrow, Name, TypeName)).
733
734has_source(Var) :->
735    "Test if object may have associated sources"::
736    send(Var?context, has_source).
737
738source(Var, Src) :<-
739    "Find source (same as related class"::
740    get(Var, context, Class), Class \== @nil,
741    get(Class, source, Src).
742
743man_inherit_object(Var, Att:name, R:class_variable) :<-
744    "Lookup default in class-variable"::
745    Att == defaults,
746    get(Var?context, class_variable, Var?name, R).
747
748man_creator(Var, Creator:name) :<-
749    "<-creator of the <-context"::
750    get(Var?context, creator, Creator).
751
752:- pce_end_class.
753
754super_class(Class, Super) :-
755    get(Class, super_class, Super), Super \== @nil.
756super_class(Class, Super) :-
757    get(Class, super_class, Above), Above \== @nil,
758    super_class(Above, Super).
759
760:- pce_extend_class(method).
761:- pce_group(manual).
762
763man_module_name(M, Module) :<-
764    "Manual module name for method"::
765    get(M?context, man_module_name, Module).
766
767
768man_card_class(_M, Class:class) :<-
769    "Manual card type"::
770    get(@pce, convert, man_method_card, class, Class).
771
772
773has_source(M) :->
774    "Test if object may have associated sources"::
775    get(M, slot, source, Loc), Loc \== @nil,
776    get(Loc, line_no, LineNo), LineNo \== @nil.
777
778
779source(M, Loc) :<-
780    "Find source definition"::
781    get(M, slot, source, Loc), Loc \== @nil,
782    get(Loc, line_no, LineNo), LineNo \== @nil,
783    fix_source_path(Loc, M).
784
785
786has_help(M) :->
787    "Look for inherited too"::
788    (   send(M, send_super, has_help)
789    ->  true
790    ;   get(M, context, Class),
791        get(M, name, Selector),
792        get(Class, instance_variable, Selector, Var),
793        send(Var, has_help)
794    ).
795
796help(M) :->
797    "Open manual browser on method"::
798    manpce(M).
799
800edit(M) :->
801    "Edit source of method"::
802    (   get(M, source, Location)
803    ->  edit(Location)
804    ;   send(M, report, warning, 'No source'),
805        fail
806    ).
807
808man_creator(M, Creator:name) :<-
809    "<-creator of the <-context"::
810    get(M?context, creator, Creator).
811
812:- pce_end_class.
813
814:- pce_extend_class(error).
815:- pce_group(manual).
816
817man_module_name(_E, Module:name) :<-
818    "Manual module name for method"::
819    Module = errors.
820
821summary(E, Summary:string) :<-
822    get(E, format, Summary).
823
824name(E, Name:name) :<-
825    get(E, id, Name).
826
827man_summary(E, Summary:string) :<-
828    "Summary string"::
829    get(E, slot, format, Format),
830    new(Summary, string('!\t%s\t%s\t%s',
831                        E?id, E?kind, Format)),
832    send(Summary, translate, '\n', ' '),
833    (   send(E, has_help)
834    ->  send(Summary, append, ' (+)')
835    ;   true
836    ).
837
838man_card_class(_E, Class:class) :<-
839    "Manual card type"::
840    get(@pce, convert, man_error_card, class, Class).
841
842man_id(E, Id:name) :<-
843    "Identifier of object"::
844    get(E, id, ErrId),
845    get('!.', append, ErrId, Id).
846
847man_name(E, Name:name) :<-
848    "Name for relation browser"::
849    get(E, id, ErrId),
850    get('! ', append, ErrId, Name).
851
852man_creator(_E, Creator:name) :<-
853    "For now, always returns built_in"::
854    Creator = built_in.
855
856:- pce_end_class.
857
858%       Type pretty printing
859
860method_types(M, Str) :-
861    get(M, types, Types),
862    get(Types, size, Size),
863    (   Size > 0
864    ->  send(Str, append, ': ')
865    ;   true
866    ),
867    between(1, Size, Arg),
868        get(Types, element, Arg, Type),
869        get(Type, fullname, Name),
870        send(Str, append, Name),
871        (   Arg < Size
872        ->  send(Str, append, ', ')
873        ;   true
874        ),
875    fail ; true.
876
877
878:- pce_extend_class(send_method).
879:- pce_group(manual).
880
881man_name(M, Name) :<-
882    "Name for relation browser"::
883    new(Name, string('M\t%s->%s', M?context?name, M?name)).
884
885
886man_header(M, Header:string) :<-
887    "Header for card browser"::
888    get(M, context, Ctx),
889    get(Ctx, name, ClassName),
890    get(M, name, Name),
891    new(Header, string('M\t%s->%s', ClassName, Name)),
892    method_types(M, Header).
893
894
895man_inherit_object(M, Att:name, Impl:behaviour) :<-
896    "Inherit from variable if not available"::
897    get(M, context, Class),
898    get(M, name, Selector),
899    (   get(Class, instance_variable, Selector, Impl)
900    ->  true
901    ;   super_class(Class, Super),
902        get(Super, send_method, Selector, Impl),
903        (   (  get(Impl, man_attribute, Att, _)
904            ;  \+ super_class(Super, _)
905            )
906        ->  !
907        )
908    ).
909
910:- pce_end_class.
911
912:- pce_extend_class(get_method).
913:- pce_group(manual).
914
915man_name(M, Name) :<-
916    "Name for relation browser"::
917    new(Name, string),
918    send(Name, format, 'M\t%s<-%s', M?context?name, M?name).
919
920man_header(M, Header:string) :<-
921    "Header for card browser"::
922    get(M, context, Ctx),
923    get(Ctx, name, ClassName),
924    get(M, name, Name),
925    new(Header, string('M\t%s<-%s', ClassName, Name)),
926    method_types(M, Header),
927    send(Header, append, ' ==>'),
928    get(M, return_type, Type),
929    get(Type, fullname, TypeName),
930    send(Header, append, TypeName).
931
932man_inherit_object(M, Att:name, Impl:'variable|method') :<-
933    "Inherit from variable if not available"::
934    get(M, context, Class),
935    get(M, name, Selector),
936    (   get(Class, instance_variable, Selector, Impl)
937    ->  true
938    ;   super_class(Class, Super),
939        get(Super, get_method, Selector, Impl),
940        (   (  get(Impl, man_attribute, Att, _)
941            ;  \+ super_class(Super, _)
942            )
943        ->  !
944        )
945    ).
946
947
948:- pce_end_class.
949
950:- pce_extend_class(class_variable).
951:- pce_group(manual).
952
953man_module_name(R, Module) :<-
954    "Manual module name for method"::
955    get(R?context, man_module_name, Module).
956
957
958man_card_class(_R, Class:class) :<-
959    "Manual card type"::
960    get(@pce, convert, man_class_variable_card, class, Class).
961
962
963man_name(R, Name) :<-
964    "Name for relation browser"::
965    get(R, value, Value),
966    portray_object(Value, Term),
967    term_to_atom(Term, ValueDescription),
968    new(Name, string('R\t%s.%s: %s',
969                     R?context?name, R?name, ValueDescription)).
970
971
972has_source(_R) :->
973    "Test if object may have associated sources"::
974    true.
975
976
977man_attribute(R, Att:name, Value) :<-
978    "Get default value of class variable"::
979    (   Att == defaults
980    ->  get(R, default, Value)
981    ;   get(R, get_super, man_attribute, Att, Value)
982    ).
983
984
985man_inherited_attribute(R, Att:name, Tuple:tuple) :<-
986    "Inherit description from variable"::
987    Att == description,
988    get(R, context, Class),
989    get(R, name, Selector),
990    get(Class, instance_variable, Selector, Var),
991    get(Var, man_attribute, Att, Value),
992    new(Tuple, tuple(Var, Value)).
993
994
995source(R, Src) :<-
996    "Find source (same as related class"::
997    get(R, context, Class),
998    get(Class, source, Src).
999
1000
1001man_creator(R, Creator:name) :<-
1002    "<-creator of the <-context"::
1003    get(R?context, creator, Creator).
1004
1005:- pce_end_class.
1006
1007