1/* Part of XPCE --- The SWI-Prolog GUI toolkit 2 3 Author: Jan Wielemaker and Anjo Anjewierden 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org/packages/xpce/ 6 Copyright (c) 1985-2015, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 37Module PCE. This module defines the core of XPCE. It is designed in 38such a way that it may be compiled using the SWI-Prolog qcompile/1 39compiler, which makes XPCE an autoloadable module of SWI-Prolog. 40 41Various things are Prolog-implementation specific in this module and 42therefore each Prolog system will require a different version of this 43module. 44 45This module only defines some paths, some things to make the .qlf 46compiler work on it and finally it just loads the XPCE modules and 47reexports the content of these files. 48- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 49 50:- module(pce, 51 [ new/2, free/1, % pce_principal predicates 52 53 send/2, send/3, send/4, send/5, send/6, send/7, 54 send/8, 55 56 get/3, get/4, get/5, get/6, get/7, get/8, 57 58 send_class/3, 59 get_class/4, 60 object/1, object/2, 61 62 pce_global/2, % pce_global 63 pce_autoload/2, % pce_autoload 64 pce_autoload_all/0, 65 66 pce_term_expansion/2, 67 pce_compiling/1, % -Class 68 pce_compiling/2, % -Class, -Path 69 pce_begin_recording/1, 70 pce_end_recording/0, 71 72 pce_register_class/1, 73 pce_extended_class/1, 74 pce_begin_class_definition/4, 75 pce_prolog_class/1, 76 pce_prolog_class/2, 77 78 pce_catch_error/2, % pce_error 79 pce_open/3, 80 in_pce_thread/1, % :Goal 81 in_pce_thread_sync/1, % :Goal 82 set_pce_thread/0, 83 pce_thread/1, % -Thread 84 pce_dispatch/0, 85 86 op(200, fy, @), 87 op(250, yfx, ?), 88 op(990, xfx, :=) 89 ]). 90 91:- set_prolog_flag(generate_debug_info, false). 92 93:- meta_predicate 94 in_pce_thread_sync(). 95 96 /******************************** 97 * LOAD COMMON PLATFORM * 98 ********************************/ 99 100:- prolog_load_context(directory, Dir), 101 atom_concat(Dir, '/../boot', RawBootDir), 102 absolute_file_name(RawBootDir, BootDir), 103 assert(user:file_search_path(pce_boot, BootDir)). 104 105:- load_files([ pce_boot(pce_expand), 106 pce_boot(pce_pl), 107 pce_boot(pce_principal), 108 pce_boot(pce_error), 109 pce_boot(pce_global), 110 pce_boot(pce_expansion), 111 pce_boot(pce_realise), 112 pce_boot(pce_goal_expansion), 113 pce_boot(pce_autoload), 114 pce_boot(pce_editor), 115 pce_boot(pce_keybinding), 116 pce_boot(pce_portray) 117 ], 118 [ qcompile(part), % compile boot files as part of pce.qlf 119 silent(true) 120 ]). 121:- use_module(pce_dispatch).
130:- create_prolog_flag(xpce_threaded, true, [keep(true)]). 131 132:- dynamic 133 pce_thread/1. 134 135start_dispatch :- 136 ( current_prolog_flag(xpce_threaded, true) 137 -> pce_dispatch([]) 138 ; true 139 ).
Possible bindings of Goal are returned, but be aware that the term has been copied. If in_pce_thread_sync/1 is called in the thread running pce, it behaves as once/1.
151in_pce_thread_sync(Goal) :- 152 thread_self(Me), 153 pce_thread(Me), 154 !, 155 , 156 !. 157in_pce_thread_sync(Goal) :- 158 term_variables(Goal, Vars), 159 pce_principal:in_pce_thread_sync2(Goal-Vars, Vars). 160 161:- initialization 162 start_dispatch. 163 164set_version :- 165 current_prolog_flag(version_data, swi(Major, Minor, Patch, _)), 166 format(string(PlId), 167 'SWI-Prolog version ~w.~w.~w', [Major, Minor, Patch]), 168 send(@prolog, system, PlId). 169 170:- initialization set_version. 171 172get_pce_version :- 173 ( current_prolog_flag(xpce_version, _) 174 -> true 175 ; get(@pce, version, name, Version), 176 create_prolog_flag(xpce_version, Version, []) 177 ). 178 179:- initialization get_pce_version. 180 181 182 /******************************* 183 * CONSOLE * 184 *******************************/ 185 186%:- send(@pce, console_label, 'XPCE/SWI-Prolog'). 187 188 189 /******************************** 190 * PROLOG LIBRARIES * 191 ********************************/ 192 193:- multifile 194 user:file_search_path/2. 195 196user:file_search_path(demo, pce('prolog/demo')). 197user:file_search_path(contrib, pce('prolog/contrib')). 198user:file_search_path(image, pce(bitmaps)). 199 200 201 /******************************* 202 * HOOKS * 203 *******************************/ 204 205:- use_module(swi_hooks). 206 207 /******************************* 208 * EDIT HOOKS * 209 *******************************/ 210 211% make sure SWI-Prolog edit/0 loads the XPCE edit hooks. 212 213:- multifile 214 prolog_edit:load/0, 215 prolog:locate_clauses/2. 216 217prolog_edit:load :- 218 ensure_loaded(library(swi_edit)). 219 220 /******************************* 221 * LIST HOOKS * 222 *******************************/
see library(listing).
231prolog:locate_clauses(Term, Refs) :- 232 ( Term = ->(_,_) 233 ; Term = <-(_,_) 234 ), 235 !, 236 findall(R, method_clause(Term, R), Refs). 237 238match_id(->(Class, Method), Id) :- 239 atomic(Class), atomic(Method), 240 !, 241 atomic_list_concat([Class, (->), Method], Id). 242match_id(->(_Class, _Method), _Id). 243match_id(<-(Class, Method), Id) :- 244 atomic(Class), atomic(Method), 245 !, 246 atomic_list_concat([Class, (<-), Method], Id). 247match_id(<-(_Class, _Method), _Id). 248 249method_clause(->(Class, Send), Ref) :- 250 match_id((Class->Send), Id), 251 clause(pce_principal:send_implementation(Id, _M, _O), _B, Ref), 252 atom(Id), 253 atomic_list_concat([Class,Send], '->', Id). 254method_clause(<-(Class, Get), Ref) :- 255 match_id(<-(Class, Get), Id), 256 clause(pce_principal:get_implementation(Id, _M, _O, _R), _B, Ref), 257 atom(Id), 258 atomic_list_concat([Class,Get], '->', Id)