1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * Author: Tobias Rho, Andreas Becker, Fabian Noth
    5 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    6 * Mail: pdt@lists.iai.uni-bonn.de
    7 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    8 * 
    9 * All rights reserved. This program is  made available under the terms
   10 * of the Eclipse Public License v1.0 which accompanies this distribution,
   11 * and is available at http://www.eclipse.org/legal/epl-v10.html
   12 * 
   13 ****************************************************************************/
   14
   15
   16:- module( pdt_reload,
   17         [ pdt_reload/1                           % Called from ConsultActionDelegate.run()
   18         , pdt_reload/2                           % Called from ConsultActionDelegate.run()
   19%         , activate_warning_and_error_tracing/0   % Called from PLMarkerUtils.addMarkers()
   20%         , deactivate_warning_and_error_tracing/0 % Called from PLMarkerUtils.addMarkers()
   21         , errors_and_warnings/5                  % Called from PLMarkerUtils.run()
   22         , reloaded_file/1
   23         , wait_for_reload_finished/0
   24         ]).   25
   26
   27               /*************************************
   28                * PDT RELAOAD                       *
   29                *************************************/
   30
   31:- use_module(split_file_path).   32:- use_module(library(lists)).   33:- use_module(library(memfile)).   34:- use_module(library(debug)).   35:- if(current_prolog_flag(dialect, swi)).   36% SWI-Prolog
   37:- use_module(library(make), []).   38:- endif.   39:- op(600, xfy, ::).   % Logtalk message sending operator
 pdt_reload(+File) is det
Wrapper for consult used to ignore PLEditor-triggered consults in the console history and to start the update of the PDT-internal factbase.
   46% SWI-Prolog list    
   47
   48:- multifile(reload_message/2).   49
   50pdt_reload(FileOrFiles, MessageTerm) :-
   51	(	nonvar(MessageTerm)
   52	->	(	atomic(MessageTerm)
   53		->	Message = MessageTerm
   54		;	(	reload_message(MessageTerm, Message)
   55			->	true
   56			;	Message = MessageTerm
   57			)
   58		),
   59		write(user_error, Message),
   60		nl(user_error)
   61	;	true
   62	),
   63	pdt_reload(FileOrFiles).
   64
   65pdt_reload(FileOrFiles) :-
   66	with_mutex('reloadMutex',(
   67		setup_call_cleanup(
   68			activate_warning_and_error_tracing,
   69			pdt_reload__(FileOrFiles),
   70			deactivate_warning_and_error_tracing
   71		)
   72	)),
   73	notify_reload_listeners(FileOrFiles).
   74
   75pdt_reload__(Files):-
   76    is_list(Files),
   77    !,
   78    forall(member(F,Files), pdt_reload__(F)).
   79	
   80% Logtalk
   81pdt_reload__(File):-
   82    split_file_path(File, _Directory,_FileName,_,lgt),
   83    !,
   84    logtalk_reload_adapter::pdt_reload(File),
   85    assertz(reloaded_file__(File)).
   86
   87:- if(current_prolog_flag(dialect, swi)).   88% SWI-Prolog
   89pdt_reload__(File):-
   90	debug(pdt_reload, 'pdt_reload(~w)', [File]),
   91	
   92	% we have to continiue, even if reload_file fails
   93	% normally failing means: the file has errors
   94	(make:reload_file(File) -> true ; true).
   95:- else.   96pdt_reload__(File):-
   97	debug(pdt_reload, 'pdt_reload(~w)', [File]),
   98	
   99	% we have to continiue, even if reload_file fails
  100	% normally failing means: the file has errors
  101	(user:consult(File) -> true ; true).
  102:- endif.  103
  104:- multifile(pdt_reload_listener/1).  105
  106notify_reload_listeners(Files) :-
  107	(	is_list(Files)
  108	->	pdt_reload_listener(Files)
  109	;	pdt_reload_listener([Files])
  110	),
  111	fail.
  112notify_reload_listeners(_).
  113
  114%pdt_reload_listener(Files) :-
  115%    atomic_list_concat(Files, '<>', FileList),
  116%    catch(process_observe:process_notify(file_loaded,FileList),_,true).
  117
  118               /*************************************
  119                * INTERCEPT PROLOG ERROR MESSAGES   *
  120                *************************************/
  121
  122% Store SWI-Prolog error and warning messages as
  123% traced_messages(Level, Line, Lines, File) facts.
  124
  125:- dynamic(traced_messages/5).  126:- dynamic(warning_and_error_tracing/0).  127:- dynamic(reloaded_file__/1).  128
  129activate_warning_and_error_tracing :- 
  130    trace_reload(begin),
  131    assertz(in_reload),
  132	retractall(traced_messages(_,_,_,_,_)),
  133	retractall(reloaded_file__(_)),
  134	assertz(warning_and_error_tracing).
  135
  136deactivate_warning_and_error_tracing :-
  137	retractall(in_reload),
  138	retractall(warning_and_error_tracing).
  139 
  140:- dynamic in_reload/0.
 message_hook(+Term, +Level, +Lines) is det
intercept prolog messages to collect term positions and error/warning messages in traced_messages/5
author
- trho
  150:- multifile(user:message_hook/3).  151:- dynamic(user:message_hook/3).  152
  153user:message_hook(Term, Level,Lines) :-
  154    with_mutex('reloadMutex', (
  155		warning_and_error_tracing,
  156		(	Term = error(_, file(File, Line, _, _))
  157		->	true
  158		;	prolog_load_context(term_position, TermPosition),
  159			(	TermPosition = '$stream_position'(_,Line,_,_,_)
  160			->	true
  161			;	TermPosition = '$stream_position'(_,Line,_,_)
  162			),
  163			prolog_load_context(source, File)
  164		),
  165		assertz(traced_messages(swi, Level, Line,Lines, File)),
  166		trace_reload(traced_messages(swi, Level, Line,Lines, File)),
  167	%	assertz(user:am(_Term, Level,Lines)),
  168		fail
  169	)).
  170
  171
  172user:message_hook(load_file(start(_, file(_, FullPath))), _, _) :-
  173	with_mutex('reloadMutex', (
  174		warning_and_error_tracing,
  175		assertz(reloaded_file__(FullPath)),
  176		fail
  177	)).
  178               /*************************************
  179                * USE INTERCEPTED PROLOG ERROR MESSAGES   *
  180                *************************************/
 errors_and_warnings(?Level, ?Line, ?Length, ?Message, ?File) is nondet
  184errors_and_warnings(Level,Line,0,Message, File) :-
  185		wait_for_reload_finished,
  186	    traced_messages(swi, Level, Line, Lines, File),
  187	    trace_reload(e_w(Lines)),
  188	%	traced_messages(error(syntax_error(_Message), file(_File, StartLine, Length, _)), Level,Lines),
  189	    new_memory_file(Handle),
  190	   	open_memory_file(Handle, write, Stream),
  191		print_message_lines(Stream,'',Lines),
  192	    close(Stream),
  193		memory_file_to_atom(Handle,Message),
  194	    free_memory_file(Handle).
  195
  196errors_and_warnings(Level,Line,0,Message, File) :-
  197	wait_for_reload_finished,
  198	traced_messages(logtalk, Level, Line, Tokens, File),
  199	with_output_to(atom(Message), (current_output(S), logtalk::print_message_tokens(S, '', Tokens))).
  200
  201reloaded_file(LoadedFile) :-
  202	wait_for_reload_finished,
  203	reloaded_file__(LoadedFile).
  204   
  205wait_for_reload_finished :-
  206   reset_timout_counter,
  207   repeat,
  208   ( with_mutex('reloadMutex', (
  209      trace_reload(check_in_reload),
  210       \+in_reload
  211     ))
  212    ; ( 
  213        %writeln(wait_for_reload_to_end),
  214        trace_reload(wait),
  215        sleep(0.1),
  216        ( timeout_reached(Timeout) ->
  217          throw(reload_timeout_reached(Timeout))
  218        ; fail 
  219        )
  220	  )
  221	),
  222    !.
  223
  224
  225:- dynamic timeout_counter/1.  226timeout_threshold(150).
  227
  228reset_timout_counter :-
  229   retractall(timeout_counter(_)),
  230   assert(timeout_counter(0)).
  231   
  232   
  233timeout_reached(New) :-
  234   timeout_counter(C),
  235   New is C+1,
  236   timeout_threshold(Th),
  237  ( Th == New ->
  238     true
  239    ; ( retractall(timeout_counter(_)),
  240        assert(timeout_counter(New)),
  241        fail
  242    )
  243   ).
  244
  245% If you want to trace reloading comment out the "fail"
  246% in the first line of "trace_reload" and then look at
  247% the reload_trace(What,Time) facts generated. 
  248% It makes no sense to add a special preference to enable
  249% reload tracing since this only interests PDT developers, 
  250% not end users: 
  251:- dynamic reload_trace/2.  252
  253trace_reload(Name):-
  254    fail,
  255    get_time(T),
  256    assert(reload_trace(Name,T)),
  257    !.
  258trace_reload(_Name)