/* Part of XPCE --- The SWI-Prolog GUI toolkit
Author: Jan Wielemaker and Anjo Anjewierden
E-mail: J.Wielemaker@vu.nl
WWW: http://www.swi-prolog.org/packages/xpce/
Copyright (c) 2001-2022, University of Amsterdam
VU University Amsterdam
SWI-Prolog Solutions b.v.
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(prolog_gui,
[ prolog_tracer/2, % +Thread, -GUI
send_tracer/2, % +Thread, :Goal
send_if_tracer/2, % +Thread, :Goal
get_tracer/3, % +Thread, :Goal, -Result
send_tracer/1, % :Goal
send_if_tracer/1, % :Goal
get_tracer/2, % :Goal, -Result
in_debug_thread/2, % +ObjOrThread, :Goal
thread_debug_queue/2, % +Thread, -Queue
prolog_frame_attribute/4, % +GUI, +Frame, +Attr, -Value
prolog_choice_attribute/4 % +GUI, +Choice, +Attr, -Value
]).
:- use_module(library(pce)).
:- use_module(library(lists)).
:- use_module(library(toolbar)).
:- use_module(library(pce_report)).
:- use_module(library(pce_util)).
:- use_module(library(persistent_frame)).
:- use_module(library(debug)).
:- if(exists_source(library(threadutil))).
:- use_module(library(threadutil)).
:- endif.
:- use_module(library(pprint)).
:- use_module(trace).
:- use_module(clause).
:- use_module(util).
:- use_module(source).
:- consult([ settings,
stack,
viewterm
]).
:- require([ make/0,
acyclic_term/1,
current_predicate/1,
notrace/1,
pce_image_directory/1,
portray_text/1,
set_portray_text/3,
prolog_ide/1,
thread_self/1,
atomic_list_concat/2,
file_directory_name/2,
pce_help_file/2,
predicate_name/2,
prolog_listen/2,
prolog_unlisten/2,
string_codes/2,
term_attvars/2,
unify_with_occurs_check/2,
with_mutex/2,
'$factorize_term'/3,
'$get_predicate_attribute'/3,
absolute_file_name/3,
atomic_list_concat/3,
file_name_extension/3,
maplist/3,
numbervars/4,
start_emacs/0
]).
:- if(current_prolog_flag(threads, true)).
:- require([ message_queue_create/1,
message_queue_destroy/1,
thread_get_message/2,
thread_property/2,
thread_send_message/2,
thread_signal/2
]).
:- endif.
:- multifile
user:message_hook/3.
:- meta_predicate
in_debug_thread(+, 0),
send_pce(0),
send_pce_async(0).
register_directories :-
( member(SpyBase, ['icons/nospy', library('trace/icons/nospy')]),
absolute_file_name(SpyBase,
[ extensions([xpm]), access(read)],
SpyIcon)
-> file_directory_name(SpyIcon, Icons),
pce_image_directory(Icons)
),
( member(HlpBase, ['pltracer', library('trace/pltracer')]),
absolute_file_name(HlpBase,
[ extensions([hlp]), access(read)],
HlpFile)
-> pce_help_file(pltracer, HlpFile)
).
:- register_directories.
version('2.0').
/*******************************
* RESOURCES *
*******************************/
resource(debug, image, image('debug.xpm')).
resource(Name, image, image(XPM)) :-
button(_, _, XPM, _),
file_name_extension(Name, xpm, XPM).
/*******************************
* TOPLEVEL *
*******************************/
:- dynamic
gui/3. % +Thread, +BreakLevel, -Gui
%! prolog_tracer(+Thread, -Ref) is det.
%! prolog_tracer(+Thread, -Ref, +Create) is semidet.
%
% Get the Prolog debugger window for Thread.
prolog_tracer(Thread, Ref) :-
prolog_tracer(Thread, Ref, true).
% (*) (Windows) we must start Emacs first because Emacs tries to setup a
% DDE service on Windows, but send_pce/1 eventually calls
% thread_get_message/2, which causes the main thread to block on a
% condition variable using SleepConditionVariableCS(), which does not
% process Windows messages and sleeps for 15 seconds before continuing.
% In contrast, start_emacs/0 uses in_pce_thread_sync/1 which uses a
% normal message loop to wait for xpce to do its job. Note that the
% debugger cannot use in_pce_thread_sync/1 because it requires a method
% to wait that allows for callbacks.
prolog_tracer(Thread, Ref, Create) :-
break_level(Level),
( gui(Thread, Level, Ref)
-> true
; Create == true
-> debug(gtrace(gui),
'New GUI for thread ~p, break level ~p', [Thread, Level]),
start_emacs, % see (*)
send_pce(send(new(Ref, prolog_debugger(Level, Thread)), open))
).
%! break_level(-Level) is det.
%
% Current break-level. Level is left unbound if the caller is an
% engine. In that case we use the break level of the client
% thread.
break_level(Level) :-
current_prolog_flag(break_level, Level),
!.
break_level(_Level) :-
thread_self(Me),
thread_property(Me, engine(true)),
!.
break_level(-1). % non-interactive thread.
%! send_tracer(+ThreadOrGUI, +Term) is semidet.
%! send_if_tracer(+Thread, +Term) is semidet.
%! get_tracer(+Thread, +Term, -Reply) is semidet.
%
% Send messages to the XPCE tracer window.
%
% @param Thread: calling thread.
send_tracer(Term) :-
notrace(send_tracer_(Term)).
send_tracer_(Term) :-
thread_self_id(Thread),
send_tracer(Thread, Term).
send_tracer(GUI, Term) :-
object(GUI),
!,
send_pce(send(GUI, Term)).
send_tracer(Thread, Term) :-
prolog_tracer(Thread, Ref),
send_pce(send(Ref, Term)).
send_if_tracer(Term) :-
thread_self_id(Thread),
send_if_tracer(Thread, Term).
send_if_tracer(Thread, Term) :-
( prolog_tracer(Thread, Ref, false)
-> send_pce(send(Ref, Term))
; true
).
get_tracer(Term, Result) :-
thread_self_id(Thread),
get_tracer(Thread, Term, Result).
get_tracer(GUI, Term, Result) :-
object(GUI),
!,
get(GUI, Term, Result).
get_tracer(Thread, Term, Result) :-
prolog_tracer(Thread, Ref),
get(Ref, Term, Result).
/*******************************
* THREAD SYNCHRONISATION *
*******************************/
%! thread_debug_queue(+Thread, -Queue) is det.
%
% Queue is the debugging queue for Thread. We do not use the main
% queue to avoid interference with user-messages.
:- dynamic
thread_debug_queue_store/2.
thread_debug_queue(Thread, Queue) :-
with_mutex(debug_msg_queue,
thread_debug_queue_locked(Thread, Queue)).
thread_debug_queue_locked(Thread, Queue) :-
( thread_debug_queue_store(Thread, Q)
-> Queue = Q
; message_queue_create(Q),
assert(thread_debug_queue_store(Thread, Q)),
Queue = Q
).
:- initialization
( current_prolog_flag(threads, true)
-> prolog_unlisten(thread_exit, thread_finished),
prolog_listen(thread_exit, thread_finished)
; true
).
thread_finished(TID) :-
destroy_thread_debug_gui(TID),
forall(retract(thread_debug_queue_store(TID, Queue)),
message_queue_destroy(Queue)).
msg_id(Id) :-
with_mutex(debug_msg_id,
msg_id_locked(Id)).
:- dynamic
trace_msg_id/1.
msg_id_locked(Id) :-
( retract(trace_msg_id(Id0))
-> NId is Id0+1
; NId = 1
),
assert(trace_msg_id(NId)),
Id = NId.
%! send_pce(:Goal)
%
% Run Goal in XPCE thread. Wait for completion. In the meanwhile,
% allow the XPCE thread to call in_debug_thread/1.
send_pce(Goal) :-
thread_self_id(Me),
pce_thread(Me),
!,
Goal.
send_pce(Goal) :-
thread_self_id(Self),
term_variables(Goal, GVars),
msg_id(Id),
in_pce_thread(run_pce(Goal, GVars, Self, Id)),
thread_debug_queue(Self, Queue),
repeat,
thread_get_message(Queue, '$trace'(Result, Id2)),
debug(gtrace(thread),
' ---> ~w: send_pce: result = ~p', [Id2, Result]),
( Result = call(CallBack, CBVars, Caller)
-> run_pce(CallBack, CBVars, Caller, Id2),
fail
; assertion(Id == Id2),
( Result = true(BGVars)
-> !, BGVars = GVars
; Result == false
-> fail
; Result = error(E)
-> throw(E)
; assertion(false)
)
).
run_pce(Goal, Vars, Caller, Id) :-
debug(gtrace(thread), '~w: running ~p for thread ~p',
[Id, Goal, Caller]),
( catch(Goal, Error, true)
-> ( var(Error)
-> Result = true(Vars)
; Result = error(Error)
)
; Result = false
),
debug(gtrace(thread), '~w: ok, returning ~p', [Id, Result]),
thread_debug_queue(Caller, Queue),
thread_send_message(Queue, '$trace'(Result, Id)).
%! in_debug_thread(+Thread, :Goal) is semidet.
%! in_debug_thread(+Object, :Goal) is semidet.
%
% Run Goal in the thread being debugged. The first argument is
% either an XPCE object that is part of the debugger window, or a
% thread identifier.
in_debug_thread(Object, Goal) :-
object(Object),
!,
get(Object, frame, Frame),
get(Frame, thread, Thread),
in_debug_thread(Thread, Goal).
in_debug_thread(Thread, Goal) :-
thread_self_id(Thread),
!,
Goal,
!.
in_debug_thread(Thread, Goal) :-
thread_self_id(Self),
msg_id(Id),
debug(gtrace(thread), 'Call [Thread ~p] ~p', [Thread, Goal]),
term_variables(Goal, GVars),
thread_debug_queue(Thread, Queue),
thread_send_message(Queue, '$trace'(call(Goal, GVars, Self), Id)),
thread_debug_queue(Self, MyQueue),
thread_get_message(MyQueue, '$trace'(Result, Id)),
debug(gtrace(thread),
' ---> in_debug_thread: result = ~p', [Result]),
( Result = error(E)
-> throw(E)
; Result = true(BGVars)
-> GVars = BGVars
).
%! send_pce_async(:Goal) is det.
%
% Send to the debug thread asynchronously.
send_pce_async(Goal) :-
thread_self_id(Me),
pce_thread(Me),
!,
Goal.
send_pce_async(Goal) :-
in_pce_thread(Goal).
%! prolog_frame_attribute(+GUI, +Frame, +Attribute, -Value) is det.
%! prolog_frame_attribute(+Thread, +Frame, +Attribute, -Value) is det.
%
% As prolog_frame_attribute/3, but calling in the thread debugged
% by GUI.
prolog_frame_attribute(Thread, Frame, Attribute, Value) :-
in_debug_thread(Thread,
prolog_frame_attribute(Frame, Attribute, Value)).
prolog_choice_attribute(GUI, Choice, Attribute, Value) :-
in_debug_thread(GUI,
prolog_choice_attribute(Choice, Attribute, Value)).
/*******************************
* DEBUGGER APPLICATION *
*******************************/
:- pce_global(@prolog_gui, new(prolog_gui)).
:- pce_begin_class(prolog_gui, application,
"Toplevel driver for the Prolog GUI").
initialise(App) :->
send_super(App, initialise, 'Prolog Debugger GUI'),
send(App, kind, service). % Do not debug in this
:- pce_end_class.
/*******************************
* DEBUGGER FRAME *
*******************************/
:- pce_begin_class(prolog_debugger, persistent_frame,
"Toplevel driver for the debugger").
variable(source, any, both, "Source view").
variable(break_level, int, get, "Break-level I'm associated to").
variable(thread, 'int|name*', get, "Associated thread").
variable(trap_frame, int*, get, "Last trapped frame").
variable(trap_port, name*, get, "Last trapped port").
variable(current_frame, int*, both, "The most recent frame").
variable(quitted, bool := @off, both, "Asked to quit").
variable(mode, name := created,get, "Current mode").
running_in_pce_thread :-
pce_thread(Pce), thread_self_id(Pce).
initialise(F, Level:int, Thread:'int|name') :->
assertion(running_in_pce_thread),
send(F, slot, break_level, Level),
send(F, slot, thread, Thread),
send_super(F, initialise, 'SWI-Prolog debugger',
application := @prolog_gui),
send(F, icon, resource(debug)),
send(F, done_message, message(F, quit)),
send(F, append, new(MBD, dialog)),
send(MBD, gap, size(0, 2)),
send(MBD, pen, 0),
send(MBD, append, new(menu_bar)),
send(MBD, name, menu_bar_dialog),
send(MBD, resize_message, message(MBD, layout, @arg2)),
send(F, fill_menu_bar),
send(new(D, prolog_button_dialog), below, MBD),
send(D, name, buttons),
new(V, prolog_bindings_view),
send(V, label, 'Bindings'),
send(V, name, bindings),
send(new(S, prolog_stack_view), right, V),
send(V, below, D),
send(new(Src, prolog_source_view), below, V),
send(F, source, Src),
send(new(RD, report_dialog), below, Src),
send(RD, warning_delay, 0),
send(S, label, 'Call Stack'),
send(S, name, stack),
ignore(send(F, frame_finished, 0)), % FR_WATCHED issue
asserta(gui(Thread, Level, F)).
unlink(F) :->
retractall(gui(_, _, F)),
clear_clause_info_cache, % safety first
send_super(F, unlink).
quit(F) :->
"User initiated quit"::
( ( get(F, mode, thread_finished)
; get(F, mode, query_finished)
; get(F, mode, aborted)
; get(F, mode, replied)
)
-> send(F, destroy)
; get(F, tracer_quitted, Action),
( Action == cancel
-> true
; send(F, return, Action)
)
).
label(F, Label:char_array) :->
"Set label, indicating associated thread"::
get(F, thread, Thread),
( Thread == main
-> send_super(F, label, Label)
; send_super(F, label, string('[Thread %s] %s', Thread, Label))
).
clear_stack_window(F) :->
"Clear the stack window"::
get(F, member, stack, StackView),
send(StackView, clear).
clear(F, Content:[bool]) :->
"Deactivate all views"::
ignore(send(F, send_hyper, fragment, free)),
get(F, member, stack, StackView),
send(StackView, clear),
get(F, member, bindings, BindingView),
send(BindingView, clear, Content).
fill_menu_bar(F) :->
get(F, member, menu_bar_dialog, MBD),
get(MBD, member, menu_bar, MB),
send(MB, append, new(Tool, popup(tool))),
send(MB, append, new(Edit, popup(edit))),
send(MB, append, new(View, popup(view))),
send(MB, append, new(Comp, popup(compile))),
send(MB, append, new(Help, popup(help)), right),
send_list(Tool, append,
[ menu_item(settings,
message(F, settings),
end_group := @on),
menu_item(clear_source_cache,
message(@prolog, clear_clause_info_cache),
end_group := @on),
menu_item(quit,
message(F, quit))
]),
send_list(Edit, append,
[ menu_item(breakpoints,
message(F, breakpoints)),
menu_item(exceptions,
message(F, exceptions),
end_group := @on),
menu_item(toggle_edit_mode,
message(F, edit),
end_group := @on),
menu_item(copy_goal,
message(F, copy_goal))
]),
send_list(View, append,
[ menu_item(threads,
message(F, show_threads)),
new(PT, menu_item(portray_code_lists,
message(F, portray_text)))
]),
send_list(Comp, append,
[ menu_item(make,
message(F, make),
end_group := @on)
]),
send_list(Help, append,
[ menu_item(about,
message(F, about)),
menu_item(help_on_debugger,
message(F, help),
end_group := @on),
menu_item(prolog_manual,
message(@prolog, prolog_help)),
menu_item('XPCE manual',
message(@prolog, manpce))
]),
send(View, show_current, @on),
send(View, multiple_selection, @on),
send(PT, condition, message(F, update_portray_text, PT)).
settings(_F) :->
"Edit the preferences"::
trace_settings.
about(_) :->
"Display aout message"::
version(Version),
send(@display, inform,
'SWI-Prolog debugger version %s\n\c
By Jan Wielemaker',
Version).
help(_) :->
"Show window with help-text"::
send(@helper, give_help, pltracer, main).
show_frame(GUI, Frame:int, PC:prolog) :->
"Show the variables of this frame"::
( get(GUI, trap_frame, Frame) % the initial trapped port
-> get(GUI, trap_port, Style)
; PC = choice(_) % A choice-point
-> Style = choice
; Style = frame % Somewhere up the stack
),
prolog_show_frame(Frame, [ gui(GUI), pc(PC),
source, bindings,
style(Style)
]).
show_stack(GUI, CallFrames:prolog, ChoiceFrames:prolog) :->
"Show the stack and choicepoints"::
get(GUI, member, stack, StackWindow),
send(StackWindow, clear),
display_stack(StackWindow, CallFrames, ChoiceFrames).
show_threads(_GUI) :->
"Open Thread monitor"::
prolog_ide(thread_monitor).
portray_text(GUI) :->
"Toggle portray of text"::
portraying_text(Old),
negate(Old, New),
portray_text(New),
send(GUI, refresh_bindings),
send(GUI, report, status, 'Portray code-list as text: %s', New).
negate(true, false).
negate(false, true).
update_portray_text(_GUI, MI:menu_item) :->
"Update selected of portray text item"::
portraying_text(Bool),
send(MI, selected, Bool).
%! portraying_text(-Bool) is det.
%
% Whether or not portraying text is enabled. The first checks that the
% library is loaded.
portraying_text(Bool) :-
current_predicate(portray_text:set_portray_text/3),
!,
set_portray_text(enabled, Bool, Bool).
portraying_text(false).
trapped_location(GUI, StartFrame:int, Frame:int, Port:name) :->
"The last trapped location"::
send(GUI, slot, trap_frame, Frame),
send(GUI, slot, trap_port, Port),
send(GUI, current_frame, StartFrame).
refresh_bindings(GUI) :->
"Refresch the binding view after changing parameters"::
( get(GUI, member, bindings, Bindings),
get(Bindings, prolog_frame, Frame),
Frame \== @nil
-> prolog_show_frame(Frame, [ gui(GUI),
bindings
])
; true
).
/*******************************
* EVENT *
*******************************/
source_typed(Frame, Typed:event_id) :->
"Forward a typing event to the button-dialog"::
get(Frame, member, buttons, Dialog),
send(Dialog, typed, Typed).
/*******************************
* ACTIONS *
*******************************/
window_pos_for_button(F, ButtonName:name, Pos:point) :<-
"Return position for transient window reacting on Button"::
get(F, member, buttons, Dialog),
get(Dialog, button, ButtonName, Button),
get(Button, display_position, ButtonPos),
get(ButtonPos, plus, point(0, 25), Pos).
prepare_action(Frame) :->
"Prepare for reading an action"::
send(Frame, open), % make sure
get(Frame, display, Display),
send(Display, busy_cursor, @nil),
send(Display, synchronise),
send(Frame, mode, wait_user).
action(Frame, Action:name) :<-
"Wait for the user to return an action"::
send(Frame, prepare_action),
get(Frame, confirm, Action),
( get(Frame, quitted, @on)
-> send(Frame, destroy)
; true
).
return(Frame, Result:any) :->
"Return user action"::
( get(Frame, mode, wait_user)
-> get(Frame, thread, Thread),
send(Frame, mode, replied),
( pce_thread(Thread)
-> send_super(Frame, return, Result)
; ( get(Frame, quitted, @on)
-> send(Frame, destroy)
; true
),
debug(gtrace(thread),
' ---> frame for thread = ~p: result = ~p',
[Thread, Result]),
thread_debug_queue(Thread, Queue),
thread_send_message(Queue, '$trace'(action(Result), action))
)
; get(Frame, quitted, @on)
-> send(Frame, destroy)
; send(Frame, report, warning, 'Not waiting')
).
%! tracer_quitted(+Thread, -Action) is semidet.
%
% Ask the user what to do after a user-initiated quit of the
% debugger.
tracer_quitted(Frame, Action) :<-
"Confirm user requested quit"::
get(Frame, thread, Thread),
( Thread == main
-> Label = 'Tracer quitted'
; Label = string('[Thread %s] Tracer quitted', Thread)
),
new(D, dialog(Label)),
send(D, application, @prolog_gui),
send(D, append,
button(continue_without_debugging,
message(D, return, nodebug))),
send(D, append,
button(abort,
message(D, return, abort))),
( Thread == main
-> send(D, append,
button(exit_prolog,
message(D, return, halt)))
; true
),
send(D, append,
button(cancel,
message(D, return, cancel))),
send(D, transient_for, Frame),
send(D, modal, transient),
get(D, confirm_centered, Frame?area?center, Action),
send(D, destroy),
( Action == cancel
-> true
; send(Frame, quitted, @on)
).
selected_frame(F, Frame:int) :<-
"Prolog frame selected by user in stack window"::
get(F, member, stack, Browser),
get(Browser, selection, Frame).
/*******************************
* ACTIONS OF THE SOURCE VIEW *
*******************************/
:- pce_group(actions).
edit(F) :->
"(Toggle) Edit-mode of source-window"::
send(F?source, edit).
breakpoints(_F) :->
"Edit spy/break/trace-points"::
prolog_ide(open_debug_status).
exceptions(_F) :->
"Edit exceptions"::
prolog_ide(open_exceptions).
make(_) :->
"Run Prolog make"::
( object(@emacs)
-> send(@emacs, save_some_buffers)
; true
),
make.
goal(F, Goal:prolog) :<-
"Return qualitied term for selected frame"::
get(F, selected_frame, Frame),
prolog_frame_attribute(F, Frame, goal, Goal0),
( Goal0 = _:_
-> Goal = Goal0
; Goal = user:Goal0
).
nostop_or_spy(F) :->
"Clear spy-point"::
( send(F?source, delete_selected_stop)
-> true
; ( get(F, current_frame, Frame)
; get(F, selected_frame, Frame)
),
Frame \== @nil,
prolog_frame_attribute(F, Frame, goal, Goal0),
( Goal0 = _:_
-> Goal = Goal0
; Goal = user:Goal0
),
'$get_predicate_attribute'(Goal, spy, 1)
-> nospy(Goal)
; send(F, report, warning,
'No selected break or current spy-point')
).
browse(_F) :->
"Provides overview for edit/spy/break"::
prolog_ide(open_navigator).
stop_at(F) :->
"Set stop at caret"::
get(F, source, SourceWindow),
send(SourceWindow, stop_at).
up(F) :->
"Select child frame"::
get(F, member, stack, Stack),
send(Stack, up).
down(F) :->
"Select parent frame"::
get(F, member, stack, Stack),
send(Stack, down).
details(F) :->
"Show (variable) details"::
get(F, member, bindings, Bindings),
send(Bindings, details).
nodebug(F) :->
"User hit n(odebug)"::
( setting(auto_close, true)
-> send(F, quitted, @on)
; true
),
send(F, return, nodebug).
abort(F) :->
"User hit a(bort)"::
( setting(auto_close, true)
-> send(F, quitted, @on)
; true
),
send(F, return, abort).
interrupt(F) :->
"User hit t (interrupt, trace)"::
get(F, thread, Thread),
thread_signal(Thread, trace).
query(F) :->
"Enter and run a query"::
send(F, check_console),
send(F, report, status,
'Started toplevel in console. Type Control-D to resume debugging'),
send(F, synchronise),
in_debug_thread(F, prolog),
send(F, report, status,
'Toplevel has terminated; resuming debugger').
check_console(F) :->
"See whether the debugged thread has a console"::
( in_debug_thread(F, thread_has_console)
-> true
; send(@display, inform,
'The debugged thread is not attached to a console.\n\c
Cannot run an interactive session in the debuggee.'),
fail
).
interactor(F) :->
"Open a new interactor"::
send(F, warn_windows_thread),
prolog_ide(open_interactor).
warn_windows_thread(_F) :->
"Warn to run in a separate thread"::
( current_prolog_flag(windows, true),
pce_thread(main)
-> send(@display, inform,
'Opening a new interactor from the debugger requires\n\c
for the tools to run in a separate thread. Please set\n\c
the flag "xpce_threaded" to "true" in your Prolog startup\n\c
file and restart Prolog'),
fail
; true
).
copy_goal(F) :->
"Copy the current goal into the copy-buffer"::
get(F, selected_frame, Frame),
( Frame \== @nil
-> true
; send(F, report, warning, 'No current frame'),
fail
),
prolog_frame_attribute(F, Frame, goal, Goal),
prolog_frame_attribute(F, Frame, predicate_indicator, PI),
( numbervars(Goal, 0, _, [attvar(skip)]),
format(string(Text), '~q', [Goal]),
send(@display, copy, Text),
fail
; true
),
format(atom(PIA), '~q', [PI]),
send(F, report, inform, 'Copied goal (%s) to clipboard', PIA).
:- pce_group(delegate).
file(F, File:'name|emacs_buffer*') :->
"Attach to indicated file"::
send(F?source, source, File).
show_range(F, File:'name|text_buffer', From:int, To:int, Style:name) :->
"Show indicated region using Style"::
send(F?source, show_range, File, From, To, Style).
show_line(F, File:'name|text_buffer', Line:int, Style:name) :->
"Show numbered line"::
send(F?source, show_line, File, Line, Style).
listing(F, Module:name, Predicate:name, Arity:int) :->
"List the specified predicate"::
send(F?source, listing, Module, Predicate, Arity).
/* NOTE: lazy creation of this message interferes with call_cleanup/2 used
by findall/3 from XPCE's lazy method binder. Therefore we make a
dummy call to this method in ->initialise.
*/
frame_finished(F, Frame:int) :->
"This frame was terminated; remove it"::
get(F, member, stack, StackView),
send(StackView, frame_finished, Frame),
( get(F, member, bindings, Bindings),
get(Bindings, prolog_frame, Frame)
-> send(Bindings, background,
?(Bindings, class_variable_value, background_inactive)),
send(Bindings, slot, prolog_frame, @nil),
ignore(send(F, send_hyper, fragment, free))
; true
),
( get(F, current_frame, Frame)
-> send(F, current_frame, @nil)
; true
).
aborted(F) :->
"User has aborted the query"::
send(F, clear, @off),
send(F, mode, aborted),
send(F, report, status, 'Execution aborted').
thread_finished(F, Status:prolog) :->
"Thread I'm associated with finished"::
send(F, clear),
send(F, mode, thread_finished),
format(string(String), '~q', Status),
send(F, report, status, 'Thread finished: %s', String).
query_finished(F, Message:char_array) :->
"Toplevel query finished"::
send(F, clear),
send(F, mode, query_finished),
send(F, report, status, Message).
mode(F, Mode:name) :->
"Switch modes"::
send(F, slot, mode, Mode),
( get(F, member, buttons, D)
-> ( Mode == wait_user
-> send(D, running, @off)
; send(D, running, @on)
)
; true
).
:- pce_end_class(prolog_debugger).
/*******************************
* BUTTONS *
*******************************/
:- pce_begin_class(prolog_button_dialog, dialog,
"Dialog holding the function buttons").
% button(Action, Keys, Image, Balloon)
%
% If action is +Action, send message Action to the frame. Otherwise
% return Action to the caller.
button(into, "i", 'into.xpm', 'Show unification').
button(creep, "\n ", 'creep.xpm', 'Step').
button(skip, "s", 'skip.xpm', 'Skip over this goal').
button(finish, "f", 'finish.xpm', 'Finish selected goal').
button(gap, -, -, -).
button(retry, "r", 'retry.xpm', 'Retry selected goal').
button(gap, -, -, -).
button(+nodebug, "n", 'nodebug.xpm', 'Continue without debugging').
button(+abort, "a", 'abort.xpm', 'Abort to the Prolog toplevel').
button(+interrupt, "t", 'interrupt.xpm', 'Interrupt (trace)').
button(+query, "b", 'break.xpm', 'Enter a query (in debugged thread)').
button(+interactor, "B", 'interactor.xpm', 'Enter a query (in new thread)').
button(fail, "F", 'fail.xpm', 'Force query to fail').
button(gap, -, -, -).
button(+up, "u", 'up.xpm', 'Select parent frame').
button(+down, "d", 'down.xpm', 'Select child frame').
button(gap, -, -, -).
button(+browse, "", '16x16/butterfly.xpm', 'Browse program structure').
button(gap, -, -, -).
button(leap, "l", 'leap.xpm', 'Continue to spy- or breakpoint').
button(+breakpoints, "+", 'spy.xpm', 'Edit spy- and breakpoints').
button(+stop_at, "!", 'stop.xpm', 'Set Stop at caret').
button(+nostop_or_spy, "-", 'nostopspy.xpm', 'Delete break- or spy-point').
button(gap, -, -, -).
button(+details, "v", 'details.xpm', 'Show (variable) details').
button(+edit, "e", 'edit.xpm', 'Toggle read-only/edit-mode').
tag_balloon(Balloon0, Keys, Balloon) :-
maplist(key_name, Keys, Names),
atomic_list_concat(Names, ', ', Tag),
atomic_list_concat([Balloon0, ' (', Tag, ')'], Balloon).
key_name(10, return) :- !.
key_name(32, space) :- !.
key_name(C, A) :-
char_code(A, C).
initialise(D) :->
send_super(D, initialise),
send(D, pen, 0),
send(D, gap, size(0,0)),
get(D, frame, Frame),
send(D, append, new(TB, tool_bar(Frame))),
( button(Action, KeyString, Image, Balloon0),
file_name_extension(Resource, _, Image),
string_codes(KeyString, Keys),
( Action == gap
-> send(TB, append, gap)
; tag_balloon(Balloon0, Keys, Balloon),
make_message(Action, Name, D, Message),
send(TB, append,
new(B, tool_button(Message,
resource(Resource),
Balloon,
name := Name))),
chain_list(KL, Keys),
send(B, attribute, keys, KL)
),
fail
; true
).
make_message(+Action, Action, D, message(D?frame, Action)) :- !.
make_message(Action, Action, D, message(D, return, Action)).
typed(D, Id:event_id, Delegate:[bool]) :->
"Handle typing"::
( get(D, find, @default,
and(message(@arg1, has_get_method, keys),
message(@arg1?keys, member, Id)),
Button)
-> send(Button, execute)
; Delegate == @on
-> send_super(D, typed, Id, Delegate)
).
event(D, Ev:event) :->
( send(Ev, is_a, keyboard)
-> send(D, typed, Ev)
; send_super(D, event, Ev)
).
button(D, Name:name, Button:button) :<-
"Find button from its name"::
get(D, member, tool_bar, TB),
get(TB, member, Name, Button).
running(D, Running:bool) :->
"Make some buttons (in)active"::
get(Running, negate, NotRunning),
forall(running_button(Name),
( get(D, button, Name, Button)
-> send(Button, active, NotRunning)
; format('No button ~w~n', [Name])
)),
( get(D, button, interrupt, Interrupt)
-> send(Interrupt, active, Running)
; true
).
running_button(into).
running_button(creep).
running_button(skip).
running_button(retry).
running_button(finish).
running_button(nodebug).
running_button(abort).
:- pce_end_class(prolog_button_dialog).
/*******************************
* VARIABLES *
*******************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
We use a view with some tweaks to display the bindings. Originally we
used a browser, but a view has two advantages. First of all, we can
write directly to it by opening it as a stream and second the user can
use search and selection on the view to analyse it or export text from
it.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
:- pce_begin_class(prolog_bindings_view, view,
"Overview of bindings of the current frame").
class_variable(font, font, normal, "Font for bindings").
class_variable(size, size, size(40,11), "Initial size").
variable(prolog_frame, int*, both, "Frame who's variables we are showing").
class_variable(background_active, colour, white).
class_variable(background_inactive, colour, grey80).
:- pce_global(@prolog_binding_recogniser,
make_prolog_binding_recogniser).
:- pce_global(@prolog_binding_popup,
make_prolog_binding_popup).
make_prolog_binding_recogniser(G) :-
new(View, @event?window),
new(Index, ?(@event?receiver, index, @event)),
new(C1, click_gesture(left, '', single,
message(View, on_click, Index))),
new(C2, click_gesture(left, '', double,
message(View, details))),
new(C3, popup_gesture(@prolog_binding_popup)),
send(@prolog_binding_popup, update_message,
message(View, on_click, Index)),
new(G, handler_group(C1, C2, C3)).
make_prolog_binding_popup(P) :-
new(P, popup),
send_list(P, append,
[ menu_item(details, message(@arg1?window, details)),
menu_item(copy, message(@arg1?window, details,
@default, copy))
]).
initialise(B) :->
send_super(B, initialise),
send(B?text_buffer, undo_buffer_size, 0),
get(B, font, Font),
get(Font, ex, Ex),
Tab is 15 * Ex,
send(B, wrap, none),
send(B?image, tab_stops, vector(Tab)),
send(B?image, recogniser, @prolog_binding_recogniser),
send(B, editable, @off),
send(B, style, constraint, style(colour := blue)),
send(B?text_cursor, displayed, @off),
send(B, ver_stretch, 0).
clear(B, Content:[bool]) :->
send(B, prolog_frame, @nil),
( Content == @off
-> send(B, background, ?(B, class_variable_value, background_inactive))
; send_super(B, clear)
).
scroll_to_end(B) :->
"Scroll the last line to the bottom"::
get(B, editor, E),
get(E, size, size(_,Lines)),
send(E, scroll_to, @default, Lines).
details(B, Fragment:[prolog_frame_var_fragment], Action:[{view,copy}]) :->
"View details of the binding"::
get(B, prolog_frame, Frame),
( Frame \== @nil
-> true
; send(B, report, warning, 'No current frame'),
fail
),
( Fragment == @default
-> ( get(B, selected_fragment, Frag),
Frag \== @nil
-> true
; send(B, report, warning, 'No selected variable'),
fail
)
; Frag = Fragment
),
( get(Frag, var_name, VarName)
-> get(Frag, value, Value),
prolog_frame_attribute(B, Frame, level, Level),
prolog_frame_attribute(B, Frame, goal, Goal),
predicate_name(Goal, PredName),
( integer(VarName)
-> VarType = 'Argument'
; VarType = 'Variable'
),
format(string(Label), '~w ~w of frame at level ~d running ~w',
[ VarType, VarName, Level, PredName ]),
debug(gtrace(bindings), 'Action ~w on ~w', [Action, Value]),
( Action == copy
-> ( numbervars(Value, 0, _, [attvar(skip)]),
format(string(Text), '~q', [Value]),
send(@display, copy, Text),
fail
; send(B, report, status, Label)
)
; view_term(Value,
[ comment(Label),
source_object(Frag),
expose(true)
])
)
; send(B, report, warning, 'Not a variable value')
).
on_click(B, Index:int) :->
"Select fragment clicked"::
get(B, text_buffer, TB),
send(B, selection, Index, Index), % do not move
( get(TB, find_fragment, message(@arg1, overlap, Index), Frag)
-> send(B, selected_fragment, Frag)
; send(B, selected_fragment, @nil)
).
% Bindings is a list of Vars = Value, where Vars is a list of variable
% identifiers that take the form Name:ArgN, were Name is the variable
% name (atom) and ArgN is the location in the frame.
bindings(B, Bindings:prolog) :->
"Display complete list of bindings"::
( term_attvars(Bindings, [])
-> Plain = Bindings,
Constraints = []
; copy_term(Bindings, Plain, Constraints)
),
debug(gtrace(bindings), 'Plain = ~p, Constraints = ~p', [Plain, Constraints]),
bind_vars(Plain),
cycles(Plain, Template, Cycles, Plain),
send(B, background, ?(B, class_variable_value, background_active)),
pce_open(B, write, Fd),
( forall(member(Vars=Value, Template),
send(B, append_binding, Vars, value(Value), Fd)),
forall(member(C, Constraints),
send(B, append_extra, C, Fd, constraint)),
forall(member(C, Cycles),
send(B, append_extra, C, Fd, cycle)),
fail
; true
),
close(Fd),
send(B, scroll_to_end).
bind_vars([]).
bind_vars([Vars=Value|T]) :-
( var(Value)
-> ( Vars = [Name:_|_] % clustered
-> Value = '$VAR'(Name)
; Vars = Name:_ % non-clustered
-> Value = '$VAR'(Name)
)
; true
),
bind_vars(T).
cycles(Term, Template, Cycles, _) :-
acyclic_term(Term),
!,
Template = Term,
Cycles = [].
cycles(Term, Template, Cycles, Bindings) :-
'$factorize_term'(Term, Template, Factors),
bind_non_cycles(Factors, Cycles),
name_cycle_vars(Cycles, 1, Bindings).
bind_non_cycles([], []).
bind_non_cycles([V=Term|T], L) :-
unify_with_occurs_check(V, Term),
!,
bind_non_cycles(T, L).
bind_non_cycles([H|T0], [H|T]) :-
bind_non_cycles(T0, T).
name_cycle_vars([], _, _).
name_cycle_vars([H|T], I, Bindings) :-
H = (Var=_Value),
( member(Vars=VarsValue, Bindings),
VarsValue == Var,
Vars = [Name:_|_]
-> I2 = I
; atom_concat('_S', I, Name),
I2 is I + 1
),
Var = '$VAR'(Name),
name_cycle_vars(T, I2, Bindings).
append_binding(B, Names0:prolog, ValueTerm:prolog, Fd:prolog) :->
"Add a binding to the browser"::
ValueTerm = value(Value0), % protect :=, ?, etc.
( Value0 = '$VAR'(Name),
( Names0 = [Name:_]
; Names0 = Name:_
)
-> ( setting(show_unbound, false)
-> true
; format(Fd, '~w\t= _~n', [Name])
)
; ( Value0 = '$VAR'(_), Names0 = [_,_|_]
-> append(Names, [VarN:_], Names0),
Value = '$VAR'(VarN)
; Names = Names0,
Value = Value0
),
get(B, text_buffer, TB),
get(TB, size, S0),
( Names = VarName:ArgN
-> format(Fd, '~w', [VarName])
; Names = [VarName:ArgN|_],
write_varnames(Fd, Names)
),
current_prolog_flag(answer_write_options, Options),
format(Fd, '\t= ~W~n', [Value, Options]),
flush_output(Fd),
get(TB, size, S1),
new(_, prolog_frame_var_fragment(TB, S0, S1, VarName, ArgN))
).
write_varnames(Fd, [N:_]) :-
!,
format(Fd, '~w', N).
write_varnames(Fd, [N:_|T]) :-
format(Fd, '~w = ', N),
write_varnames(Fd, T).
append_extra(B, Constraint:prolog, Fd:prolog, Comment:name) :->
"Display current constraints"::
get(B, text_buffer, TB),
current_prolog_flag(answer_write_options, Options),
get(TB, size, S0),
format(Fd, '(~w)\t~W~n', [Comment, Constraint, Options]),
flush_output(Fd),
get(TB, size, S1),
new(_, prolog_frame_constraint_fragment(TB, S0, S1)).
:- pce_end_class(prolog_bindings_view).
:- pce_begin_class(prolog_frame_var_fragment, fragment,
"Represent a variable in a frame").
variable(var_name, name, get, "Name of displayed variable").
variable(argn, int, get, "Slot in frame").
initialise(F, TB:text_buffer, From:int, To:int, Name:name, ArgN:int) :->
Len is To-From,
send_super(F, initialise, TB, From, Len, frame),
send(F, slot, var_name, Name),
send(F, slot, argn, ArgN).
% Issue: this copies really big values
value(F, Value:prolog) :<-
"Get current value of the variable"::
get(F, text_buffer, TB),
get(TB?editors, head, Editor),
get(Editor, window, View),
get(View, prolog_frame, Frame), Frame \== @nil,
get(F, argn, ArgN),
prolog_frame_attribute(F, Frame, argument(ArgN), Value).
:- pce_end_class(prolog_frame_var_fragment).
:- pce_begin_class(prolog_frame_constraint_fragment, fragment,
"Represent a contraint on a frame").
initialise(F, TB:text_buffer, From:int, To:int) :->
Len is To-From,
send_super(F, initialise, TB, From, Len, constraint).
var_name(_F, _Name:name) :<-
"Cannot show details"::
fail.
:- pce_end_class(prolog_frame_constraint_fragment).
/*******************************
* EVENTS *
*******************************/
:- initialization
prolog_unlisten(frame_finished, frame_finished),
prolog_listen(frame_finished, frame_finished).
frame_finished(Frame) :-
thread_self_id(Thread),
gui(Thread, _, Gui), % has a gui
send_pce_async(send(Gui, frame_finished(Frame))).
destroy_thread_debug_gui(Thread) :-
( gui(Thread, _, Gui)
-> thread_property(Thread, status(Status)),
send_pce_async(send(Gui, thread_finished(Status)))
; true
).
user:message_hook('$aborted', _, _Lines) :-
aborted,
fail.
user:message_hook(query(YesNo), _, _Lines) :-
query_finished(YesNo),
fail.
user:message_hook(break(end, Level)) :-
thread_self_id(Thread),
gui(Thread, Level, Gui),
send_pce_async(send(Gui, destroy)),
fail.
aborted :-
thread_self_id(Thread),
gui(Thread, Level, Gui),
( Level \== 0
-> Message = destroy
; Message = aborted
),
send_pce_async(send(Gui, Message)).
query_finished(YesNo) :-
finished(YesNo, Message),
thread_self_id(Thread),
break_level(Level),
gui(Thread, Level, Gui),
send_pce_async(send(Gui, query_finished(Message))).
finished(no, 'Query failed').
finished(yes, 'Query succeeded').
finished(done, 'User ended query').
finished(yes(_), 'Query succeeded with result').
finished(more(_), 'Query succeeded non-deterministically with result').