/* Part of XPCE --- The SWI-Prolog GUI toolkit Author: Jan Wielemaker and Anjo Anjewierden E-mail: jan@swi.psy.uva.nl WWW: http://www.swi.psy.uva.nl/projects/xpce/ Copyright (c) 1985-2002, University of Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ :- module(man_manual, []). :- use_module(library(pce)). :- use_module(library(persistent_frame)). :- use_module(library(pce_help_file)). :- use_module(util). :- require([ absolute_file_name/3 , auto_call/1 , default/3 , forall/2 , ignore/1 , send_list/3 ]). resource(man_icon, image, image('32x32/books.xpm')). :- pce_autoload(event_viewer, library('man/showevent')). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - OVERALL ARCHITECTURE The following diagram provides an overall view of the design of the manual tools. ManualTool | | (select) | V | ClassBrowser Tools | ClassHierarchy | | TopicBrowser | | KeywordBrowser | | (find/browse) V [Type] Name [Summary] /|\ Examples----/-------- | -----------\ / | \ / | \ Sources Textual Relations Attributes [Type] Name [Summary] The communication between the tools is arranged via messages send to and possible broadcasted by ManualTool. These messages are: ->request_selection: man_frame, object*, [bool] Set the <-selection and <-selection_holder attribute of the ManualTool and broadcasts the following messages: * SelectionHolder ->release_selection * AllTools ->selected: object* If bool == @on, the card viewer is started automatically ->tool_focus: object* Set the focus of all tools. Broadcasted to all tools. ->relate: object Request manual to relate selection to object. ->edit_mode: bool Switch edit_mode on/off. Broadcasted to all tools. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(man_manual, persistent_frame, "PCE manual main object"). class_variable(geometry, geometry, '+0+0'). class_variable(user_scope, chain, chain(basic, user), "Default scoping of manual material"). class_variable(edit, bool, @off). variable(selection, object*, get, "Currently selected object"). variable(selection_holder, man_frame*, get, "Tool holding selection"). variable(tool_focus, object*, get, "Arg of last ->tool_focus"). variable(tools, sheet, get, "Tool-name --> tool mapping"). variable(edit_mode, bool, get, "Can database be edited?"). variable(space, man_space, get, "Manual module collection"). variable(focus_history, chain, get, "Chain of focused cards"). variable(selection_history, chain, get, "Chain of selected cards"). variable(maintainer, bool, get, "Indicates the user is a maintainer"). variable(exit_message, code*, get, "Message called on exit"). variable(user_scope, chain, get, "Types in user's scope"). variable(search_patterns, chain*, both, "Search patterns to be highlighted"). /******************************** * CREATE * ********************************/ initialise(M, Dir:[directory]) :-> "Create the manual main object":: send(M, send_super, initialise, 'XPCE Manual'), send(M, icon, resource(man_icon)), send(M, can_resize, @off), send(M, done_message, message(M, quit)), get(M, class_variable_value, user_scope, Scope), get(M, class_variable_value, edit, Edit), send(M, slot, maintainer, Edit), default(Dir, directory('$PCEHOME/man/reference'), Directory), send(M, check_directory, Directory), send(M, slot, space, new(Space, man_space(reference, Directory))), send(M, slot, tools, new(sheet)), send(M, slot, edit_mode, @off), send(M, slot, focus_history, new(chain)), send(M, slot, selection_history, new(chain)), send(M, slot, user_scope, Scope), send(Space, attribute, attribute(report_to, M)), send(M, append, new(D, dialog)), send(M, fill_dialog, D), ifmaintainer(( send(@pce, exit_message, new(Msg, message(M, save_if_modified))), send(M, slot, exit_message, Msg))), send(M, check_runtime), send(M, report, status, 'For help, see `File'' menu'). unlink(M) :-> "Manual is destroyed":: get(M, space, Space), send(Space, delete_attribute, report_to), get(M, exit_message, Msg), ignore(send(@pce?exit_messages, delete, Msg)), send(M, send_super, unlink). check_directory(M, Dir:directory) :-> "Check the manual directory":: ( send(Dir, exists) -> true ; send(M, report, error, 'Cannot find manual directory %s', Dir?path) ). check_runtime(_M) :-> "Check for runtime system":: ( get(@pce, is_runtime_system, @on) -> send(@display, inform, '%s. %s\n%s %s', 'This is a runtime version of XPCE', 'Most of the manual will not work.', 'Contact xpce-request@swi.psy.uva.nl', 'for a information on the development version') ; true ). fill_dialog(M, D) :-> send(D, gap, size(5, 5)), send(D, append, new(MB, menu_bar)), send(MB, append, new(F, popup(file))), send(MB, append, new(V, popup(browsers, message(M, start_tool, @arg1)))), send(MB, append, new(T, popup(tools, message(M, start_tool, @arg1)))), send(MB, append, new(H, popup(history))), /* FILE menu */ send_list(F, append, [ menu_item(about, message(M, about)), menu_item(help, message(M, help)), menu_item(demo_programs, message(M, start_demo), @default, @on), menu_item('ChangeLog', message(M, changelog)), menu_item('FAQ', message(M, faq), @default, @on), new(Prefs, popup(edit_preferences)) ]), send(Prefs, end_group, @on), send_list(Prefs, append, [ menu_item('XPCE User Defaults', message(M, edit_preferences, xpce_user)), menu_item('XPCE System Defaults', message(M, edit_preferences, xpce), end_group := @on), menu_item('Prolog Defaults', message(M, edit_preferences, prolog)) ]), ( get(@pce, window_system, windows) -> send(Prefs, append, menu_item('Prolog Stack Limits', message(M, edit_prolog_registry))) ; true ), ( get(M, maintainer, @on) -> send_list(F, append, [ menu_item(edit_mode, message(M, toggle_edit_mode)) , menu_item(list_modules, message(M, list_modules)) , menu_item(list_all_modules, message(M, list_all_modules)) , menu_item(save_manual, message(M, save_if_modified, @off), @default, @on, M?modified == @on) ]) ; true ), send_list(F, append, [ menu_item(quit, message(M, quit)), menu_item(quit_pce, message(M, quit_pce)) ]), /* BROWSERS menu */ send_list(V, append, [ menu_item(manual_tools, end_group := @on), menu_item(class_hierarchy), menu_item(class_browser), menu_item(global_objects), menu_item(errors, end_group := @on), menu_item(xpce_predicates, @default, 'XPCE/Prolog predicates'), menu_item(prolog_manual, message(M, help_on_prolog), end_group := @on), menu_item(search), menu_item(group_overview), menu_item(examples, end_group := @on) ]), ( get(M, maintainer, @on) -> send_list(V, append, [ menu_item(class_finder, end_group := @off) ]) ; true ), /* TOOLS menu */ send_list(T, append, [ statistics, visual_hierarchy, inspector, gap, menu_item(event_viewer, message(M, event_viewer)), gap, menu_item(prolog_graphical_tracer, message(M, guitracer)), menu_item(prolog_navigator, message(M, prolog_navigator)), menu_item(prolog_thread_monitor, message(M, thread_monitor), condition := ?(@prolog, current_prolog_flag, threads) == true), menu_item(emacs, message(M, start_emacs)), gap, menu_item(dialog_editor, message(M, dialog_editor)), menu_item(check_object_base, message(M, check_object_base)) ]), /* HISTORY menu */ new(SI, menu_item(selection, @nil, @default, @off, not(message(M?selection_history, empty)))), new(FI, menu_item(focus, @nil, @default, @off, not(message(M?focus_history, empty)))), send(SI, popup, new(SH, popup(selection, message(M, select_history_menu, selection_history, @arg1)))), send(FI, popup, new(FH, popup(focus, message(M, select_history_menu, focus_history, @arg1)))), send(SH, update_message, message(M, update_history_menu, selection_history, @receiver)), send(FH, update_message, message(M, update_history_menu, focus_history, @receiver)), send(H, append, SI), send(H, append, FI), send(D, append, new(label)). /******************************** * STARTING TOOLS * ********************************/ start_tool(M, ToolName:name, Tool:frame) :<- "Start named tool":: ( get(M?tools, value, ToolName, Tool) -> send(Tool, expose) ; create_tool(M, ToolName, Tool), send(Tool, open) -> send(M, register_tool, ToolName, Tool) ; send(@display, inform, 'Failed to start %s', ToolName) ). start_tool(M, ToolName:name) :-> "Start named tool":: get(M, start_tool, ToolName, _). register_tool(M, Name:name, Tool:man_frame) :-> "Register frame as a menual tool":: send(Tool, slot, tool_name, Name), send(M?tools, append, attribute(Name, Tool)). expose_tool(M, ToolName:name) :-> "Expose named tool":: get(M?tools, value, ToolName, Tool), send(Tool, expose). create_tool(M, Name, Tool) :- tool_class(Name, M, Term), new(Tool, Term). tool_class(class_browser, M, man_class_browser(M)). tool_class(class_finder, M, man_class_browser(M)). tool_class(class_hierarchy, M, man_class_hierarchy(M)). tool_class(search, M, man_search_tool(M)). tool_class(topics, M, man_topic_browser(M)). tool_class(card_viewer, M, man_card_editor(M)). tool_class(statistics, M, man_statistics(M)). tool_class(inspector, M, isp_frame(M)). tool_class(visual_hierarchy, M, vis_frame(M)). tool_class(global_objects, M, man_object_browser(M)). tool_class(errors, M, man_error_browser(M)). tool_class(manual_tools, M, man_module_browser(M, tools, man_browser_card, 'Manual Tools')). tool_class(xpce_predicates, M, man_module_browser(M, predicates, man_predicate_card, 'XPCE/Prolog Predicates')). tool_class(examples, M, man_module_browser(M, examples, man_example_card, 'XPCE Examples')). tool_class(changes, M, man_module_browser(M, changes, man_change_card, 'XPCE Changes')). tool_class(group_overview, M, man_group_browser(M, groups, 'Group Browser')). /******************************** * DESTROYING * ********************************/ destroy_tool(M, Tool:man_frame) :-> "Destroy a tool":: ( get(M, selection_holder, Tool) -> ignore(send(Tool, release_selection)), % TBD: forward send(M, slot, selection_holder, @nil) ; true ), send(M?tools, for_all, if(@arg1?value == Tool, message(M?tools, delete, @arg1?name))), send(Tool, destroy). quit(M) :-> "Quit Manual Tool":: send(M, save_if_modified), % send(@display, confirm, 'Quit all manual tools?'), send(M?tools, for_all, message(@arg1?value, quit)), send(M, destroy). quit_pce(M) :-> "Exit from PCE process":: send(M, save_if_modified), send(@display, confirm, 'Really exit PCE?'), send(@pce, die). /******************************* * SAVE/MODIFIED * *******************************/ modified(M, Modified:bool) :<- "See if manual database has been modified":: ( ( get(M?space, modified, @on) ; object(@man_classification), get(@man_classification, modified, @on) ) -> Modified = @on ; Modified = @off ). save_if_modified(M, Ask:[bool]) :-> "Save if some part has been modified":: ( get(M, modified, @on) -> ( Ask \== @on ; send(@display, confirm, 'Manual Database is modified. Save?') ), !, send(M?space, save_some), ClassifyTab = @man_classification, ( object(ClassifyTab), get(ClassifyTab, modified, @on) -> send(M, report, progress, 'Saving %s ...', ClassifyTab?file?base_name), send(ClassifyTab?file, backup), send(ClassifyTab, save_in_file, ClassifyTab?file), send(ClassifyTab, modified, @off), send(M, report, done) ; true ) ; true ). /******************************* * PREFERENCES * *******************************/ edit_preferences(_, What:name) :-> "Edit preferences file":: auto_call(prolog_edit_preferences(What)). edit_prolog_registry(_M) :-> "Edit SWI-Prolog registry settings":: auto_call(prolog_edit_preferences(stack_sizes)). /******************************** * MANUAL DATA * ********************************/ module(M, Name:name, Create:[bool], Module) :<- "Find/create manual module":: get(M, space, Space), ( send(Space, ensure_loaded, Name) -> get(Space, module, Name, Module) ; Create == @on -> new(Module, man_module(Space, Name)) ; fail ). list_modules(M) :-> "List associated modules":: new(V, view('Loaded Modules')), new(D, dialog), send(D, append, button(quit, message(D?frame, free))), send(D, below, V), send(V, tab_stops, vector(200)), send(V, font, font(helvetica, roman, 12)), send(V, format, '%s\t%s\n\n', 'Module Name', 'Number of Cards'), new(NM, number(0)), new(NC, number(0)), send(M?space?modules, for_all, block(message(NM, plus, 1), message(NC, plus, @arg2?id_table?size), message(V, format, '%s\t%s\n', @arg2?name, @arg2?id_table?size))), send(V, caret, 0), send(V, format, '%d cards in %d modules\n\n', NC, NM), send(V, caret, 0), send(V, open). list_all_modules(M) :-> "Load and list all modules from the directory":: send(M?space, load_all_modules), send(M, list_modules). /******************************* * VIEW FILES * *******************************/ changelog(_M) :-> "View ChangeLog":: get(@pce, home, Home), get(string('%s/ChangeLog', Home), value, Path), auto_call(start_emacs), send(@emacs, goto_source_location, Path). :- pce_help_file(pce_faq, pce_help('pcefaq.hlp')). faq(_M) :-> "Start @helper on faq-database":: send(@helper, give_help, pce_faq, main). help_on_prolog(_M) :-> "Start Prolog help-system":: auto_call(user:help). /******************************** * ABOUT/LICENCE * ********************************/ about([ 'XPCE version %s'+[@pce?version]-boldhuge, 'Copyright 1992-2007, University of Amsterdam', 'XPCE comes with ABSOLUTELY NO WARRANTY.', 'This is free software (LGPL), and you are welcome to', 'redistribute it under certain conditions.', url('http://www.swi-prolog.org/packages/xpce/'), 'Jan Wielemaker\nAnjo Anjewierden'-italic, 'HCS\nUniversity of Amsterdam\nKruislaan 419\n1098 VA Amsterdam\nThe Netherlands' ]). about(M) :-> "Print about and licence info":: new(D, dialog('About XPCE')), send(D, transient_for, M), about(List), maplist(add_about(D), List), send(D, append, button(ok, message(D, destroy))), send(D, open_centered). add_about(D, X-Font) :- !, add_about(X, Font, D). add_about(D, X) :- add_about(X, normal, D). add_about(url(Url), Font, D) :- !, send(D, append, new(T, text(Url, center, Font))), send(T, underline, @on), send(T, colour, blue), send(T, recogniser, click_gesture(left, '', single, message(@prolog, goto_url, T?string?value))), send(T, cursor, hand2), send(T, alignment, center). add_about(Fmt+Args, Font, D) :- !, Term =.. [string, Fmt | Args], send(D, append, new(T, text(Term, center, Font))), send(T, alignment, center). add_about(Text, Font, D) :- send(D, append, new(T, text(Text, center, Font))), send(T, alignment, center). goto_url(Url) :- send(@display, busy_cursor), ( catch(www_open_url(Url), _, fail) -> true ; send(@display, inform, 'Failed to open URL') ), send(@display, busy_cursor, @nil). /******************************* * HELP * *******************************/ help(M) :-> "Give help on the overall manual":: give_help(M, @nil, manual). /******************************** * DEMO * ********************************/ :- multifile pce_demo:pcedemo/0. start_demo(M) :-> send(M, report, progress, 'Starting demo tool ...'), use_module(demo(pce_demo), []), pce_demo:pcedemo, send(M, report, done). /******************************** * CHECKING * ********************************/ check_object_base(_M) :-> ( auto_call(checkpce) -> send(@display, inform, 'Object base is consistent') ; send(@display, inform, '%s\n%s', 'Object base is corrupted', 'See Prolog window for details') ). /******************************* * START EXTERNAL TOOLS * *******************************/ dialog_editor(_M) :-> "Start the dialog editor":: auto_call(dialog). event_viewer(_) :-> "Start event-viewer":: send(new(event_viewer), open). guitracer(M) :-> "Start the GUI tracer for Prolog":: ( catch(guitracer, _, fail) -> true ; send(M, report, error, 'Failed to load GUI tracer') ). prolog_navigator(_M) :-> "Start the source-code navigator":: prolog_ide(open_navigator). thread_monitor(_M) :-> "Start the thread monitor":: prolog_ide(thread_monitor). start_emacs(_M) :-> "Start PceEmacs (*scratch* buffer)":: auto_call(emacs). /******************************** * INSPECTOR * ********************************/ inspect(M, V:object) :-> "Start inspector on object":: send(M, start_tool, inspector), send(M?tools?inspector, inspect, V). /******************************* * EXTERNAL INVOKES * *******************************/ manual(M, Object:'class|behaviour|object') :-> "Open manual on object":: send(M, open), ( send(Object, instance_of, class) -> send(M, start_tool, class_browser), send(M, request_tool_focus, Object) ; ( send(Object, instance_of, behaviour) ; send(Object, instance_of, man_global) ) -> send(M, request_selection, @nil, Object, @on) ; Object = @Ref, atom(Ref) -> send(M, request_selection, @nil, man_global(Ref), @on) ; send(M, report, error, 'Cannot start manual from %O', Object), fail ). /******************************* * USER-SCOPING * *******************************/ :- pce_global(@man_classification, load_man_classification). load_man_classification(C) :- absolute_file_name(library('man/classification.dat'), [access(read)], FileName), new(F, file(FileName)), get(F, object, C), send(C, attribute, file, file(F?absolute_path)), send(C, attribute, modified, @off). in_scope(M, Obj:object) :-> "Test if object is in current scope":: get(M, user_scope, Scope), get(Obj, man_id, Id), ( ( get(@man_classification, member, Id, Type) -> send(Scope, member, Type) ; send(Scope, member, obscure) ) ; get(Obj, man_creator, Creator), Creator \== built_in, send(Scope, member, user) ). user_scope(M, Scope:chain) :-> "Modify scope and inform tools":: ( send(M?user_scope, equal, Scope) -> true ; send(M, slot, user_scope, Scope), send(M?tools, for_some, message(@arg1?value, user_scope, Scope)) ). /******************************** * COMMUNICATION * ********************************/ request_selection(M, Frame:man_frame*, Obj:any*, Open:[bool]) :-> "Request to become selection holder":: get(M, selection_holder, OldHolder), ( OldHolder \== @nil -> ( send(OldHolder, release_selection) -> true ; send(@display, inform, '%s does not release selection', OldHolder) ) ; true ), send(M, slot, selection_holder, Frame), send(M, slot, selection, Obj), send(M, update_history, selection_history, Obj), send(M?tools, for_some, message(@arg1?value, selected, Obj)), ( \+ get(M?tools, value, card_viewer, _) -> ( Open == @on -> send(M, report, progress, 'Starting Card Viewer ...'), send(M, start_tool, card_viewer), send(M, report, done) ; true ) ; send(M, expose_tool, card_viewer) % exposes it? ). request_tool_focus(M, Obj:object*, ForceClass:[bool]) :-> "Change the tool focus":: send(M, slot, tool_focus, Obj), send(M, update_history, focus_history, Obj), send(M?tools, for_some, message(@arg1?value, tool_focus, Obj)), ( ( ForceClass == @on ; send(Obj, instance_of, class) ), \+ get(M?tools, value, class_browser, _) -> send(M, report, progress, 'Starting Class Browser'), send(M, start_tool, class_browser), send(M, report, done) ; send(M, expose_tool, class_browser) % exposes it! ). maintainer(M, Val:bool) :-> "Switch maintainer-mode on/off":: send(M, slot, maintainer, Val), send(M?tools, for_some, message(@arg1?value, maintainer, Val)). /******************************** * HISTORY * ********************************/ update_history(M, History:name, Obj:object*) :-> "Add object to the requested history":: get(M, History, Chain), ( get(Chain, head, Obj) -> true ; ignore(send(Chain, delete, Obj)), send(Chain, prepend, Obj), ( get(Chain, size, S), S > 10 -> send(Chain, delete_tail) ; true ) ). update_history_menu(M, History, Menu) :-> "Update the contents of the history popup":: get(M, History, Chain), send(Menu, clear), send(Chain, for_some, message(Menu, append, create(menu_item, @arg1, @default, when(message(@arg1, instance_of, chain), ?(@pce, instance, string, 'G %s:%s', when(message(@arg1?head, instance_of, class), @arg1?head?name, @arg1?head?context?name), @arg1?head?group), progn(assign(new(X, var), create(string, '%s', @arg1?man_name)), message(X, translate, '\t', ' '), X))))). select_history_menu(M, History:name, Obj) :-> "Trap selected history item":: ( History == selection_history -> send(M, request_selection, @nil, Obj, @on) ; send(M, request_tool_focus, Obj) ). /******************************** * (UN)RELATE * ********************************/ request_relate(M, Obj:object) :-> "Relate selection to object":: request_relate(M, relate, Obj). request_unrelate(M, Obj:object) :-> "Destroy relation to selection":: request_relate(M, unrelate, Obj). request_relate(M, CD, Obj) :- ( get(M, edit_mode, @on) -> ( get(M, selection, Selection), Selection \== @nil -> get(Selection, class_name, SClass), get(Obj, class_name, OClass), relate(M, SClass-OClass, CD, Selection, Obj) ; send(@display, inform, 'First make a selection') ) ; send(@display, inform, 'Manual is in read-only mode') ). relate(_, _-_, create, Obj, Obj) :- !, send(@display, inform, 'Can''t relate %s to itself', Obj?man_name). relate(M, _-_, CD, Selection, Obj) :- send(@display, confirm, '%s %s <-> %s', CD, Selection?man_name, Obj?man_name), send(M, create_relation, CD, Selection, see_also, Obj), send(M, create_relation, CD, Obj, see_also, Selection). create_relation(M, CD, From, Rel, To) :-> ( CD == relate -> send(From, man_relate, Rel, To), send(M?tools, for_some, message(@arg1?value, related, From, Rel, To)) ; CD == unrelate -> send(From, man_unrelate, Rel, To), send(M?tools, for_some, message(@arg1?value, unrelated, From, Rel, To)) ). /******************************* * (UN)INHERIT * *******************************/ request_inherit(M, Obj:object) :-> "Relate selection to object":: request_inherit(M, relate, Obj). request_uninherit(M, Obj:object) :-> "Destroy relation to selection":: request_inherit(M, unrelate, Obj). request_inherit(M, CD, Obj) :- ( get(M, edit_mode, @on) -> ( get(M, selection, Selection), Selection \== @nil -> inherit(M, CD, Selection, Obj) ; send(@display, inform, 'First make a selection') ) ; send(@display, inform, 'Manual is in read-only mode') ). inherit(_, create, Obj, Obj) :- !, send(@display, inform, 'Can''t inherit %s from myself', Obj?man_name). inherit(M, CD, Selection, Obj) :- send(@display, confirm, '%s description of %s from %s', when(CD == relate, 'Inherit', 'UnInherit'), Obj?man_name, Selection?man_name), send(M, create_relation, CD, Obj, inherit, Selection), send(@man_description_cache, clear), send(@man_source_cache, clear). /******************************** * SOURCES * ********************************/ request_source(_M, Obj:object) :-> "Display source of object":: ( get(Obj, source, Location) -> auto_call(start_emacs), send(@emacs, goto_source_location, Location) ; send(@display, inform, 'Can''t find source') ). /******************************** * EDIT MODE * ********************************/ edit_mode(M, Val) :-> "Set overall edit_mode":: send(M, slot, edit_mode, Val), send(M?tools, for_some, message(@arg1?value, edit_mode, Val)). toggle_edit_mode(M) :-> "Toggle current setting of edit_mode":: ( get(M, edit_mode, @off) -> send(M, edit_mode, @on) ; send(M, edit_mode, @off) ), get(M, edit_mode, @Val), send(M, report, status, 'Edit mode is now %s', Val). :- pce_end_class. /******************************** * TOOL FRAMES * ********************************/ :- pce_begin_class(man_frame(label), persistent_frame). variable(manual, man_manual, get, "Manual we are related to"). variable(tool_name, name, get, "Name of the tool in this frame"). initialise(F, Manual:man_manual, Label:[name]) :-> "Create from label":: send(F, send_super, initialise, Label), send(F, slot, manual, Manual), send(F, done_message, message(F, quit)). user_scope(_F, _Scope:chain) :-> "Generic operation: fail":: fail. tool_focus(_F, _Focus:object*) :-> "Generic operation: fail":: fail. selected(_F, _Obj:object*) :-> "Generic operation: fail":: fail. release_selection(_F) :-> "Generic operation: true":: true. edit_mode(_F, _Val:bool) :-> "Generic operation: fail":: fail. related(_F, _From:object, _Rel:name, _To:object) :-> "Generic operation: fail":: fail. unrelated(_F, _From:object, _Rel:name, _To:object) :-> "Generic operation: fail":: fail. quit(F) :-> "Destroy a tool":: send(F?manual, destroy_tool, F). /******************************** * GENERIC USER ACTIONS * ********************************/ request_selection(F, Obj:any*, Open:[bool]) :-> send(F?manual, request_selection, F, Obj, Open). request_tool_focus(F, Obj:object, Force:[bool]) :-> send(F?manual, request_tool_focus, Obj, Force). request_source(F, Obj:object) :-> send(F?manual, request_source, Obj). request_relate(F, Obj:object) :-> send(F?manual, request_relate, Obj). request_unrelate(F, Obj:object) :-> send(F?manual, request_unrelate, Obj). request_inherit(F, Obj:object) :-> send(F?manual, request_inherit, Obj). request_uninherit(F, Obj:object) :-> send(F?manual, request_uninherit, Obj). help(F) :-> "Give help on a manual tool":: get(F, manual, Manual), get(F, tool_name, ToolName), give_help(Manual, F, ToolName). :- pce_end_class. /******************************** * HELP * ********************************/ give_help(Manual, Frame, ToolName) :- get(Manual, module, tools, @on, Tools), ( get(Tools?id_table, find_value, @arg2?tool_name == ToolName, Card) -> send(Manual, request_selection, Frame, Card, @on) ; get(Manual, edit_mode, @on), get(Manual, selection, ToolCard), ToolCard \== @nil, send(ToolCard, instance_of, man_browser_card), send(@display, confirm, 'Assign %s to browser %s', ToolCard?man_name, ToolName) -> send(ToolCard, store, tool_name, ToolName) ; send(@display, inform, 'Sorry, Can''t find help card ...') ).