1/* Logicmoo Debug Tools 2% =================================================================== 3% File 'instant_prolog_docs.pl' 4% Purpose: An Implementation in SWI-Prolog of certain debugging tools 5% Maintainer: Douglas Miles 6% Contact: $Author: dmiles $@users.sourceforge.net ; 7% Version: 'logicmoo_util_varnames.pl' 1.0.0 8% Revision: $Revision: 1.1 $ 9% Revised At: $Date: 2002/07/11 21:57:28 $ 10% =================================================================== 11*/ 12% File: '/opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/util/instant_prolog_docs.pl' 13:- module(prolog_refactor, [ ]). 14 15:- set_module(class(library)). 16 17 18 19:- multifile(user:portray/1). 20:- dynamic(user:portray/1). 21:- discontiguous(user:portray/1). 22% user:portray 23 24 25:- use_module(library(apply)). 26:- use_module(library(option)). 27:- use_module(library(debug)). 28:- use_module(library(lists)). 29:- use_module(library(prolog_colour)). 30:- use_module(library(pldoc/doc_colour)). 31:- use_module(library(pldoc/doc_html)). 32%:- use_module(library(pldoc/doc_wiki)). 33:- use_module(library(pldoc/doc_modes)). 34%:- use_module(library(pldoc/doc_process)). 35:- use_module(library(http/html_write)). 36:- use_module(library(http/http_path)). 37%:- use_module(library(prolog_xref)). 38 39:- meta_predicate 40 source_to_html(, , ). 41 42 43 44 45/* source pretty-printer 46 47This module colourises Prolog source using HTML+CSS using the same 48cross-reference based technology as used by PceEmacs. 49 50@tbd Create hyper-links to documentation and definitions. 51@author Jan Wielemaker 52*/ 53 54:- predicate_options(source_to_html/3, 3, 55 [ format_comments(boolean), 56 header(boolean), 57 skin(callable), 58 stylesheets(list), 59 title(atom) 60 ]). 61 62 63:- thread_local 64 lineno/0, % print line-no on next output 65 nonl/0, % previous tag implies nl (block level) 66 id/1. % Emitted ids
true (default), use PlDoc formatting for structured
comments.Other options are passed to the following predicates:
94source_to_html(Src, stream(Out), Options) :- 95 !, 96 retractall(lineno), % play safe 97 retractall(nonl), % play safe 98 retractall(id(_)), 99 colour_fragments(Src, Fragments0), 100 refactor_frags(Fragments0,Fragments), 101 setup_call_cleanup( 102 ( open_source(Src, In), 103 asserta(user:thread_message_hook(_,_,_), Ref) 104 ), 105 ( 106 doc_fragments(Fragments, In, Out, [], State, Options), 107 copy_rest(In, Out, State, State1), 108 pop_state(State1, Out, In) 109 ), 110 ( erase(Ref), 111 finish_in(Out,In) 112 )),!. 113 114source_to_html(Src, FileSpec, Options) :- 115 absolute_file_name(FileSpec, OutFile, [access(write)]), 116 setup_call_cleanup( 117 open(OutFile, write, Out, [encoding(utf8)]), 118 source_to_html(Src, stream(Out), Options), 119 close(Out)). 120 121finish_in(_Out,In):- at_end_of_stream(In),close(In). 122finish_in( Out,In):- get0(In,C),put_code(Out,C),finish_in( Out,In). 123 124open_source(Id, Stream) :- prolog:xref_open_source(Id, Stream), !. 125open_source(File, Stream) :- open(File, read, Stream).
133doc_fragments([], _, _, State, State, _):-!. 134doc_fragments([H|T], In, Out, State0, State, Options) :- 135 start_doc_fragment(H, In, Out, State0, State1, Options), 136 doc_fragments(T, In, Out, State1, State, Options),!.
146start_doc_fragment(fragment(Start, End, Class, Sub), In, Out, StateP, State, Options):- 147 copy_to(In, Start, Out, StateP, State0), flush_output(Out), 148 doc_fragment(fragment(Start, End, Class, Sub), In, Out, State0, State, Options). 149 150doc_fragment(fragment(Start, End, Class, Sub), In, Out, State0, State, Options):- 151 peek_code(In, C), (member(C,[46,32,12,13])), 152 get0(In,_), put_code(Out, C), flush_output(Out), !, 153 Start2 is Start + 1, 154 doc_fragment(fragment(Start2, End, Class, Sub), In, Out, State0, State, Options). 155 156doc_fragment(fragment(Start, End, Class, Sub), In, Out, State0, State, Options) :- 157 member(Class,[clause,directive,neck(directive)]), 158 clause_fragment(fragment(Start, End, clause, Sub), In, Out, State0, State, Options). 159 160doc_fragment(fragment(_, End, _, _Args), In, Out, State0, State, _Options) :- copy_to(In, End, Out, State0, State),!. 161 162sub_clause_fragments([], _, _, State, State, _). 163sub_clause_fragments([H|T], In, Out, State0, State, Options) :- 164 sub_clause_fragment(H, In, Out, State0, State1, Options), 165 sub_clause_fragments(T, In, Out, State1, State, Options). 166 167clause_fragment(fragment(Start, End, Class,Sub), In, Out, State2, State, Options) :- 168 nl,nl,print_tree(fragment(Start, End, Class, Sub)),nl, 169 %start_fragment(Class, In, Out, State0, State2), 170 sub_clause_fragments(Sub, In, Out, State2, State3, Options), 171 % copy_to(In, End, Out, State3, State4), % TBD: pop-to? 172 end_fragment(Out, In, State3, State),!. 173 174sub_clause_fragment(fragment(Start, End, Class, Sub), In, Out, StateP, State, Options) :- 175 copy_to(In, Start, Out, StateP, State1), flush_output(Out), 176 member(Class,[neck(_),head(_,_), goal(_,_),singleton,fullstop,control,comment(_)]), 177 start_fragment(Class, In, Out, State1, State2), 178 sub_clause_fragments(Sub, In, Out, State2, State3, Options), 179 copy_to(In, End, Out, State3, State4), % TBD: pop-to? 180 end_fragment(Out, In, State4, State),!. 181 182sub_clause_fragment(fragment(Start, End, Class, Sub), In, Out, State, State, Options) :- 183 member(Class,[functor,goal_term(_,_),head_term(_,_)]), 184 % functor(Class,F,_),atom_codes(F,[C|_]), format(Out,'/*~s*/ ',[[C]]), 185 grab_term(In,Start,End, Term, _Source), 186 transformed_term(Term,NewTerm), 187 write_trans_term(Out,NewTerm),!. 188 189sub_clause_fragment(fragment(Start, End, Class, Sub), In, Out, State1, State, Options) :- 190 member(Class,[functor,goal_term(_,_),head_term(_,_)]), 191 % functor(Class,F,_),atom_codes(F,[C|_]), format(Out,'/*~s*/ ',[[C]]), 192 start_fragment(Class, In, Out, State1, State2), 193 sub_clause_fragments(Sub, In, Out, State2, State3, Options), 194 copy_to(In, End, Out, State3, State4), % TBD: pop-to? 195 end_fragment(Out, In, State4, State),!. 196 197sub_clause_fragment(fragment(_Start, End, Class, Sub), In, Out, State1, State, Options) :- 198 start_fragment(Class, In, Out, State1, State2), 199 sub_clause_fragments(Sub, In, Out, State2, State3, Options), 200 copy_to(In, End, Out, State3, State4), % TBD: pop-to? 201 end_fragment(Out, In, State4, State),!. 202 203grab_term(In,Start,End, Term, _Source):- 204 seek(In, Start, +Method, -NewLocation). 205start_fragment(atom, In, Out, State0, State) :- 206 !, 207 ( peek_code(In, C), 208 C == 39 209 -> start_fragment(quoted_atom, In, Out, State0, State) 210 ; State = [nop|State0] 211 ). 212start_fragment(Class, _, Out, State, [Push|State]) :- 213 element(Class, Tag, CSSClass), 214 !, 215 Push =.. [Tag,class(CSSClass)], 216 ( anchor(Class, ID) 217 -> skip_format(Out, '<~w id="~w" class="~w">', [Tag, ID, CSSClass]) 218 ; skip_format(Out, '<~w class="~w">', [Tag, CSSClass]) 219 ). 220start_fragment(Class, _, Out, State, [span(class(SpanClass))|State]) :- 221 functor(Class, SpanClass, _), 222 skip_format(Out, '<span class="~w">', [SpanClass]). 223 224end_fragment(_, _, [nop|State], State) :- !. 225end_fragment(Out, In, [span(class(directive))|State], State) :- 226 !, 227 copy_full_stop(In, Out), 228 skip_format(Out, '</span>', []), 229 ( peek_code(In, 10), 230 \+ nonl 231 -> assert(nonl) 232 ; true 233 ). 234end_fragment(Out, _, [Open|State], State) :- 235 retractall(nonl), 236 functor(Open, Element, _), 237 skip_format(Out, '</~w>', [Element]). 238 239pop_state([], _, _) :- !. 240pop_state(State, Out, In) :- 241 end_fragment(Out, In, State, State1), 242 pop_state(State1, Out, In).
id we must assign to the fragment of
class Class. This that the first definition of a head with
the id name/arity.251anchor(head(_, Head), Id) :- 252 callable(Head), 253 functor(Head, Name, Arity), 254 skip_format(atom(Id), '~w/~w', [Name, Arity]), 255 ( id(Id) 256 -> fail 257 ; assertz(id(Id)) 258 ). 259 260mode_anchor(Out, Mode) :- 261 mode_anchor_name(Mode, Id), 262 ( id(Id) 263 -> true 264 ; skip_format(Out, '<span id="~w"><span>', [Id]), 265 assertz(id(Id)) 266 ). 267 268assert_seen_mode(Mode) :- 269 mode_anchor_name(Mode, Id), 270 ( id(Id) 271 -> true 272 ; assertz(id(Id)) 273 ).
<&>. If State
does not include a pre environment, create one and skip all
leading blank lines.282copy_to(In, End, Out, State, State) :- 283 member(pre(_), State), 284 !, 285 copy_to(In, End, Out). 286copy_to(In, End, Out, State, [pre(class(listing))|State]) :- 287 skip_format(Out, '<pre class="listing">~n', []), 288 line_count(In, Line0), 289 read_to(In, End, Codes0), 290 delete_leading_white_lines(Codes0, Codes, Line0, Line), 291 assert(lineno), 292 my_write_codes(Codes, Line, Out). 293 294copy_codes(Codes, Line, Out, State, State) :- 295 member(pre(_), State), 296 !, 297 my_write_codes(Codes, Line, Out). 298copy_codes(Codes0, Line0, Out, State, State) :- 299 skip_format(Out, '<pre class="listing">~n', []), 300 delete_leading_white_lines(Codes0, Codes, Line0, Line), 301 assert(lineno), 302 my_write_codes(Codes, Line, Out).
309copy_full_stop(In, Out) :- 310 get_code(In, C0), 311 copy_full_stop(C0, In, Out). 312 313copy_full_stop(0'., _, Out) :- %' 314 !, 315 my_put_code(Out, 0'.). %' 316copy_full_stop(C, In, Out) :- 317 my_put_code(Out, C), 318 get_code(In, C2), 319 copy_full_stop(C2, In, Out).
328delete_leading_white_lines(Codes0, Codes, Line0, Line) :- 329 append(LineCodes, [10|Rest], Codes0), 330 all_spaces(LineCodes), 331 !, 332 Line1 is Line0 + 1, 333 delete_leading_white_lines(Rest, Codes, Line1, Line). 334delete_leading_white_lines(Codes, Codes, Line, Line).
341copy_without_trailing_white_lines(In, End, Out, State, State) :- 342 member(pre(_), State), 343 !, 344 line_count(In, Line), 345 read_to(In, End, Codes0), 346 delete_trailing_white_lines(Codes0, Codes), 347 my_write_codes(Codes, Line, Out). 348copy_without_trailing_white_lines(In, End, Out, State0, State) :- 349 copy_to(In, End, Out, State0, State). 350 351delete_trailing_white_lines(Codes0, []) :- 352 all_spaces(Codes0), 353 !. 354delete_trailing_white_lines(Codes0, Codes) :- 355 append(Codes, Tail, [10|Rest], Codes0), 356 !, 357 delete_trailing_white_lines(Rest, Tail). 358delete_trailing_white_lines(Codes, Codes).
364append(T, T, L, L). 365append([H|T0], Tail, L, [H|T]) :- 366 append(T0, Tail, L, T). 367 368all_spaces([]). 369all_spaces([H|T]) :- 370 code_type(H, space), 371 all_spaces(T). 372 373copy_to(In, End, Out) :- 374 line_count(In, Line), 375 read_to(In, End, Codes), 376 ( debugging(htmlsrc) 377 -> length(Codes, Count), 378 debug(htmlsrc, 'Copy ~D chars: ~s', [Count, Codes]) 379 ; true 380 ), 381 my_write_codes(Codes, Line, Out). 382 383read_to(In, End, Codes) :- 384 character_count(In, Here), 385 Len is End - Here, 386 read_n_codes(In, Len, Codes).
<&>404content_escape(_, Out, L, _) :- 405 ( lineno 406 -> retractall(lineno), 407 write_line_no(L, Out), 408 fail 409 ; fail 410 ). 411content_escape(0'\n, Out, L0, L) :- %' 412 !, 413 L is L0 + 1, 414 ( retract(nonl) 415 -> true 416 ; my_nl(Out) 417 ), 418 assert(lineno). 419content_escape(C, Out, L, L) :- 420 my_put_code(Out, C). 421 422write_line_no(LineNo, Out) :- 423 nop(skip_format(Out, '<span class="line-no">~|~t~d~5+</span>', [LineNo])).
429copy_rest(In, Out, State0, State) :-
430 copy_to(In, -1, Out, State0, State).437read_n_codes(_, N, Codes) :- 438 N =< 0, 439 !, 440 Codes = []. 441read_n_codes(In, N, Codes) :- 442 get_code(In, C0), 443 read_n_codes(N, C0, In, Codes). 444 445read_n_codes(_, -1, _, []) :- !. 446read_n_codes(1, C, _, [C]) :- !. 447read_n_codes(N, C, In, [C|T]) :- 448 get_code(In, C2), 449 N2 is N - 1, 450 read_n_codes(N2, C2, In, T). 451 452 453 454%:- set_prolog_flag(verbose_load, full). 455:- set_prolog_flag(verbose, normal). 456%:- set_prolog_flag(verbose_autoload, true). 457 458skip_format(A,B,C):- nop(format(A,B,C)). 459not_skip_format(A,B,C):- format(A,B,C). 460my_nl(Out):- nl(Out). 461my_put_code(Out,C):- put_code(Out,C). 462 463my_write_codes([], _, _). 464% my_write_codes([H|T],_L0, Out):- format(Out,'"~s"\n',[[H|T]]),!. 465my_write_codes([H|T], L0, Out) :- 466 content_escape(H, Out, L0, L1), 467 my_write_codes(T, L1, Out). 468 469my_print_html(Out,Tokens):- print_html(Out,Tokens). 470:- meta_predicate source_to_html(,,). 471 472%source_to_html:- source_to_html('/mnt/sdc1/logicmoo_workspace.1/packs_sys/logicmoo_agi/prolog/episodic_memory/adv_axiom.pl'). 473source_to_html:- source_to_html('/mnt/sdc1/logicmoo_workspace.1/packs_sys/logicmoo_agi/prolog/episodic_memory/knowledgeBaseCGI.pl'). 474 475source_to_html(Src):- 476 source_to_html(Src, stream(user_output), []). 477 478my_prolog_read_source_term(In,B,C,D):- prolog_read_source_term(In,B,C,D). 479 480refactor_frags(Term1,Term2):- map_tree_pred3(refactor_src,Term1,Term2),!. 481 482map_tree_pred3(_,Arg1,Arg2):- var(Arg1),!,Arg2=Arg1,!. 483map_tree_pred3(Pred,Arg1,Arg2):- call(Pred,Arg1,Arg2), Arg1\==Arg2,!. 484map_tree_pred3(_ ,Arg1,Arg2):- \+ compound(Arg1), !, Arg2=Arg1. 485map_tree_pred3(Pred,Arg1,Arg2):- 486 compound_name_arguments(Arg1,F1,ArgS1), 487 maplist(map_tree_pred3(Pred),ArgS1,ArgS2), 488 compound_name_arguments(Arg2,F1,ArgS2). 489 490refactor_src(nathan,bob). 491refactor_src(Term,E):- fail, is_list(Term),E=was_list,!