15:- module(echo_files,
16 [get_file_from_stream/2,assume_caughtup_to/3]). 17
18:- define_into_module(
19 [
20 check_current_echo/0,
21 echo_source_file/0,
22 echo_source_file_no_catchup/1,
23 echo_source_file/1]).
34:- set_module(class(library)). 35
36:- meta_predicate(into_echo_cmt(:)). 37
38
39:- module_transparent(echo_source_file/0). 40:- module_transparent(check_current_echo/1). 41:- module_transparent(into_echo_cmt/1). 42
43:- thread_local(t_l:echoing_file/1). 44:- thread_local(t_l:echoing_file_in_cmt/1). 45:- thread_local(t_l:file_stream_loc/3).
49echo_source_file(F):-
50 (\+ t_l:echoing_file(F) -> asserta(t_l:echoing_file(F)) ; true),
51 check_current_echo(F).
52
53echo_source_file:- prolog_load_context(file,File), echo_source_file(File).
54
55echo_source_file_no_catchup(F):-
56 ignore((
57 \+ t_l:echoing_file(F),
58 asserta(t_l:echoing_file(F)),!,
59 stream_property(S,file_name(F)),
60 61 character_count(S,Pos),
62 echo_files:assume_caughtup_to(F,S,Pos))),!.
63
64check_current_echo:-
65 source_location(F,_), prolog_load_context(source,S), S\==F,!,
66 check_current_echo(S),check_current_echo(F).
67check_current_echo:-
68 ignore((prolog_load_context(source,S),check_current_echo(S))),
69 ignore((source_location(F,_),S\==F,check_current_echo(F))),
70 ignore((prolog_load_context(file,SL),SL\==S,SL\==F,check_current_echo(SL))),!.
71
72check_current_echo(F):- t_l:echoing_file(F),get_file_from_stream(S,F), character_count(S,Pos),catch_up_to_stream(S,Pos),!.
73check_current_echo(F):- t_l:echoing_file_in_cmt(F),!,get_file_from_stream(S,F), character_count(S,Pos),into_echo_cmt((catch_up_to_stream(S,Pos))).
74check_current_echo(F):- asserta(t_l:echoing_file_in_cmt(F)),!,check_current_echo(F).
75
76
77into_echo_cmt(Goal):- setup_call_cleanup(format('~N/*~~~n',[]),Goal,format('~N~~*/~n',[])).
78
79
80:- thread_local(t_l:feedback_started/2). 81
82:- create_prolog_flag(capture_feedback,false,[keep(true)]). 83
84c_es(X):- stream_property(X,alias(current_error)),!.
85c_es(X):- stream_property(X,alias(user_error)),!.
86c_es(X):- stream_property(X,alias(main_error)),!.
87c_es(X):- stream_property(X,file_no(2)),!.
88
89feedback_open(F):- t_l:feedback_started(F,_),!, format('~N/*~~~n'),
90 ignore(( \+ current_prolog_flag(capture_feedback,false), fail, feedback_close(F),!,feedback_open(F))).
91feedback_open(F):- current_prolog_flag(capture_feedback,true),
92 current_input(I),current_output(O),c_es(E),
93 new_memory_file(MF),open_memory_file(MF,write,S,[free_on_close(false)]),
94 asserta(t_l:feedback_started(F,mf_s(MF,S,I,O,E))),!,tell(S),set_prolog_IO(I,S,S),
95 96 set_stream(S,tty(true)).
97feedback_open(F):- format('~N/*~~~n'),assert(t_l:feedback_started(F,current_output)).
98
99feedback_close(F):- retract(t_l:feedback_started(F,current_output)),!,format('~N~~*/~n').
100feedback_close(F):- retract(t_l:feedback_started(F,mf_s(MF,S,I,O,E))),!,set_prolog_IO(I,O,E),
101 close(S),memory_file_to_string(MF,String),free_memory_file(MF),
102 atom_length(String,L), (L>0 -> into_echo_cmt(write(String));true).
103feedback_close(_):- told.
104
105mco_info(F,S,_I,Start,End):-
106 get_file_range(F,Start,End,STerm),
107 read_mco(STerm,Term,Cmnts,QQ,Vs,Sv),
108 character_count(S,Pos), get_file_range(F,End,Pos,After), peek_string(S,6,Peek),
109 fmsg('~N%~~ ~q ~~%~n',[[string(STerm),term(Term),comments(Cmnts),quasi_quotations(QQ),
110 variable_names(Vs),singletons(Sv),after(After),peek(Peek)]]).
111fmsg(Fmt,Args):- flush_output,ttyflush,format(user_output,Fmt,Args),ttyflush.
112
113never_echo_term(_:P):-!,compound(P),never_echo_term(P).
114never_echo_term(end_tests(_)).
115never_echo_term(begin_tests(_)).
116
117:- module_transparent(echo_catchup/4). 118
119echo_catchup(I,P,O,PO):- \+ echo_catchup_f(I,P,O,PO), fail.
120echo_catchup_f(I,P,O,PO):-
121 notrace((compound(P),
122 source_location(F,_L),t_l:echoing_file(F),
123 b_getval('$term', Term),I==Term)),
124 nonvar(I), \+ never_echo_term(I),
125 prolog_load_context(stream,S),stream_property(S,file_name(F)),
126 P=..[_,Start,End|_],!,
127 ttyflush,
128 mco(F,S,I,Start,End,O),!,
129 PO=P.
130
131:- style_check(-singleton). 132mco(F,S,I,Start,End,O):- I == end_of_file, !, feedback_close(F),fail.
133mco(F,S,I,Start,End,O):- t_l:file_stream_loc(F,S,Pos), PosBefore1 is Pos+1, End =< PosBefore1,!, mco_i2(F,S,I,O).
134mco(F,S,I,Start,End,O):- feedback_close(F),fail.
135mco(F,S,I,Start,End,O):- catch_up_to_stream(S,Start), fail.
136mco(F,S,I,Start,End,O):- mco_p(F,S,I,Start,End) -> fail; (print_tree(I), fail).
137mco(F,S,I,Start,End,O):- assume_caughtup_to(F,S,End),fail.
138mco(F,S,I,Start,End,O):- character_count(S,Pos), catch_up_to_stream(S,Pos), fail.
139mco(F,S,I,Start,End,O):- consume_white_space(F,S),fail.
140mco(F,S,I,Start,End,O):- character_count(S,Pos), assume_caughtup_to(F,S,Pos), fail. 142mco(F,S,I,Start,End,O):- mco_i(F,S,I,O),!,feedback_open(F),!.
143mco(F,S,I,Start,End,O):- feedback_open(F),fail.
144
145consume_white_space(_,S):- at_end_of_stream(S),!,fail.
146consume_white_space(F,S):- character_count(S,Start),get_file_from(F,Start,SubStr),
147 open_string(SubStr,S2),consume_white_space_proxy(S2),character_count(S2,Consumed),
148 NewPos is Start + Consumed,
149 assume_caughtup_to(F,S,NewPos),!.
150
151consume_white_space_proxy(S):- consume_white(S),!,consume_white_space_proxy(S).
152
153consume_white(S):- at_end_of_stream(S),!,fail.
154consume_white(S):- peek_char(S,C),char_type(C,space),get_char(S,C),put_char(C).
155consume_white(S):- nsl(NSL),atom_length(NSL,L),peek_string(S,L,Str),Str==NSL,!,read_line_to_string(S,_).
156consume_white(S):- peek_string(S,2,"%~"),!,read_line_to_string(S,_).
157consume_white(S):- peek_string(S,1,"%"),!,read_line_to_string(S,Str),write(Str),nl.
158consume_white(S):- peek_string(S,2,"#!"),!,read_line_to_string(S,Str),write(Str),nl.
159
160
161mco_p(F,_S,_I,Start,End):- 162 get_file_range(F,Start,End,STerm),
163 read_mco(STerm,Term,Cmnts,QQ,_Vs,_Sv),
164 165 166 write(STerm),!,
167 assume_caughtup_to(F,S,End).
168
169mco_p(F,S,I,Start,End):- print_tree(I),!,assume_caughtup_to(F,S,End).
170
172mco_i2(F,S,I,O):- fail.
173mco_i(F,S,I,O):- fail.
174mco_i(F,S,_-->_,O):- fail.
175
176:- style_check(+singleton). 177
178read_mco(STerm,Term,Cmnts,QQ,Vs,Sv):-
179 read_term_from_atom(STerm,CTerm,[cycles(true),comments(Cmnts),quasi_quotations(QQ),variable_names(Vs),singletons(Sv)]),
180 read_term_from_atom(STerm,UTerm,[cycles(false),comments(UCmnts),quasi_quotations(UQQ),variable_names(UVs),singletons(USv)]),!,
181 (CTerm =@= UTerm -> Term = CTerm ; (Term = UTerm, UCmnts = Cmnts, QQ=UQQ, Vs=UVs, USv=Sv)),!.
182
183get_file_from_stream(S,F):- stream_property(S,file_name(F)).
184
185catch_up_to_stream(S,Pos):- \+ t_l:file_stream_loc(_,S,_),get_file_from_stream(S,F), print_file_range(F,S,0,Pos),!.
186catch_up_to_stream(S,Pos):- t_l:file_stream_loc(F,S,PosBefore), Pos>PosBefore, print_file_range(F,S,PosBefore,Pos).
187catch_up_to_stream(S):- character_count(S,Pos),catch_up_to_stream(S,Pos).
188
189get_file_range(F,Start,End,SubStr):-
190 Len is End-Start,
191 read_file_to_string(F,Str,[]),
192 sub_string(Str,Start,Len,_,SubStr).
193get_file_from(F,Start,SubStr):-
194 read_file_to_string(F,Str,[]),
195 sub_string(Str,Start,_,0,SubStr).
196
197
198print_file_range(F,S,Start,End):-
199 get_file_range(F,Start,End,SubStr),
200 assume_caughtup_to(F,S,End),
201 write_ommit_feedback(on,SubStr),!.
202
203nsl('No source location!?').
204
205write_ommit_feedback(S,String):- nsl(NSL), atom_contains(String,NSL),replace_in_string([NSL='/*~NSL~*/'],String,Rest),!,
206 write_ommit_feedback(S,Rest).
207write_ommit_feedback(on,String):- (sub_string(String,Before,_,After,'\n/*~');sub_string(String,Before,_,After,'/*~')),!,
208 sub_atom(String,0,Before,_A,On),write_ommit_feedback(on,On),
209 sub_atom(String,After,_,0,Rest),write_ommit_feedback(off,Rest).
210write_ommit_feedback(on,String):- (sub_string(String,Before,_,After,'\n%~');sub_string(String,Before,_,After,'%~')),!,
211 sub_atom(String,0,Before,_A,On),write_ommit_feedback(on,On),
212 sub_atom(String,After,_,0,Rest),write_ommit_feedback(lineoff,Rest).
213write_ommit_feedback(on,String):- !, write(String).
214write_ommit_feedback(off,String):- (sub_string(String,_,_,After,'~*/\n');sub_string(String,_,_,After,'~*/')),!,
215 sub_atom(String,After,_,0,Rest),write_ommit_feedback(on,Rest).
216write_ommit_feedback(lineoff,String):- sub_string(String,_,_,After,'\n'), !,
217 sub_atom(String,After,_,0,Rest),write_ommit_feedback(on,Rest).
218write_ommit_feedback(_,_).
219
220
221assume_caughtup_current(F,S):- retractall(t_l:file_stream_loc(F,S,_)),character_count(S,Pos),assert(t_l:file_stream_loc(F,S,Pos)).
222
223assume_caughtup_to(F,S,Pos):- retractall(t_l:file_stream_loc(F,S,_)),assert(t_l:file_stream_loc(F,S,Pos)).
224
225se:echo_expander(system:term_expansion(I,P,O,PO), echo_catchup(I,P,O,PO)).
226
228system:term_expansion(_,_,_,_):-
229 notrace((
230 se:echo_expander(H,B),
231 nth_clause(H,1,Ref),
232 \+ (clause(H,_:B,Ref)))),
233 ignore(retract(H:- B)),
234 asserta(H:-B),
235 fail.
Utility LOGICMOO_PREDICATE_STREAMS
This module allows running prolog files as echos. @author Douglas R. Miles @license LGPL
Prolog source-code will echo while running
*/