Home Page
Site Map
Login/out
Message Board
Download(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
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
:- ensure_loaded(library(util/charsio)).
/*********************************************************/
/* Format Output */
/*********************************************************/
/**
* tab(N):
* tab(S, N):
* The predicate succeeds. As a side effect N spaces are
* written to the current output. The binary predicate allows
* specifying the output stream.
*/
% tab(+Integer)
tab(N) :-
current_output(S),
tab(S, N).
% tab(+Stream, +Integer)
tab(S, N) :-
sys_check_integer(N),
(N > 0 -> sys_tab(N, S); true).
% sys_tab(+Integer, +Stream)
sys_tab(0, _) :- !.
sys_tab(N, S) :-
put_code(S, 0' ),
M is N-1,
sys_tab(M, S).
/**
* format(T, L):
* format(S, T, L):
* The built-in succeeds in writing the list L formatted
* according to the template T to the standard output. The
* ternary predicate allows specifying an output stream.
*/
% format(+Atom, +List)
format(T, L) :-
current_output(S),
format(S, T, L).
% format(+Stream, +Atom, +List)
format(S, T, L) :-
atom_codes(T, C),
sys_format(L, S, C, []).
/***************************************************************/
/* Format Atom */
/***************************************************************/
/**
* format_atom(T, L, A):
* The build-in succeeds in writing the list L formatted
* according to the template T into a new atom A.
*/
% format_atom(+Atom, +List, -Atom)
format_atom(T, L, A) :-
open_output_atom_stream(K),
format(K, T, L),
flush_output(K),
close_output_atom_stream(K, A).
/*********************************************************/
/* Format Arguments */
/*********************************************************/
% sys_format(+List, +Stream, +List, -List)
sys_format(L, S) -->
sys_format_fill(F),
{atom_codes(A, F), put_atom(S, A)},
sys_format_more(L, S).
% sys_format_more(+List, +Stream, +List, -List)
sys_format_more(V, _) --> {var(V),
throw(error(instantiation_error,_))}.
sys_format_more([X|L], S) --> !,
sys_format_rest,
sys_format_char(C),
sys_format_unpara(C, X, S),
sys_format(L, S).
sys_format_more([], _) --> !,
sys_format_eof.
sys_format_more(L, _) -->
{throw(error(type_error(list,L),_))}.
% sys_format_eof(+List, -List)
sys_format_eof --> [_],
{throw(error(syntax_error(superflous_format),_))}.
sys_format_eof --> [].
% sys_format_rest(+List, -List)
sys_format_rest --> [_], !.
sys_format_rest -->
{throw(error(syntax_error(format_missing),_))}.
/*********************************************************/
/* Format Specifier */
/*********************************************************/
/**
* sys_format_unpara(C, X, S, I, O):
* Format an item by format specifier without a parameter.
*/
% sys_format_unpara(+Integer, +Term, +Stream, +List, -List)
sys_format_unpara(C, X, S) --> {0'0 =< C, C =< 0'9}, !,
{N is C-0'0},
sys_format_char(D),
sys_format_para(D, N, X, S).
sys_format_unpara(0'a, X, S) --> !,
{xml_escape(X, A), put_atom(S, A)}.
sys_format_unpara(0'c, X, S) --> !,
{percent_encode(X, A), put_atom(S, A)}.
sys_format_unpara(0'd, X, S) --> !,
{H is X, atom_integer(A, 10, H), put_atom(S, A)}.
sys_format_unpara(0'e, X, S) --> !,
{H is X, sys_float_atom(H, 'e', 6, A), put_atom(S, A)}.
sys_format_unpara(0'f, X, S) --> !,
{H is X, sys_float_atom(H, 'f', 6, A), put_atom(S, A)}.
sys_format_unpara(0'g, X, S) --> !,
{H is X, sys_float_atom(H, 'g', 6, A), put_atom(S, A)}.
sys_format_unpara(0'k, X, S) --> !,
{write_canonical(S, X)}.
sys_format_unpara(0'q, X, S) --> !,
{writeq(S, X)}.
sys_format_unpara(0'r, X, S) --> !,
{H is X, atom_integer(A, 8, H), put_atom(S, A)}.
sys_format_unpara(0'w, X, S) --> !,
{write(S, X)}.
sys_format_unpara(C, _, _) -->
{char_code(S, C), throw(error(domain_error(illegal_format,S),_))}.
/**
* sys_format_para(C, N, X, S, I, O):
* Format an item by format specifier with a parameter.
*/
% sys_format_para(+Integer, +Integer, +Term, +Stream, +List, -List)
sys_format_para(C, N, X, S) --> {0'0 =< C, C =< 0'9}, !,
{M is N*10+C-0'0},
sys_format_char(D),
sys_format_para(D, M, X, S).
sys_format_para(0'e, N, X, S) --> !,
{H is X, sys_float_atom(H, 'e', N, A), put_atom(S, A)}.
sys_format_para(0'f, N, X, S) --> !,
{H is X, sys_float_atom(H, 'f', N, A), put_atom(S, A)}.
sys_format_para(0'g, N, X, S) --> !,
{H is X, sys_float_atom(H, 'g', N, A), put_atom(S, A)}.
sys_format_para(0'r, N, X, S) --> !,
{H is X, atom_integer(A, N, H), put_atom(S, A)}.
sys_format_para(C, _, _, _) -->
{char_code(S, C), throw(error(domain_error(illegal_format,S),_))}.
% sys_format_char(-Integer, +List, -List)
sys_format_char(C) --> [C], !.
sys_format_char(_) -->
{throw(error(syntax_error(char_missing),_))}.
/**
* sys_format_fill(L, I, O):
* Parse the filler between item related format specifiers.
*/
% sys_format_fill(-List, +List, -List)
sys_format_fill([X|F]) --> [X], {X =\= 0'~}, !,
sys_format_fill(F).
sys_format_fill([0'~|F]) --> [0'~, 0'~], !,
sys_format_fill(F).
sys_format_fill([0'\n|F]) --> [0'~, 0'n], !,
sys_format_fill(F).
sys_format_fill([]) --> [].
/*******************************************************************/
/* Foreign Predicates */
/*******************************************************************/
% sys_float_atom(F, S, N, A):
% defined in foreign(strlib)
:- ensure_loaded(foreign(util/strlib)).
/****************************************************************/
/* Error Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile strings/3.
strings('syntax_error.superflous_format', de, 'Nicht genug Argumente.').
strings('syntax_error.format_missing', de, 'Zu viele Argumente.').
strings('syntax_error.char_missing', de, 'Ungültiger Formatbezeichner.').
strings('syntax_error.superflous_format', '', 'Not enough arguments.').
strings('syntax_error.format_missing', '', 'Too many arguments.').
strings('syntax_error.char_missing', '', 'Illegal format specifier.').