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_manual, []).
  36
  37:- use_module(library(pce)).
  38:- use_module(library(persistent_frame)).
  39:- use_module(library(pce_help_file)).
  40:- use_module(util).
  41:- require([ absolute_file_name/3
  42           , auto_call/1
  43           , default/3
  44           , forall/2
  45           , ignore/1
  46           , send_list/3
  47           ]).
  48
  49resource(man_icon, image, image('32x32/books.xpm')).
  50
  51:- pce_autoload(event_viewer, library('man/showevent')).
  52
  53/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  54                            OVERALL ARCHITECTURE
  55
  56The following diagram  provides an overall  view of the  design of the
  57manual tools.
  58
  59                         ManualTool
  60                             |
  61                             | (select)
  62                             |
  63                             V           | ClassBrowser
  64                           Tools         | ClassHierarchy
  65                             |           | TopicBrowser
  66                             |           | KeywordBrowser
  67                             |
  68                             | (find/browse)
  69                             V
  70                   [Type] Name [Summary]
  71                            /|\
  72       Examples----/-------- | -----------\
  73                  /          |             \
  74                 /           |              \
  75             Sources      Textual          Relations
  76                        Attributes    [Type] Name [Summary]
  77
  78
  79The communication between  the tools is arranged  via messages send to
  80and possible broadcasted by ManualTool.  These messages are:
  81
  82    ->request_selection: man_frame, object*, [bool]
  83        Set the <-selection and <-selection_holder attribute of the
  84        ManualTool and broadcasts the following messages:
  85
  86                * SelectionHolder ->release_selection
  87                * AllTools        ->selected: object*
  88
  89        If bool == @on, the card viewer is started automatically
  90
  91    ->tool_focus: object*
  92        Set the focus of all tools.  Broadcasted to all tools.
  93
  94    ->relate: object
  95        Request manual to relate selection to object.
  96
  97    ->edit_mode: bool
  98        Switch edit_mode on/off.  Broadcasted to all tools.
  99- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 100
 101:- pce_begin_class(man_manual, persistent_frame,
 102                   "PCE manual main object").
 103
 104class_variable(geometry,        geometry,               '+0+0').
 105class_variable(user_scope,      chain,                  chain(basic, user),
 106         "Default scoping of manual material").
 107class_variable(edit,            bool,                   @off).
 108
 109variable(selection,             object*,        get,
 110         "Currently selected object").
 111variable(selection_holder,      man_frame*,     get,
 112         "Tool holding selection").
 113variable(tool_focus,            object*,        get,
 114         "Arg of last ->tool_focus").
 115variable(tools,                 sheet,          get,
 116         "Tool-name --> tool mapping").
 117variable(edit_mode,             bool,           get,
 118         "Can database be edited?").
 119variable(space,                 man_space,      get,
 120         "Manual module collection").
 121variable(focus_history,         chain,          get,
 122         "Chain of focused cards").
 123variable(selection_history,     chain,          get,
 124         "Chain of selected cards").
 125variable(maintainer,            bool,           get,
 126         "Indicates the user is a maintainer").
 127variable(exit_message,          code*,          get,
 128         "Message called on exit").
 129variable(user_scope,            chain,          get,
 130         "Types in user's scope").
 131variable(search_patterns,       chain*,         both,
 132         "Search patterns to be highlighted").
 133
 134
 135                /********************************
 136                *            CREATE             *
 137                ********************************/
 138
 139initialise(M, Dir:[directory]) :->
 140    "Create the manual main object"::
 141    send(M, send_super, initialise, 'XPCE Manual'),
 142    send(M, icon, resource(man_icon)),
 143    send(M, can_resize, @off),
 144    send(M, done_message, message(M, quit)),
 145    get(M, class_variable_value, user_scope, Scope),
 146    get(M, class_variable_value, edit, Edit),
 147    send(M, slot, maintainer, Edit),
 148    default(Dir, directory('$PCEHOME/man/reference'), Directory),
 149    send(M, check_directory, Directory),
 150    send(M, slot, space, new(Space, man_space(reference, Directory))),
 151    send(M, slot, tools, new(sheet)),
 152    send(M, slot, edit_mode, @off),
 153    send(M, slot, focus_history, new(chain)),
 154    send(M, slot, selection_history, new(chain)),
 155    send(M, slot, user_scope, Scope),
 156
 157    send(Space, attribute, attribute(report_to, M)),
 158    send(M, append, new(D, dialog)),
 159    send(M, fill_dialog, D),
 160
 161    ifmaintainer((
 162          send(@pce, exit_message, new(Msg, message(M, save_if_modified))),
 163          send(M, slot, exit_message, Msg))),
 164
 165    send(M, check_runtime),
 166    send(M, report, status, 'For help, see `File'' menu').
 167
 168
 169unlink(M) :->
 170    "Manual is destroyed"::
 171    get(M, space, Space),
 172    send(Space, delete_attribute, report_to),
 173    get(M, exit_message, Msg),
 174    ignore(send(@pce?exit_messages, delete, Msg)),
 175    send(M, send_super, unlink).
 176
 177
 178check_directory(M, Dir:directory) :->
 179    "Check the manual directory"::
 180    (   send(Dir, exists)
 181    ->  true
 182    ;   send(M, report, error, 'Cannot find manual directory %s', Dir?path)
 183    ).
 184
 185
 186check_runtime(_M) :->
 187    "Check for runtime system"::
 188    (   get(@pce, is_runtime_system, @on)
 189    ->  send(@display, inform,
 190             '%s.  %s\n%s %s',
 191             'This is a runtime version of XPCE',
 192             'Most of the manual will not work.',
 193             'Contact xpce-request@swi.psy.uva.nl',
 194             'for a information on the development version')
 195    ;   true
 196    ).
 197
 198
 199fill_dialog(M, D) :->
 200    send(D, gap, size(5, 5)),
 201    send(D, append, new(MB, menu_bar)),
 202    send(MB, append, new(F, popup(file))),
 203    send(MB, append, new(V, popup(browsers,
 204                                  message(M, start_tool, @arg1)))),
 205    send(MB, append, new(T, popup(tools,
 206                                  message(M, start_tool, @arg1)))),
 207    send(MB, append, new(H, popup(history))),
 208
 209    /* FILE menu */
 210
 211    send_list(F, append,
 212              [ menu_item(about,
 213                          message(M, about)),
 214                menu_item(help,
 215                          message(M, help)),
 216                menu_item(demo_programs,
 217                          message(M, start_demo),
 218                          @default, @on),
 219                menu_item('ChangeLog',
 220                          message(M, changelog)),
 221                menu_item('FAQ',
 222                          message(M, faq),
 223                          @default, @on),
 224                new(Prefs, popup(edit_preferences))
 225         ]),
 226    send(Prefs, end_group, @on),
 227    send_list(Prefs, append,
 228              [ menu_item('XPCE User Defaults',
 229                          message(M, edit_preferences, xpce_user)),
 230                menu_item('XPCE System Defaults',
 231                          message(M, edit_preferences, xpce),
 232                          end_group := @on),
 233                menu_item('Prolog Defaults',
 234                          message(M, edit_preferences, prolog))
 235              ]),
 236    (   get(@pce, window_system, windows)
 237    ->  send(Prefs, append,
 238             menu_item('Prolog Stack Limits',
 239                       message(M, edit_prolog_registry)))
 240    ;   true
 241    ),
 242    (   get(M, maintainer, @on)
 243    ->  send_list(F, append,
 244                  [ menu_item(edit_mode,
 245                              message(M, toggle_edit_mode))
 246                  , menu_item(list_modules,
 247                              message(M, list_modules))
 248                  , menu_item(list_all_modules,
 249                              message(M, list_all_modules))
 250                  , menu_item(save_manual,
 251                              message(M, save_if_modified, @off),
 252                              @default, @on,
 253                              M?modified == @on)
 254                  ])
 255    ;   true
 256    ),
 257    send_list(F, append,
 258              [ menu_item(quit,
 259                          message(M, quit)),
 260                menu_item(quit_pce,
 261                          message(M, quit_pce))
 262              ]),
 263
 264
 265    /* BROWSERS menu */
 266
 267    send_list(V, append,
 268         [ menu_item(manual_tools,
 269                     end_group := @on),
 270           menu_item(class_hierarchy),
 271           menu_item(class_browser),
 272           menu_item(global_objects),
 273           menu_item(errors,
 274                     end_group := @on),
 275           menu_item(xpce_predicates,
 276                     @default,
 277                     'XPCE/Prolog predicates'),
 278           menu_item(prolog_manual,
 279                     message(M, help_on_prolog),
 280                     end_group := @on),
 281           menu_item(search),
 282           menu_item(group_overview),
 283           menu_item(examples,          end_group := @on)
 284         ]),
 285    (    get(M, maintainer, @on)
 286    ->   send_list(V, append,
 287         [ menu_item(class_finder,      end_group := @off)
 288         ])
 289    ;    true
 290    ),
 291
 292    /* TOOLS menu */
 293
 294    send_list(T, append,
 295         [ statistics,
 296           visual_hierarchy,
 297           inspector,
 298           gap,
 299           menu_item(event_viewer,
 300                     message(M, event_viewer)),
 301           gap,
 302           menu_item(prolog_graphical_tracer,
 303                     message(M, guitracer)),
 304           menu_item(prolog_navigator,
 305                     message(M, prolog_navigator)),
 306           menu_item(prolog_thread_monitor,
 307                     message(M, thread_monitor),
 308                     condition :=
 309                     ?(@prolog, current_prolog_flag, threads) == true),
 310           menu_item(emacs,
 311                     message(M, start_emacs)),
 312           gap,
 313           menu_item(dialog_editor,
 314                     message(M, dialog_editor)),
 315           menu_item(check_object_base,
 316                     message(M, check_object_base))
 317         ]),
 318
 319    /* HISTORY menu */
 320
 321    new(SI, menu_item(selection, @nil, @default, @off,
 322                      not(message(M?selection_history, empty)))),
 323    new(FI, menu_item(focus, @nil, @default, @off,
 324                      not(message(M?focus_history, empty)))),
 325    send(SI, popup,
 326         new(SH, popup(selection, message(M, select_history_menu,
 327                                          selection_history, @arg1)))),
 328    send(FI, popup,
 329         new(FH, popup(focus, message(M, select_history_menu,
 330                                      focus_history, @arg1)))),
 331
 332    send(SH, update_message, message(M, update_history_menu,
 333                                     selection_history, @receiver)),
 334    send(FH, update_message, message(M, update_history_menu,
 335                                     focus_history, @receiver)),
 336    send(H, append, SI),
 337    send(H, append, FI),
 338
 339    send(D, append, new(label)).
 340
 341
 342                /********************************
 343                *         STARTING TOOLS        *
 344                ********************************/
 345
 346start_tool(M, ToolName:name, Tool:frame) :<-
 347    "Start named tool"::
 348    (   get(M?tools, value, ToolName, Tool)
 349    ->  send(Tool, expose)
 350    ;   create_tool(M, ToolName, Tool),
 351        send(Tool, open)
 352    ->  send(M, register_tool, ToolName, Tool)
 353    ;   send(@display, inform, 'Failed to start %s', ToolName)
 354    ).
 355
 356start_tool(M, ToolName:name) :->
 357    "Start named tool"::
 358    get(M, start_tool, ToolName, _).
 359
 360register_tool(M, Name:name, Tool:man_frame) :->
 361    "Register frame as a menual tool"::
 362    send(Tool, slot, tool_name, Name),
 363    send(M?tools, append, attribute(Name, Tool)).
 364
 365
 366expose_tool(M, ToolName:name) :->
 367    "Expose named tool"::
 368    get(M?tools, value, ToolName, Tool),
 369    send(Tool, expose).
 370
 371
 372create_tool(M, Name, Tool) :-
 373    tool_class(Name, M, Term),
 374    new(Tool, Term).
 375
 376tool_class(class_browser,       M, man_class_browser(M)).
 377tool_class(class_finder,        M, man_class_browser(M)).
 378tool_class(class_hierarchy,     M, man_class_hierarchy(M)).
 379tool_class(search,              M, man_search_tool(M)).
 380tool_class(topics,              M, man_topic_browser(M)).
 381tool_class(card_viewer,         M, man_card_editor(M)).
 382tool_class(statistics,          M, man_statistics(M)).
 383tool_class(inspector,           M, isp_frame(M)).
 384tool_class(visual_hierarchy,    M, vis_frame(M)).
 385tool_class(global_objects,      M, man_object_browser(M)).
 386tool_class(errors,              M, man_error_browser(M)).
 387tool_class(manual_tools,        M,
 388           man_module_browser(M, tools, man_browser_card, 'Manual Tools')).
 389tool_class(xpce_predicates,     M,
 390           man_module_browser(M, predicates,
 391                              man_predicate_card, 'XPCE/Prolog Predicates')).
 392tool_class(examples,            M,
 393           man_module_browser(M, examples, man_example_card, 'XPCE Examples')).
 394tool_class(changes,             M,
 395           man_module_browser(M, changes, man_change_card, 'XPCE Changes')).
 396tool_class(group_overview,      M,
 397           man_group_browser(M, groups, 'Group Browser')).
 398
 399
 400                /********************************
 401                *          DESTROYING           *
 402                ********************************/
 403
 404destroy_tool(M, Tool:man_frame) :->
 405    "Destroy a tool"::
 406    (   get(M, selection_holder, Tool)
 407    ->  ignore(send(Tool, release_selection)),      % TBD: forward
 408        send(M, slot, selection_holder, @nil)
 409    ;   true
 410    ),
 411    send(M?tools, for_all,
 412         if(@arg1?value == Tool,
 413            message(M?tools, delete, @arg1?name))),
 414    send(Tool, destroy).
 415
 416
 417quit(M) :->
 418    "Quit Manual Tool"::
 419    send(M, save_if_modified),
 420%   send(@display, confirm, 'Quit all manual tools?'),
 421    send(M?tools, for_all, message(@arg1?value, quit)),
 422    send(M, destroy).
 423
 424
 425quit_pce(M) :->
 426    "Exit from PCE process"::
 427    send(M, save_if_modified),
 428    send(@display, confirm, 'Really exit PCE?'),
 429    send(@pce, die).
 430
 431
 432                 /*******************************
 433                 *         SAVE/MODIFIED        *
 434                 *******************************/
 435
 436modified(M, Modified:bool) :<-
 437    "See if manual database has been modified"::
 438    (   (   get(M?space, modified, @on)
 439        ;   object(@man_classification),
 440            get(@man_classification, modified, @on)
 441        )
 442    ->  Modified = @on
 443    ;   Modified = @off
 444    ).
 445
 446
 447save_if_modified(M, Ask:[bool]) :->
 448    "Save if some part has been modified"::
 449    (   get(M, modified, @on)
 450    ->  (   Ask \== @on
 451        ;   send(@display, confirm, 'Manual Database is modified. Save?')
 452        ),
 453        !,
 454        send(M?space, save_some),
 455        ClassifyTab = @man_classification,
 456        (   object(ClassifyTab),
 457            get(ClassifyTab, modified, @on)
 458        ->  send(M, report, progress,
 459                 'Saving %s ...', ClassifyTab?file?base_name),
 460            send(ClassifyTab?file, backup),
 461            send(ClassifyTab, save_in_file, ClassifyTab?file),
 462            send(ClassifyTab, modified, @off),
 463            send(M, report, done)
 464        ;   true
 465        )
 466    ;   true
 467    ).
 468
 469                 /*******************************
 470                 *          PREFERENCES         *
 471                 *******************************/
 472
 473edit_preferences(_, What:name) :->
 474    "Edit preferences file"::
 475    auto_call(prolog_edit_preferences(What)).
 476
 477edit_prolog_registry(_M) :->
 478    "Edit SWI-Prolog registry settings"::
 479    auto_call(prolog_edit_preferences(stack_sizes)).
 480
 481
 482                /********************************
 483                *           MANUAL DATA         *
 484                ********************************/
 485
 486module(M, Name:name, Create:[bool], Module) :<-
 487    "Find/create manual module"::
 488    get(M, space, Space),
 489    (   send(Space, ensure_loaded, Name)
 490    ->  get(Space, module, Name, Module)
 491    ;   Create == @on
 492    ->  new(Module, man_module(Space, Name))
 493    ;   fail
 494    ).
 495
 496
 497list_modules(M) :->
 498    "List associated modules"::
 499    new(V, view('Loaded Modules')),
 500    new(D, dialog),
 501    send(D, append, button(quit, message(D?frame, free))),
 502    send(D, below, V),
 503    send(V, tab_stops, vector(200)),
 504    send(V, font, font(helvetica, roman, 12)),
 505    send(V, format, '%s\t%s\n\n', 'Module Name', 'Number of Cards'),
 506    new(NM, number(0)),
 507    new(NC, number(0)),
 508    send(M?space?modules, for_all,
 509         block(message(NM, plus, 1),
 510               message(NC, plus, @arg2?id_table?size),
 511               message(V, format, '%s\t%s\n',
 512                       @arg2?name, @arg2?id_table?size))),
 513    send(V, caret, 0),
 514    send(V, format, '%d cards in %d modules\n\n', NC, NM),
 515    send(V, caret, 0),
 516    send(V, open).
 517
 518list_all_modules(M) :->
 519    "Load and list all modules from the directory"::
 520    send(M?space, load_all_modules),
 521    send(M, list_modules).
 522
 523
 524                 /*******************************
 525                 *          VIEW FILES          *
 526                 *******************************/
 527
 528changelog(_M) :->
 529    "View ChangeLog"::
 530    get(@pce, home, Home),
 531    get(string('%s/ChangeLog', Home), value, Path),
 532    auto_call(start_emacs),
 533    send(@emacs, goto_source_location, Path).
 534
 535:- pce_help_file(pce_faq,     pce_help('pcefaq.hlp')).
 536
 537faq(_M) :->
 538    "Start @helper on faq-database"::
 539    send(@helper, give_help, pce_faq, main).
 540
 541help_on_prolog(_M) :->
 542    "Start Prolog help-system"::
 543    auto_call(user:help).
 544
 545
 546                /********************************
 547                *          ABOUT/LICENCE        *
 548                ********************************/
 549
 550about([ 'XPCE version %s'+[@pce?version]-boldhuge,
 551        'Copyright 1992-2007, University of Amsterdam',
 552        'XPCE comes with ABSOLUTELY NO WARRANTY.',
 553        'This is free software (LGPL), and you are welcome to',
 554        'redistribute it under certain conditions.',
 555        url('http://www.swi-prolog.org/packages/xpce/'),
 556        'Jan Wielemaker\nAnjo Anjewierden'-italic,
 557        'HCS\nUniversity of Amsterdam\nKruislaan 419\n1098 VA  Amsterdam\nThe Netherlands'
 558      ]).
 559
 560
 561about(M) :->
 562    "Print about and licence info"::
 563    new(D, dialog('About XPCE')),
 564    send(D, transient_for, M),
 565    about(List),
 566    maplist(add_about(D), List),
 567    send(D, append, button(ok, message(D, destroy))),
 568    send(D, open_centered).
 569
 570add_about(D, X-Font) :-
 571    !,
 572    add_about(X, Font, D).
 573add_about(D, X) :-
 574    add_about(X, normal, D).
 575
 576add_about(url(Url), Font, D) :-
 577    !,
 578    send(D, append, new(T, text(Url, center, Font))),
 579    send(T, underline, @on),
 580    send(T, colour, blue),
 581    send(T, recogniser,
 582         click_gesture(left, '', single,
 583                       message(@prolog, goto_url, T?string?value))),
 584    send(T, cursor, hand2),
 585    send(T, alignment, center).
 586add_about(Fmt+Args, Font, D) :-
 587    !,
 588    Term =.. [string, Fmt | Args],
 589    send(D, append, new(T, text(Term, center, Font))),
 590    send(T, alignment, center).
 591add_about(Text, Font, D) :-
 592    send(D, append, new(T, text(Text, center, Font))),
 593    send(T, alignment, center).
 594
 595goto_url(Url) :-
 596    send(@display, busy_cursor),
 597    (   catch(www_open_url(Url), _, fail)
 598    ->  true
 599    ;   send(@display, inform, 'Failed to open URL')
 600    ),
 601    send(@display, busy_cursor, @nil).
 602
 603                 /*******************************
 604                 *             HELP             *
 605                 *******************************/
 606
 607help(M) :->
 608    "Give help on the overall manual"::
 609    give_help(M, @nil, manual).
 610
 611
 612                /********************************
 613                *              DEMO             *
 614                ********************************/
 615
 616:- multifile
 617    pce_demo:pcedemo/0.
 618
 619start_demo(M) :->
 620    send(M, report, progress, 'Starting demo tool ...'),
 621    use_module(demo(pce_demo), []),
 622    pce_demo:pcedemo,
 623    send(M, report, done).
 624
 625
 626                /********************************
 627                *            CHECKING           *
 628                ********************************/
 629
 630check_object_base(_M) :->
 631    (   auto_call(checkpce)
 632    ->  send(@display, inform, 'Object base is consistent')
 633    ;   send(@display, inform, '%s\n%s',
 634             'Object base is corrupted',
 635             'See Prolog window for details')
 636    ).
 637
 638
 639                 /*******************************
 640                 *     START EXTERNAL TOOLS     *
 641                 *******************************/
 642
 643dialog_editor(_M) :->
 644    "Start the dialog editor"::
 645    auto_call(dialog).
 646
 647event_viewer(_) :->
 648    "Start event-viewer"::
 649    send(new(event_viewer), open).
 650
 651guitracer(M) :->
 652    "Start the GUI tracer for Prolog"::
 653    (   catch(guitracer, _, fail)
 654    ->  true
 655    ;   send(M, report, error, 'Failed to load GUI tracer')
 656    ).
 657
 658prolog_navigator(_M) :->
 659    "Start the source-code navigator"::
 660    prolog_ide(open_navigator).
 661
 662thread_monitor(_M) :->
 663    "Start the thread monitor"::
 664    prolog_ide(thread_monitor).
 665
 666start_emacs(_M) :->
 667    "Start PceEmacs (*scratch* buffer)"::
 668    auto_call(emacs).
 669
 670
 671                /********************************
 672                *            INSPECTOR          *
 673                ********************************/
 674
 675inspect(M, V:object) :->
 676    "Start inspector on object"::
 677    send(M, start_tool, inspector),
 678    send(M?tools?inspector, inspect, V).
 679
 680
 681                 /*******************************
 682                 *       EXTERNAL INVOKES       *
 683                 *******************************/
 684
 685manual(M, Object:'class|behaviour|object') :->
 686    "Open manual on object"::
 687    send(M, open),
 688    (   send(Object, instance_of, class)
 689    ->  send(M, start_tool, class_browser),
 690        send(M, request_tool_focus, Object)
 691    ;   (   send(Object, instance_of, behaviour)
 692        ;   send(Object, instance_of, man_global)
 693        )
 694    ->  send(M, request_selection, @nil, Object, @on)
 695    ;   Object = @Ref,
 696        atom(Ref)
 697    ->  send(M, request_selection, @nil, man_global(Ref), @on)
 698    ;   send(M, report, error, 'Cannot start manual from %O', Object),
 699        fail
 700    ).
 701
 702
 703                 /*******************************
 704                 *          USER-SCOPING        *
 705                 *******************************/
 706
 707:- pce_global(@man_classification, load_man_classification).
 708
 709load_man_classification(C) :-
 710    absolute_file_name(library('man/classification.dat'),
 711                       [access(read)], FileName),
 712    new(F, file(FileName)),
 713    get(F, object, C),
 714    send(C, attribute, file, file(F?absolute_path)),
 715    send(C, attribute, modified, @off).
 716
 717
 718in_scope(M, Obj:object) :->
 719    "Test if object is in current scope"::
 720    get(M, user_scope, Scope),
 721    get(Obj, man_id, Id),
 722    (   (   get(@man_classification, member, Id, Type)
 723        ->  send(Scope, member, Type)
 724        ;   send(Scope, member, obscure)
 725        )
 726    ;   get(Obj, man_creator, Creator),
 727        Creator \== built_in,
 728        send(Scope, member, user)
 729    ).
 730
 731
 732user_scope(M, Scope:chain) :->
 733    "Modify scope and inform tools"::
 734    (   send(M?user_scope, equal, Scope)
 735    ->  true
 736    ;   send(M, slot, user_scope, Scope),
 737        send(M?tools, for_some,
 738             message(@arg1?value, user_scope, Scope))
 739    ).
 740
 741
 742                /********************************
 743                *         COMMUNICATION         *
 744                ********************************/
 745
 746
 747request_selection(M, Frame:man_frame*, Obj:any*, Open:[bool]) :->
 748    "Request to become selection holder"::
 749    get(M, selection_holder, OldHolder),
 750    (   OldHolder \== @nil
 751    ->  (   send(OldHolder, release_selection)
 752        ->  true
 753        ;   send(@display, inform,
 754                 '%s does not release selection', OldHolder)
 755        )
 756    ;   true
 757    ),
 758    send(M, slot, selection_holder, Frame),
 759    send(M, slot, selection, Obj),
 760    send(M, update_history, selection_history, Obj),
 761    send(M?tools, for_some, message(@arg1?value, selected, Obj)),
 762    (   \+ get(M?tools, value, card_viewer, _)
 763    ->  (   Open == @on
 764        ->  send(M, report, progress, 'Starting Card Viewer ...'),
 765            send(M, start_tool, card_viewer),
 766            send(M, report, done)
 767        ;   true
 768        )
 769    ;   send(M, expose_tool, card_viewer)  % exposes it?
 770    ).
 771
 772
 773request_tool_focus(M, Obj:object*, ForceClass:[bool]) :->
 774    "Change the tool focus"::
 775    send(M, slot, tool_focus, Obj),
 776    send(M, update_history, focus_history, Obj),
 777    send(M?tools, for_some, message(@arg1?value, tool_focus, Obj)),
 778    (   (   ForceClass == @on
 779        ;   send(Obj, instance_of, class)
 780        ),
 781        \+ get(M?tools, value, class_browser, _)
 782    ->  send(M, report, progress, 'Starting Class Browser'),
 783        send(M, start_tool, class_browser),
 784        send(M, report, done)
 785    ;   send(M, expose_tool, class_browser)   % exposes it!
 786    ).
 787
 788
 789maintainer(M, Val:bool) :->
 790    "Switch maintainer-mode on/off"::
 791    send(M, slot, maintainer, Val),
 792    send(M?tools, for_some, message(@arg1?value, maintainer, Val)).
 793
 794
 795                /********************************
 796                *             HISTORY           *
 797                ********************************/
 798
 799update_history(M, History:name, Obj:object*) :->
 800    "Add object to the requested history"::
 801    get(M, History, Chain),
 802    (   get(Chain, head, Obj)
 803    ->  true
 804    ;   ignore(send(Chain, delete, Obj)),
 805        send(Chain, prepend, Obj),
 806        (   get(Chain, size, S),
 807            S > 10
 808        ->  send(Chain, delete_tail)
 809        ;   true
 810        )
 811    ).
 812
 813
 814update_history_menu(M, History, Menu) :->
 815    "Update the contents of the history popup"::
 816    get(M, History, Chain),
 817    send(Menu, clear),
 818    send(Chain, for_some,
 819         message(Menu, append,
 820                 create(menu_item,
 821                        @arg1, @default,
 822                        when(message(@arg1, instance_of, chain),
 823                             ?(@pce, instance, string, 'G %s:%s',
 824                               when(message(@arg1?head, instance_of,
 825                                            class),
 826                                    @arg1?head?name,
 827                                    @arg1?head?context?name),
 828                               @arg1?head?group),
 829                             progn(assign(new(X, var),
 830                                          create(string, '%s',
 831                                                 @arg1?man_name)),
 832                                   message(X, translate, '\t', ' '),
 833                                   X))))).
 834
 835
 836select_history_menu(M, History:name, Obj) :->
 837    "Trap selected history item"::
 838    (   History == selection_history
 839    ->  send(M, request_selection, @nil, Obj, @on)
 840    ;   send(M, request_tool_focus, Obj)
 841    ).
 842
 843
 844                /********************************
 845                *           (UN)RELATE          *
 846                ********************************/
 847
 848request_relate(M, Obj:object) :->
 849    "Relate selection to object"::
 850    request_relate(M, relate, Obj).
 851
 852request_unrelate(M, Obj:object) :->
 853    "Destroy relation to selection"::
 854    request_relate(M, unrelate, Obj).
 855
 856request_relate(M, CD, Obj) :-
 857    (   get(M, edit_mode, @on)
 858    ->  (   get(M, selection, Selection),
 859            Selection \== @nil
 860        ->  get(Selection, class_name, SClass),
 861            get(Obj, class_name, OClass),
 862            relate(M, SClass-OClass, CD, Selection, Obj)
 863        ;   send(@display, inform, 'First make a selection')
 864        )
 865    ;   send(@display, inform, 'Manual is in read-only mode')
 866    ).
 867
 868relate(_, _-_, create, Obj, Obj) :-
 869    !,
 870    send(@display, inform, 'Can''t relate %s to itself', Obj?man_name).
 871relate(M, _-_, CD, Selection, Obj) :-
 872    send(@display, confirm,
 873         '%s %s <-> %s', CD, Selection?man_name, Obj?man_name),
 874    send(M, create_relation, CD, Selection, see_also, Obj),
 875    send(M, create_relation, CD, Obj, see_also, Selection).
 876
 877
 878create_relation(M, CD, From, Rel, To) :->
 879    (   CD == relate
 880    ->  send(From, man_relate, Rel, To),
 881        send(M?tools, for_some,
 882             message(@arg1?value, related, From, Rel, To))
 883    ;   CD == unrelate
 884    ->  send(From, man_unrelate, Rel, To),
 885        send(M?tools, for_some,
 886             message(@arg1?value, unrelated, From, Rel, To))
 887    ).
 888
 889
 890                 /*******************************
 891                 *          (UN)INHERIT         *
 892                 *******************************/
 893
 894request_inherit(M, Obj:object) :->
 895    "Relate selection to object"::
 896    request_inherit(M, relate, Obj).
 897
 898request_uninherit(M, Obj:object) :->
 899    "Destroy relation to selection"::
 900    request_inherit(M, unrelate, Obj).
 901
 902request_inherit(M, CD, Obj) :-
 903    (   get(M, edit_mode, @on)
 904    ->  (   get(M, selection, Selection),
 905            Selection \== @nil
 906        ->  inherit(M, CD, Selection, Obj)
 907        ;   send(@display, inform, 'First make a selection')
 908        )
 909    ;   send(@display, inform, 'Manual is in read-only mode')
 910    ).
 911
 912inherit(_, create, Obj, Obj) :-
 913    !,
 914    send(@display, inform, 'Can''t inherit %s from myself', Obj?man_name).
 915inherit(M, CD, Selection, Obj) :-
 916    send(@display, confirm,
 917         '%s description of %s from %s',
 918         when(CD == relate, 'Inherit', 'UnInherit'),
 919         Obj?man_name, Selection?man_name),
 920    send(M, create_relation, CD, Obj, inherit, Selection),
 921    send(@man_description_cache, clear),
 922    send(@man_source_cache, clear).
 923
 924
 925                /********************************
 926                *            SOURCES            *
 927                ********************************/
 928
 929request_source(_M, Obj:object) :->
 930    "Display source of object"::
 931    (   get(Obj, source, Location)
 932    ->  auto_call(start_emacs),
 933        send(@emacs, goto_source_location, Location)
 934    ;   send(@display, inform, 'Can''t find source')
 935    ).
 936
 937
 938                /********************************
 939                *          EDIT MODE            *
 940                ********************************/
 941
 942edit_mode(M, Val) :->
 943    "Set overall edit_mode"::
 944    send(M, slot, edit_mode, Val),
 945    send(M?tools, for_some, message(@arg1?value, edit_mode, Val)).
 946
 947
 948toggle_edit_mode(M) :->
 949    "Toggle current setting of edit_mode"::
 950    (   get(M, edit_mode, @off)
 951    ->  send(M, edit_mode, @on)
 952    ;   send(M, edit_mode, @off)
 953    ),
 954    get(M, edit_mode, @Val),
 955    send(M, report, status, 'Edit mode is now %s', Val).
 956
 957:- pce_end_class.
 958
 959
 960                /********************************
 961                *          TOOL FRAMES          *
 962                ********************************/
 963
 964:- pce_begin_class(man_frame(label), persistent_frame).
 965
 966variable(manual,        man_manual,     get,
 967         "Manual we are related to").
 968variable(tool_name,     name,           get,
 969         "Name of the tool in this frame").
 970
 971
 972initialise(F, Manual:man_manual, Label:[name]) :->
 973    "Create from label"::
 974    send(F, send_super, initialise, Label),
 975    send(F, slot, manual, Manual),
 976    send(F, done_message, message(F, quit)).
 977
 978
 979user_scope(_F, _Scope:chain) :->
 980    "Generic operation: fail"::
 981    fail.
 982
 983
 984tool_focus(_F, _Focus:object*) :->
 985    "Generic operation: fail"::
 986    fail.
 987
 988
 989selected(_F, _Obj:object*) :->
 990    "Generic operation: fail"::
 991    fail.
 992
 993
 994release_selection(_F) :->
 995    "Generic operation: true"::
 996    true.
 997
 998
 999edit_mode(_F, _Val:bool) :->
1000    "Generic operation: fail"::
1001    fail.
1002
1003
1004related(_F, _From:object, _Rel:name, _To:object) :->
1005    "Generic operation: fail"::
1006    fail.
1007
1008
1009unrelated(_F, _From:object, _Rel:name, _To:object) :->
1010    "Generic operation: fail"::
1011    fail.
1012
1013
1014quit(F) :->
1015    "Destroy a tool"::
1016    send(F?manual, destroy_tool, F).
1017
1018
1019                /********************************
1020                *      GENERIC USER ACTIONS     *
1021                ********************************/
1022
1023request_selection(F, Obj:any*, Open:[bool]) :->
1024    send(F?manual, request_selection, F, Obj, Open).
1025
1026request_tool_focus(F, Obj:object, Force:[bool]) :->
1027    send(F?manual, request_tool_focus, Obj, Force).
1028
1029request_source(F, Obj:object) :->
1030    send(F?manual, request_source, Obj).
1031
1032request_relate(F, Obj:object) :->
1033    send(F?manual, request_relate, Obj).
1034
1035request_unrelate(F, Obj:object) :->
1036    send(F?manual, request_unrelate, Obj).
1037
1038request_inherit(F, Obj:object) :->
1039    send(F?manual, request_inherit, Obj).
1040
1041request_uninherit(F, Obj:object) :->
1042    send(F?manual, request_uninherit, Obj).
1043
1044help(F) :->
1045    "Give help on a manual tool"::
1046    get(F, manual, Manual),
1047    get(F, tool_name, ToolName),
1048    give_help(Manual, F, ToolName).
1049
1050:- pce_end_class.
1051
1052                /********************************
1053                *              HELP             *
1054                ********************************/
1055
1056give_help(Manual, Frame, ToolName) :-
1057    get(Manual, module, tools, @on, Tools),
1058    (   get(Tools?id_table, find_value, @arg2?tool_name == ToolName, Card)
1059    ->  send(Manual, request_selection, Frame, Card, @on)
1060    ;   get(Manual, edit_mode, @on),
1061        get(Manual, selection, ToolCard),
1062        ToolCard \== @nil,
1063        send(ToolCard, instance_of, man_browser_card),
1064        send(@display, confirm, 'Assign %s to browser %s',
1065             ToolCard?man_name, ToolName)
1066    ->  send(ToolCard, store, tool_name, ToolName)
1067    ;   send(@display, inform, 'Sorry, Can''t find help card ...')
1068    ).