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