View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2011-2013, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(writef,
   37          [ writef/1,                   % +Format
   38            writef/2,                   % +Format, +Args
   39            swritef/2,                  % -String, +Format
   40            swritef/3                   % -String, +Format, +Args
   41          ]).   42:- set_prolog_flag(generate_debug_info, false).   43
   44/** <module> Old-style formatted write
   45
   46This library provides writef/1 and   friends. These predicates originate
   47from Edinburgh C-Prolog and and provided for compatibility purposes. New
   48code should use format/1, format/2  and   friends,  which  are currently
   49supported by more Prolog implementations.
   50
   51The   writef-family   of   predicates   conflicts    with   the   modern
   52_|character-esacapes|_ flag about  the   interpretation  of \-sequences.
   53This can be avoided by
   54
   55  1. Disable character escapes (not recommended unless one wants to
   56  run really outdated code unmodified).
   57  2. Double the \ for conflicting interpretations
   58  3. Use ISO compliant alternatives for conflicting interpretations
   59
   60@copyright      Copied from Edinburgh C-Prolog. Original version by Byrd,
   61                changed many times since.
   62*/
   63
   64%!  writef(+Format) is det.
   65%!  writef(+Format, +Arguments) is det.
   66%
   67%   Formatted write to the  =current_output=.   Format  is  a format
   68%   specifier. Some escape sequences require  arguments that must be
   69%   provided in the list Arguments. There   are  two types of escape
   70%   sequences: special characters  start  with   =|\|=  and  include
   71%   arguments start with =|%|=. The special character sequences are:
   72%
   73%       | =|\n|= | Output a newline character |
   74%       | =|\l|= | Output a line separator (same as =|\n|=) |
   75%       | =|\r|= | Output a carriage-return character (ASCII 13) |
   76%       | =|\r|= | Output a TAB character (ASCII 9) |
   77%       | =|\\|= | Output =|\|= |
   78%       | =|\%|= | Output =|%|= |
   79%       | =|\nnn|= | Output character <nnn>. <nnn> is a 1-3 decimal number |
   80%
   81%   Escape sequences to include arguments  from Arguments. Each time
   82%   a %-escape sequence is found in   Format  the next argument from
   83%   Arguments is formatted according to the specification.
   84%
   85%       | =|%t|= | print/1 the next item (mnemonic: term) |
   86%       | =|%w|= | write/1 the next item |
   87%       | =|%q|= | writeq/1 the next item  |
   88%       | =|%d|= | display/1 the next item |
   89%       | =|%n|= | Put the next item as a character |
   90%       | =|%r|= | Write the next item N times where N is the second item (an integer) |
   91%       | =|%s|= | Write the next item as a String (so it must be a list of characters) |
   92%       | =|%f|= |Perform a ttyflush/0 (no items used) |
   93%       | =|%Nc|= | Write the next item Centered in N columns. |
   94%       | =|%Nl|= | Write the next item Left justified in N columns. |
   95%       | =|%Nr|= | Write the next item Right justified in N columns. |
   96%
   97%   @deprecated New code should use format/1, format/2, etc.
   98
   99writef(Format) :-
  100    writef(Format, []).
  101
  102writef([F|String], List) :-
  103    '$writefs'([F|String], List),
  104    fail.                           % clean up global stack
  105writef(String, List) :-
  106    string(String),
  107    string_codes(String, Fstring),
  108    '$writefs'(Fstring, List),
  109    fail.                           % clean up global stack
  110writef(Format, List) :-
  111    atom(Format),
  112    name(Format, Fstring),
  113    '$writefs'(Fstring, List),
  114    fail.                           % clean up global stack
  115writef(_, _).
  116
  117%!  swritef(-String, +Format) is det.
  118%!  swritef(-String, +Format, +Arguments) is det.
  119%
  120%   Use writef/1 or writef/2 and  write   the  result to a _string_.
  121%   Note that this is a  string   in  the sense of string_codes/2,
  122%   _not_ a list of character(-code)s.
  123%
  124%   @deprecated.  See format/2,3 and/or with_output_to/2.
  125
  126swritef(String, Format, Arguments) :-
  127    with_output_to(string(String), writef(Format, Arguments)).
  128swritef(String, Format) :-
  129    with_output_to(string(String), writef(Format)).
  130
  131                        % Formatted write for a string (i.e. a list of
  132                        % character codes).
  133
  134'$writefs'([], _).
  135'$writefs'([0'%, A|Rest], List) :-      %   %<$action'>
  136    '$action'(A, List, More),
  137    !,
  138    '$writefs'(Rest, More).
  139'$writefs'([0'%, D|Rest], [Head|Tail]) :-       %   %<columns><just>
  140    between(0'0, 0'9, D),
  141    '$getpad'(Size, Just, [D|Rest], More),
  142    !,
  143    '$padout'(Head, Size, Just),
  144    '$writefs'(More, Tail).
  145'$writefs'([0'\\, C|Rest], List) :-     %   \<special>
  146    '$special'(C, Char),
  147    !,
  148    put(Char),
  149    '$writefs'(Rest, List).
  150'$writefs'([0'\\|Rest], List) :-        %   \<character code in decimal>
  151    '$getcode'(Char, Rest, More),
  152    !,
  153    put(Char),
  154    '$writefs'(More, List).
  155'$writefs'([Char|Rest], List) :-        %   <ordinary character>
  156    put(Char),
  157    '$writefs'(Rest, List).
  158
  159
  160'$action'(0't, [Head|Tail], Tail) :-    %   Term
  161    print(Head).
  162'$action'(0'd, [Head|Tail], Tail) :-    %   Display
  163    write_canonical(Head).
  164'$action'(0'w, [Head|Tail], Tail) :-    %   Write
  165    write(Head).
  166'$action'(0'q, [Head|Tail], Tail) :-    %   Quoted
  167    writeq(Head).
  168'$action'(0'p,  [Head|Tail], Tail) :-   %   Print
  169    print(Head).
  170'$action'(0'f, List, List) :-           %   Flush
  171    ttyflush.
  172'$action'(0'n, [Char|Tail], Tail) :-    %   iNteger (character)
  173    put(Char).
  174'$action'(0'r, [Thing, Times|Tail], Tail) :-    %   Repeatedly
  175    '$writelots'(Times, Thing).
  176'$action'(0's, [Head|Tail], Tail) :-    %   String
  177    '$padout'(Head).
  178
  179'$special'(0'n, 10).            /*  n  */
  180'$special'(0'l, 10).            /*  l  */
  181'$special'(0'r, 10).            /*  r  */
  182'$special'(0't,  9).            /*  t  */
  183'$special'(0'\\, 0'\\).         /*  \  */
  184'$special'(0'%, 0'%).           /*  %  */
  185
  186'$getcode'(Char, In, Out) :-
  187    '$getdigits'(3, Digits, In, Out),
  188    Digits = [_|_],
  189    name(Char, Digits),
  190    Char < 128.
  191
  192'$getdigits'(Limit, [Digit|Digits], [Digit|Out0], Out) :-
  193    Limit > 0,
  194    between(0'0, 0'9, Digit),
  195    Fewer is Limit - 1,
  196    !,
  197    '$getdigits'(Fewer, Digits, Out0, Out).
  198'$getdigits'(_, [], Out, Out).
  199
  200'$writelots'(N, T) :-
  201    N > 0,
  202    !,
  203    write(T),
  204    M is N - 1,
  205    '$writelots'(M, T).
  206'$writelots'(_, _).
  207
  208/*  The new formats are %nC, %nL, and %nR for centered, left, and right
  209    justified output of atoms, integers, and strings.  This is meant to
  210    simplify the production of tabular output when it is appropriate.
  211    At least one space will always precede/follow the item written.
  212*/
  213
  214'$getpad'(Size, Just, In, Out) :-
  215    '$getdigits'(3, Digits, In, [Out1|Out]),
  216    name(Size, Digits),
  217    '$getpad'(Out1, Just).
  218
  219'$getpad'(0'r, r).              %  right justified
  220'$getpad'(0'l, l).              %  left justified
  221'$getpad'(0'c, c).              %  centered
  222'$getpad'(0'R, r).              %  right justified
  223'$getpad'(0'L, l).              %  left justified
  224'$getpad'(0'C, c).              %  centered
  225
  226
  227                                %   '$padout'(A, S, J) writes the item A in a
  228                                %   field of S or more characters, Justified.
  229
  230'$padout'(String, Size, Just) :-
  231    '$string'(String),
  232    !,
  233    name(Atom, String),
  234    '$padout'(Atom, Size, Just).
  235'$padout'(Term, Size, Just) :-
  236    format(string(Atom), Term, Atom),
  237    atom_length(Atom, Length),
  238    '$padout'(Just, Size, Length, Left, Right),
  239    tab(Left),
  240    write(Atom),
  241    tab(Right).
  242
  243'$string'(0) :- !, fail.
  244'$string'([]) :- !.
  245'$string'([H|T]) :-
  246    '$print'(H),
  247    !,
  248    '$string'(T).
  249
  250'$print'(10).                   % newline
  251'$print'(9).                    % tab
  252'$print'(X) :-
  253    integer(X),
  254    between(32, 0'~, X).
  255
  256
  257                                %   '$padout'(Just, Size, Length, Left, Right)
  258                                %   calculates the number of spaces to put
  259                                %   on the Left and Right of an item needing
  260                                %   Length characters in a field of Size.
  261
  262'$padout'(l, Size, Length, 0, Right) :-
  263    !,
  264    Right is max(1, Size-Length).
  265'$padout'(r, Size, Length, Left, 0) :-
  266    !,
  267    Left is max(1, Size-Length).
  268'$padout'(c, Size, Length, Left, Right) :-
  269    Left is max(1, round((Size - Length)/2)),
  270    Right is max(1, Size - Length - Left).
  271
  272                                %   '$padout'(Str) writes a string.
  273
  274'$padout'([Head|Tail]) :-
  275    !,
  276    put(Head),
  277    '$padout'(Tail).
  278'$padout'([])