Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 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
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
:- ensure_loaded(library(util/charsio)).
:- ensure_loaded(library(misc/markup)).
/**
* fancy_atom(A, B, P):
* The predicate succeeds in B with the colorized A
* useing the paragraph class P to color lines.
*/
% fancy_atom(+Atom, -Atom, +Atom)
fancy_atom(A, B, P) :-
open_input_atom_stream(A, I),
open_output_atom_stream(O),
dom_output_new(O, D),
sys_fancy_stream(I, D, P),
flush_output(D),
close_output_atom_stream(O, B).
% sys_fancy_stream(+Stream, +Stream, +Atom)
sys_fancy_stream(InStream, OutStream, P) :-
get_code(InStream, C),
sys_fancy_get(C, H, InStream, D),
sys_fancy_rest(H, D, InStream, OutStream, P).
% sys_fancy_rest(+Term, +Integer, +Stream, +Stream, +Atom)
sys_fancy_rest(end_of_file, _, _, _, _) :- !.
sys_fancy_rest(T, C, InStream, OutStream, P) :-
sys_fancy_put(T, OutStream, P),
sys_fancy_get(C, H, InStream, D),
sys_fancy_rest(H, D, InStream, OutStream, P).
/*************************************************************/
/* 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, +Atom)
/* comments */
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, P) :- !,
sys_fancy_codes(S, L, 'cm', P).
/* constants */
sys_fancy_put(single(L), S, P) :- !,
append(L, [0'\'], R),
sys_fancy_codes(S, [0'\'|R], 'cs', P).
sys_fancy_put(codes(L), S, P) :- !,
append(L, [0'\"], R),
sys_fancy_codes(S, [0'\"|R], 'cs', P).
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(code(L), S, P) :- !,
sys_fancy_codes(S, [0'0, 0'\'|L], 'cs', P).
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>').
/* variables */
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_atom(S, '_'), tag(S, '</span>').
sys_fancy_put(back(L), S, P) :- !,
append(L, [0'\`], R),
sys_fancy_codes(S, [0'\`|R], 'vr', P).
/* otherwise */
sys_fancy_put(filler(L), S, P) :- !,
sys_fancy_codes(S, L, '', P).
sys_fancy_put(atom(A), S, _) :- !,
put_atom(S, A).
sys_fancy_put(A, S, _) :-
put_atom(S, A).
/*************************************************************/
/* Style Helper */
/*************************************************************/
/**
* sys_fancy_codes(S, L, C, P):
* The predicate succeeds. As a side effect the list of lines L are
* emitted to output stream S using div-HTML tags to separate lines
* and using span-HTML tags with the given character class C
* and paragraph class P to color the lines.
*/
% sys_fancy_codes(+Stream, +List, +Atom, +Atom)
sys_fancy_codes(S, L, C, P) :-
sys_split_lines(H, L, []),
sys_fancy_list(S, H, C, P).
% sys_fancy_list(+Stream, +List, +Atom, +Atom)
sys_fancy_list(S, [X|R], C, P) :-
(C = '' -> true;
tag_format(S, '<span class="~a">', [C])),
put_atom(S, X),
(C = '' -> true;
tag(S, '</span>')),
sys_fancy_rest(R, S, C, P).
% sys_fancy_rest(+List, +Stream, +Atom, +Atom)
sys_fancy_rest([X|L], S, C, P) :-
(P = '' -> put_atom(S, '\n');
tag(S, '</div>'), tag_format(S, '<div class="~a">', [P])),
(C = '' -> true;
tag_format(S, '<span class="~a">', [C])),
put_atom(S, X),
(C = '' -> true;
tag(S, '</span>')),
sys_fancy_rest(L, S, C, P).
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([]) --> [].
/*************************************************************/
/* 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_category(C, T), 12 =< T, T =< 16.
/*************************************************************/
/* Notebook Support */
/*************************************************************/
/**
* colorize_elem(E):
* The predicate succeeds. As a side effect it colorizes the element E.
*/
% colorize_elem(+Element)
colorize_elem(E) :-
ir_object_current(E, 'innerText', A),
fancy_atom(A, B, ''),
ir_object_set(E, 'innerHTML', B).