Heimseite
Seitenübersicht
An/abmeldung
Anschlagbrett
Herunterladen(c) 2005-2024 XLOG Technologies AG
/**
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Dogelog is a deposited trademark of XLOG Technologies AG.
*/
:- ensure_loaded(library(util/format)).
:- ensure_loaded(library(misc/markup)).
/*************************************************************/
/* Fancy Utility */
/*************************************************************/
/**
* fancy_file(A, B):
* fancy_file(A, B, O):
* The predicate succeeds. As side effect it colorizes the Prolog
* text A into the file B. An already existing file B is silently
* overwritten.
*/
% fancy_file(+Atom, +Atom)
fancy_file(InName, OutName) :-
fancy_file(InName, OutName, []).
% fancy_file(+Atom, +Atom, +List)
fancy_file(InName, OutName, Opts) :-
sys_fancy_opts(Opts, Res),
setup_once_cleanup(
(open(OutName, write, OutStream), dom_output_new(OutStream, DomWriter)),
sys_fancy_dest(InName, DomWriter, Res),
close(DomWriter)).
% sys_fancy_dest(+Atom, +Stream, +Term)
sys_fancy_dest(InName, OutStream, Res) :-
sys_html_header(OutStream, Res),
sys_fancy_begin(OutStream),
setup_once_cleanup(
open(InName, read, InStream),
sys_fancy_stream(InStream, OutStream),
close(InStream)),
sys_fancy_end(OutStream),
sys_html_footer(OutStream).
% sys_fancy_stream(+Stream, +Stream)
sys_fancy_stream(InStream, OutStream) :-
get_code(InStream, C),
sys_fancy_get(C, H, InStream, D),
sys_fancy_rest(H, D, InStream, OutStream).
% sys_fancy_rest(+Term, +Integer, +Stream, +Stream)
sys_fancy_rest(end_of_file, _, _, _) :- !.
sys_fancy_rest(T, C, InStream, OutStream) :-
sys_fancy_put(T, OutStream),
sys_fancy_get(C, H, InStream, D),
sys_fancy_rest(H, D, InStream, OutStream).
/*************************************************************/
/* Fancy Helper */
/*************************************************************/
% sys_fancy_get(+Integer, -Term, +Stream, -Integer)
sys_fancy_get(C, A, S, D) :-
sys_get_comment(C, A, S, D), !.
sys_fancy_get(C, A, S, D) :-
sys_get_token(A, S-C, _-D).
% sys_fancy_put(+Term, +Stream)
sys_fancy_put(line(L), S) :- !,
atom_codes(A, L),
tag(S, '<span class="cm">'), put_atom(S, A), tag(S, '</span>').
sys_fancy_put(block(L), S) :- !,
sys_fancy_codes(S, L, 'cm').
sys_fancy_put(filler(L), S) :- !,
sys_fancy_codes(S, L, '').
sys_fancy_put(atom(A), S) :- !,
put_atom(S, A).
sys_fancy_put(single(L), S) :- !,
append(L, [0'\'], R),
sys_fancy_codes(S, [0'\'|R], 'cs').
sys_fancy_put(back(L), S) :- !,
append(L, [0'\`], R),
sys_fancy_codes(S, [0'\`|R], 'cs').
sys_fancy_put(decimal(L), S) :- !,
atom_codes(A, L),
tag(S, '<span class="cs">'), put_atom(S, A), tag(S, '</span>').
sys_fancy_put(radix(L, B), S) :- !,
atom_codes(A, L),
tag(S, '<span class="cs">'),
(B = 2 -> put_atom(S, '0b');
B = 8 -> put_atom(S, '0o');
B = 16 -> put_atom(S, '0x');
fail),
put_atom(S, A),
tag(S, '</span>').
sys_fancy_put(codes(L), S) :- !,
append(L, [0'\"], R),
sys_fancy_codes(S, [0'\"|R], 'cs').
sys_fancy_put(reference(L), S) :- !,
atom_codes(A, L),
tag(S, '<span class="cs">'),
put_atom(S, '0r'), put_atom(S, A),
tag(S, '</span>').
sys_fancy_put(code(L), S) :- !,
atom_codes(A, L),
tag(S, '<span class="cs">'),
put_atom(S, '0\''), put_atom(S, A),
tag(S, '</span>').
sys_fancy_put(var(A), S) :- !,
tag(S, '<span class="vr">'), put_atom(S, A), tag(S, '</span>').
sys_fancy_put(anon, S) :- !,
tag(S, '<span class="vr">'), put_code(S, 0'_), tag(S, '</span>').
sys_fancy_put(A, S) :-
put_atom(S, A).
/*************************************************************/
/* Fancy Document */
/*************************************************************/
% sys_fancy_begin(+Stream)
sys_fancy_begin(S) :-
tag(S, '<pre class="code2">'),
tag(S, '<div class="ln">').
% sys_fancy_end(+Stream)
sys_fancy_end(S) :-
tag(S, '</div>'),
tag(S, '</pre>').
% sys_fancy_atom(+Stram, +Atom, +Atom)
sys_fancy_atom(S, A, C) :-
atom_split(A, '\n', H),
sys_fancy_list(S, H, C).
% sys_fancy_codes(+Stream, +List, +Atom)
sys_fancy_codes(S, L, C) :-
sys_split_lines(H, L, []),
sys_fancy_list(S, H, C).
% sys_fancy_list(+Stream, +List, +Atom)
sys_fancy_list(S, [X|R], C) :-
(C = '' -> true; tag_format(S, '<span class="~a">', [C])),
put_atom(S, X),
(C = '' -> true; tag(S, '</span>')),
sys_fancy_rest(R, S, C).
% sys_fancy_rest(+List, +Stream, +Atom)
sys_fancy_rest([X|L], S, C) :-
tag(S, '</div>'),
tag(S, '<div class="ln">'),
(C = '' -> true; tag_format(S, '<span class="~a">', [C])),
put_atom(S, X),
(C = '' -> true; tag(S, '</span>')),
sys_fancy_rest(L, S, C).
sys_fancy_rest([], _, _).
/*************************************************************/
/* Line Splitter */
/*************************************************************/
/**
* sys_split_lines(L, I, O):
* The predicate succeeds in L with the lines
* of the input I and output O codes.
*/
% sys_split_lines(-List, +List, -List)
sys_split_lines([A|L]) -->
sys_split_line(X), {atom_codes(A,X)},
sys_split_more(L).
% sys_split_more(-List, +List, -List)
sys_split_more([A|L]) --> sys_convert_sep, !,
sys_split_line(X), {atom_codes(A,X)},
sys_split_more(L).
sys_split_more([]) --> [].
% sys_split_line(-List, +List, -List)
sys_split_line([X|L]) --> \+ sys_convert_sep, [X], !,
sys_split_line(L).
sys_split_line([]) --> [].
/*************************************************************/
/* Beautify Utility */
/*************************************************************/
/**
* beautify_file(A, B):
* beautify_file(A, B, O):
* The predicate succeeds. As side effect it beautifies the Prolog
* text A into the file B. An already existing file B is silently
* overwritten. The ternary predicate accepts beautify options O.
*/
% beautify_file(+Atom, +Atom)
beautify_file(InName, OutName) :-
beautify_file(InName, OutName, []).
% beautify_file(+Atom, +Atom, +List)
beautify_file(InName, OutName, Opt) :-
sys_beautify_opts(Opt, 0, Flags),
setup_once_cleanup(
open(OutName, write, OutStream),
sys_beautify_dest(InName, OutStream, Flags),
close(OutStream)).
% sys_beautify_dest(+Atom, +Stream, +Integer)
sys_beautify_dest(InName, OutStream, Flags) :-
setup_once_cleanup(
open(InName, read, InStream),
sys_beautify_stream(InStream, OutStream, Flags),
close(InStream)).
% sys_beautify_stream(+Stream, +Stream, +Integer)
sys_beautify_stream(InStream, OutStream, Flags) :-
repeat,
get_code(InStream, C),
sys_beautify_comment(C, InStream, D, OutStream),
sys_read_term(D, InStream, [variable_names(Names), annotation(true)], Term),
sys_beautify_anchor(Term, OutStream, Flags),
(Term == end_of_file -> !;
term_singletons(Term, List),
sys_beautify_names(List, Annon),
append(Names, Annon, Names2),
sys_write_term(OutStream, Term, [quoted(true), annotation(true),
variable_names(Names2), format(true)]),
sys_safe_code(OutStream, 0'.),
nl(OutStream),
fail).
% sys_beautify_names(+List, -Map)
sys_beautify_names([], []).
sys_beautify_names([V|L], ['_'=V|N]) :-
sys_beautify_names(L, N).
/*************************************************************/
/* Beautify Helpers */
/*************************************************************/
% sys_beautify_anchor(+Term, +Stream, +Integer)
sys_beautify_anchor(_, _, Flags) :- Flags /\ 1 =:= 0, !.
sys_beautify_anchor((runner_case(_,_,_,_,Case) :- _), OutStream, _) :- !,
format(OutStream, '%<a name="~a"></a>', [Case]),
nl(OutStream).
sys_beautify_anchor(_, _, _).
% sys_beautify_comment(+Integer, +Stream, -Integer, +Stream)
sys_beautify_comment(C, InStream, D, OutStream) :-
sys_get_comment(C, A, InStream, H), !,
sys_beautify_put(A, OutStream),
sys_beautify_comment(H, InStream, D, OutStream).
sys_beautify_comment(C, _, C, _).
% sys_beautify_put(+Term, +Stream)
sys_beautify_put(line(L), OutStream) :-
atom_codes(A, L),
put_atom(OutStream, A).
sys_beautify_put(block(L), OutStream) :-
atom_codes(A, L),
put_atom(OutStream, A).
sys_beautify_put(filler(L), OutStream) :-
atom_codes(A, L),
put_atom(OutStream, A).
/*************************************************************/
/* Comment Tokens */
/*************************************************************/
/**
* sys_get_comment(C, A, S, D):
* The predicate succeeds in A with the comment token and
* in D with the next character. The parameter C is the current
* character and the parameter S is the input stream.
*/
% sys_get_comment(+Integer, -Term, +Stream, -Integer)
sys_get_comment(0'%, line([0'%|L]), S, D) :- !,
get_code(S, C),
sys_get_line(C, L, S, D).
sys_get_comment(0'/, block([0'/, 0'*|L]), S, D) :- peek_code(S, 0'*), !,
get_code(S, _),
get_code(S, C),
sys_get_block(C, L, S, D).
sys_get_comment(C, filler(L), S, D) :- sys_is_white(C), !,
sys_get_filler(C, L, S, D).
% sys_get_line(+Integer, -List, +Stream, -Integer)
sys_get_line(0'\n, [], _, 0'\n) :- !.
sys_get_line(0'\r, [], _, 0'\r) :- !.
sys_get_line(-1, [], _, -1) :- !.
sys_get_line(C, [C|L], S, D) :-
get_code(S, H),
sys_get_line(H, L, S, D).
% sys_get_block(+Integer, -List, +Stream, -Integer)
sys_get_block(-1, _, _, _) :-
throw(error(syntax_error(end_of_file_in_block_comment),_)).
sys_get_block(0'*, [0'*, 0'/], S, C) :- peek_code(S, 0'/), !,
get_code(S, _),
get_code(S, C).
sys_get_block(C, [C|L], S, D) :-
get_code(S, H),
sys_get_block(H, L, S, D).
% sys_get_filler(+Integer, -List, +Stream, -Integer)
sys_get_filler(C, [C|L], S, D) :- sys_is_white(C), !,
get_code(S, H),
sys_get_filler(H, L, S, D).
sys_get_filler(C, [], _, C).
% sys_is_white(+Code)
sys_is_white(C) :- code_type(C, T), 12 =< T, T =< 16.
/*******************************************************************/
/* Decode Fancy Options */
/*******************************************************************/
% sys_fancy_opts(+List, -Quadrupel)
sys_fancy_opts(Opts, Res) :-
statistics(wall, Time0),
sys_fancy_opts(Opts, v(Time0,'','',''), Res).
% sys_fancy_opts(+List, +Quadrupel, -Quadrupel)
sys_fancy_opts(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_fancy_opts([X|L], I, O) :- !,
sys_fancy_opt(X, I, H),
sys_fancy_opts(L, H, O).
sys_fancy_opts([], H, H) :- !.
sys_fancy_opts(L, _, _) :-
throw(error(type_error(list,L),_)).
% sys_fancy_opt(+Option, +Quadrupel, -Quadrupel)
sys_fancy_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_fancy_opt(date(I), v(_,Y,Z,T), v(I,Y,Z,T)) :- !,
sys_check_integer(I).
sys_fancy_opt(title(A), v(X,_,Z,T), v(X,A,Z,T)) :- !,
sys_check_atom(A).
sys_fancy_opt(header(A), v(X,Y,_,T), v(X,Y,A,T)) :- !,
sys_check_atom(A).
sys_fancy_opt(orig(A), v(X,Y,Z,_), v(X,Y,Z,A)) :- !,
sys_check_atom(A).
sys_fancy_opt(O, _, _) :-
throw(error(type_error(fancy_option,O),_)).
/****************************************************************/
/* Decode Beautify Options */
/****************************************************************/
% sys_beautify_opts(+List, +Integer, -Integer)
sys_beautify_opts(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_beautify_opts([X|L], I, O) :- !,
sys_beautify_opt(X, I, H),
sys_beautify_opts(L, H, O).
sys_beautify_opts([], H, H) :- !.
sys_beautify_opts(L, _, _) :-
throw(error(type_error(list,L),_)).
% sys_write_opt(+Option, +Integer, -Integer)
sys_beautify_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_beautify_opt(suite(B), F, G) :- !,
sys_opt_boolean(B, 1, F, G).
sys_beautify_opt(O, _, _) :-
throw(error(type_error(beautify_option,O),_)).