← Back to branch summary

~statik/ubuntu/maverick/erlang/erlang-merge-testing

« back to all changes in this revision

Viewing changes to lib/stdlib/src/io_lib.erl

  • Committer: Bazaar Package Importer
  • Author(s): Sergei Golovan
  • Date: 2009-05-01 10:14:38 UTC
  • mfrom: (3.1.4 sid)
  • Revision ID: james.westby@ubuntu.com-20090501101438-6qlr6rsdxgyzrg2z
Tags: 1:13.b-dfsg-2
* Cleaned up patches: removed unneeded patch which helped to support
  different SCTP library versions, made sure that changes for m68k
  architecture applied only when building on this architecture.
* Removed duplicated information from binary packages descriptions.
* Don't require libsctp-dev build-dependency on solaris-i386 architecture
  which allows to build Erlang on Nexenta (thanks to Tim Spriggs for
  the suggestion).

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/stdlib/src/io_lib.erl
1
 
%% ``The contents of this file are subject to the Erlang Public License,
 
1
%%
 
2
%% %CopyrightBegin%
 
3
%% 
 
4
%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
 
5
%% 
 
6
%% The contents of this file are subject to the Erlang Public License,
2
7
%% Version 1.1, (the "License"); you may not use this file except in
3
8
%% compliance with the License. You should have received a copy of the
4
9
%% Erlang Public License along with this software. If not, it can be
5
 
%% retrieved via the world wide web at http://www.erlang.org/.
 
10
%% retrieved online at http://www.erlang.org/.
6
11
%% 
7
12
%% Software distributed under the License is distributed on an "AS IS"
8
13
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
9
14
%% the License for the specific language governing rights and limitations
10
15
%% under the License.
11
16
%% 
12
 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
13
 
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
14
 
%% AB. All Rights Reserved.''
15
 
%% 
16
 
%%     $Id$
 
17
%% %CopyrightEnd%
17
18
%%
18
19
 
19
20
%% This module is a library of useful i/o functions. It is hoped that the
62
63
-export([print/1,print/4,indentation/2]).
63
64
 
64
65
-export([write/1,write/2,write/3,nl/0,format_prompt/1]).
65
 
-export([write_atom/1,write_string/1,write_string/2,write_char/1]).
 
66
-export([write_atom/1,write_string/1,write_string/2,write_unicode_string/1,
 
67
         write_unicode_string/2, write_char/1, write_unicode_char/1]).
66
68
 
67
 
-export([quote_atom/2,char_list/1,deep_char_list/1,printable_list/1]).
 
69
-export([quote_atom/2,char_list/1,unicode_char_list/1,deep_char_list/1,deep_unicode_char_list/1,printable_list/1,printable_unicode_list/1]).
68
70
 
69
71
%% Utilities for collecting characters.
70
 
-export([collect_chars/3,collect_line/2,collect_line/3,get_until/3]).
 
72
-export([collect_chars/3,collect_chars/4,collect_line/2,collect_line/3,collect_line/4,get_until/3,get_until/4]).
71
73
 
72
74
%% Interface calls to sub-modules.
73
75
 
243
245
    write_string(S, $").   %"
244
246
 
245
247
write_string(S, Q) ->
246
 
    [Q|write_string1(S, Q)].
247
 
 
248
 
write_string1([], Q) ->
 
248
    [Q|write_string1(latin1, S, Q)].
 
249
 
 
250
write_unicode_string(S) ->
 
251
    write_unicode_string(S, $").   %"
 
252
 
 
253
write_unicode_string(S, Q) ->
 
254
    [Q|write_string1(unicode, S, Q)].
 
255
 
 
256
write_string1(_,[], Q) ->
249
257
    [Q];
250
 
write_string1([C|Cs], Q) ->
251
 
    string_char(C, Q, write_string1(Cs, Q)).
 
258
write_string1(Enc,[C|Cs], Q) ->
 
259
    string_char(Enc,C, Q, write_string1(Enc,Cs, Q)).
252
260
 
253
 
string_char(Q, Q, Tail) -> [$\\,Q|Tail];        %Must check these first!
254
 
string_char($\\, _, Tail) -> [$\\,$\\|Tail];
255
 
string_char(C, _, Tail) when C >= $\s, C =< $~ ->
256
 
    [C|Tail];
257
 
string_char(C, _, Tail) when C >= $\240, C =< $\377 ->
258
 
    [C|Tail];
259
 
string_char($\n, _, Tail) -> [$\\,$n|Tail];     %\n = LF
260
 
string_char($\r, _, Tail) -> [$\\,$r|Tail];     %\r = CR
261
 
string_char($\t, _, Tail) -> [$\\,$t|Tail];     %\t = TAB
262
 
string_char($\v, _, Tail) -> [$\\,$v|Tail];     %\v = VT
263
 
string_char($\b, _, Tail) -> [$\\,$b|Tail];     %\b = BS
264
 
string_char($\f, _, Tail) -> [$\\,$f|Tail];     %\f = FF
265
 
string_char($\e, _, Tail) -> [$\\,$e|Tail];     %\e = ESC
266
 
string_char($\d, _, Tail) -> [$\\,$d|Tail];     %\d = DEL
267
 
string_char(C, _, Tail) ->                      %Other control characters.
 
261
string_char(_,Q, Q, Tail) -> [$\\,Q|Tail];      %Must check these first!
 
262
string_char(_,$\\, _, Tail) -> [$\\,$\\|Tail];
 
263
string_char(_,C, _, Tail) when C >= $\s, C =< $~ ->
 
264
    [C|Tail];
 
265
string_char(latin1,C, _, Tail) when C >= $\240, C =< $\377 ->
 
266
    [C|Tail];
 
267
string_char(unicode,C, _, Tail) when C >= $\240 ->
 
268
    "\\x{"++erlang:integer_to_list(C, 16)++"}"++Tail;
 
269
string_char(_,$\n, _, Tail) -> [$\\,$n|Tail];   %\n = LF
 
270
string_char(_,$\r, _, Tail) -> [$\\,$r|Tail];   %\r = CR
 
271
string_char(_,$\t, _, Tail) -> [$\\,$t|Tail];   %\t = TAB
 
272
string_char(_,$\v, _, Tail) -> [$\\,$v|Tail];   %\v = VT
 
273
string_char(_,$\b, _, Tail) -> [$\\,$b|Tail];   %\b = BS
 
274
string_char(_,$\f, _, Tail) -> [$\\,$f|Tail];   %\f = FF
 
275
string_char(_,$\e, _, Tail) -> [$\\,$e|Tail];   %\e = ESC
 
276
string_char(_,$\d, _, Tail) -> [$\\,$d|Tail];   %\d = DEL
 
277
string_char(_,C, _, Tail) when C < $\240->      %Other control characters.
268
278
    C1 = (C bsr 6) + $0,
269
279
    C2 = ((C bsr 3) band 7) + $0,
270
280
    C3 = (C band 7) + $0,
276
286
 
277
287
write_char($\s) -> "$\\s";                      %Must special case this.
278
288
write_char(C) when is_integer(C), C >= $\000, C =< $\377 ->
279
 
    [$$|string_char(C, -1, [])].
 
289
    [$$|string_char(latin1,C, -1, [])].
 
290
 
 
291
write_unicode_char(Ch) when Ch =< 255 ->
 
292
    write_char(Ch);
 
293
write_unicode_char(Uni) ->
 
294
    [$$|string_char(unicode,Uni, -1, [])].
280
295
 
281
296
%% char_list(CharList)
282
297
%% deep_char_list(CharList)
288
303
char_list([]) -> true;
289
304
char_list(_) -> false.                  %Everything else is false
290
305
 
 
306
unicode_char_list([C|Cs]) when is_integer(C), C >= 0, C < 16#D800; 
 
307
       is_integer(C), C > 16#DFFF, C < 16#FFFE;
 
308
       is_integer(C), C > 16#FFFF, C =< 16#10FFFF ->
 
309
    unicode_char_list(Cs);
 
310
unicode_char_list([]) -> true;
 
311
unicode_char_list(_) -> false.                  %Everything else is false
 
312
 
291
313
deep_char_list(Cs) ->
292
314
    deep_char_list(Cs, []).
293
315
 
301
323
deep_char_list(_, _More) ->                     %Everything else is false
302
324
    false.
303
325
 
 
326
deep_unicode_char_list(Cs) ->
 
327
    deep_unicode_char_list(Cs, []).
 
328
 
 
329
deep_unicode_char_list([C|Cs], More) when is_list(C) ->
 
330
    deep_unicode_char_list(C, [Cs|More]);
 
331
deep_unicode_char_list([C|Cs], More) 
 
332
  when is_integer(C), C >= 0, C < 16#D800; 
 
333
       is_integer(C), C > 16#DFFF, C < 16#FFFE;
 
334
       is_integer(C), C > 16#FFFF, C =< 16#10FFFF ->
 
335
    deep_unicode_char_list(Cs, More);
 
336
deep_unicode_char_list([], [Cs|More]) ->
 
337
    deep_unicode_char_list(Cs, More);
 
338
deep_unicode_char_list([], []) -> true;
 
339
deep_unicode_char_list(_, _More) ->             %Everything else is false
 
340
    false.
 
341
 
304
342
%% printable_list([Char]) -> bool()
305
343
%%  Return true if CharList is a list of printable characters, else
306
344
%%  false.
319
357
printable_list([]) -> true;
320
358
printable_list(_) -> false.                     %Everything else is false
321
359
 
 
360
%% printable_unicode_list([Char]) -> bool()
 
361
%%  Return true if CharList is a list of printable characters, else
 
362
%%  false. The notion of printable in Unicode terms is somewhat floating.
 
363
%%  Everything that is not a control character and not invalid unicode 
 
364
%%  will be considered printable.
 
365
 
 
366
printable_unicode_list([C|Cs]) when is_integer(C), C >= $\040, C =< $\176 ->
 
367
    printable_unicode_list(Cs);
 
368
printable_unicode_list([C|Cs]) 
 
369
  when is_integer(C), C >= 16#A0, C < 16#D800; 
 
370
       is_integer(C), C > 16#DFFF, C < 16#FFFE;
 
371
       is_integer(C), C > 16#FFFF, C =< 16#10FFFF ->
 
372
    printable_unicode_list(Cs);
 
373
printable_unicode_list([$\n|Cs]) -> printable_unicode_list(Cs);
 
374
printable_unicode_list([$\r|Cs]) -> printable_unicode_list(Cs);
 
375
printable_unicode_list([$\t|Cs]) -> printable_unicode_list(Cs);
 
376
printable_unicode_list([$\v|Cs]) -> printable_unicode_list(Cs);
 
377
printable_unicode_list([$\b|Cs]) -> printable_unicode_list(Cs);
 
378
printable_unicode_list([$\f|Cs]) -> printable_unicode_list(Cs);
 
379
printable_unicode_list([$\e|Cs]) -> printable_unicode_list(Cs);
 
380
printable_unicode_list([]) -> true;
 
381
printable_unicode_list(_) -> false.                     %Everything else is false
 
382
 
322
383
%% List = nl()
323
384
%%  Return a list of characters to generate a newline.
324
385
 
329
390
%% Utilities for collecting characters in input files
330
391
%%
331
392
 
 
393
count_and_find_utf8(Bin,N) ->
 
394
    cafu(Bin,N,0,0,none).
 
395
 
 
396
cafu(<<>>,_N,Count,_ByteCount,SavePos) ->
 
397
    {Count,SavePos};
 
398
cafu(<<_/utf8,Rest/binary>>, 0, Count, ByteCount, _SavePos) ->
 
399
    cafu(Rest,-1,Count+1,0,ByteCount);
 
400
cafu(<<_/utf8,Rest/binary>>, N, Count, _ByteCount, SavePos) when N < 0 ->
 
401
    cafu(Rest,-1,Count+1,0,SavePos);
 
402
cafu(<<_/utf8,Rest/binary>> = Whole, N, Count, ByteCount, SavePos) ->
 
403
    Delta = byte_size(Whole) - byte_size(Rest),
 
404
    cafu(Rest,N-1,Count+1,ByteCount+Delta,SavePos);
 
405
cafu(_Other,_N,Count,_ByteCount,SavePos) -> % Non Utf8 character at end
 
406
    {Count,SavePos}.
332
407
 
333
408
%% collect_chars(State, Data, Count). New in R9C.
334
409
%%  Returns:
335
410
%%      {stop,Result,RestData}
336
411
%%      NewState
337
 
collect_chars(start, Data, N) when is_binary(Data) ->
 
412
%%% BC (with pre-R13).
 
413
collect_chars(Tag, Data, N) ->
 
414
    collect_chars(Tag, Data, latin1, N).
 
415
 
 
416
%% Now we are aware of encoding...    
 
417
collect_chars(start, Data, unicode, N) when is_binary(Data) ->
 
418
    {Size,Npos} = count_and_find_utf8(Data,N),
 
419
    if Size > N ->
 
420
            {B1,B2} = split_binary(Data, Npos),
 
421
            {stop,B1,B2};
 
422
       Size < N ->
 
423
            {binary,[Data],N-Size};
 
424
       true ->
 
425
            {stop,Data,eof}
 
426
    end;
 
427
collect_chars(start, Data, latin1, N) when is_binary(Data) ->
338
428
    Size = byte_size(Data),
339
429
    if Size > N ->
340
430
            {B1,B2} = split_binary(Data, N),
344
434
       true ->
345
435
            {stop,Data,eof}
346
436
    end;
347
 
collect_chars(start,Data,N) when is_list(Data) ->
 
437
collect_chars(start,Data,_,N) when is_list(Data) ->
348
438
    collect_chars_list([], N, Data);
349
 
collect_chars(start, eof, _) ->
 
439
collect_chars(start, eof, _,_) ->
350
440
    {stop,eof,eof};
351
 
collect_chars({binary,Stack,_N}, eof, _) ->
 
441
collect_chars({binary,Stack,_N}, eof, _,_) ->
352
442
    {stop,binrev(Stack),eof};
353
 
collect_chars({binary,Stack,N}, Data, _) ->
 
443
collect_chars({binary,Stack,N}, Data,unicode, _) ->
 
444
    {Size,Npos} = count_and_find_utf8(Data,N),
 
445
    if Size > N ->
 
446
            {B1,B2} = split_binary(Data, Npos),
 
447
            {stop,binrev(Stack, [B1]),B2};
 
448
       Size < N ->
 
449
            {binary,[Data|Stack],N-Size};
 
450
       true ->
 
451
            {stop,binrev(Stack, [Data]),eof}
 
452
    end;
 
453
collect_chars({binary,Stack,N}, Data,latin1, _) ->
354
454
    Size = byte_size(Data),
355
455
    if Size > N ->
356
456
            {B1,B2} = split_binary(Data, N),
360
460
       true ->
361
461
            {stop,binrev(Stack, [Data]),eof}
362
462
    end;
363
 
collect_chars({list,Stack,N}, Data, _) ->
 
463
collect_chars({list,Stack,N}, Data, _,_) ->
364
464
    collect_chars_list(Stack, N, Data);
365
465
%% collect_chars(Continuation, MoreChars, Count)
366
466
%%  Returns:
367
467
%%      {done,Result,RestChars}
368
468
%%      {more,Continuation}
369
469
 
370
 
collect_chars([], Chars, N) ->
 
470
collect_chars([], Chars, _, N) ->
371
471
    collect_chars1(N, Chars, []);
372
 
collect_chars({Left,Sofar}, Chars, _N) ->
 
472
collect_chars({Left,Sofar}, Chars, _, _N) ->
373
473
    collect_chars1(Left, Chars, Sofar).
374
474
 
375
475
collect_chars1(N, Chars, Stack) when N =< 0 ->
422
522
%%  Returns:
423
523
%%      {stop,Result,RestData}
424
524
%%      NewState
 
525
%%% BC (with pre-R13).
 
526
collect_line(Tag, Data, Any) -> 
 
527
    collect_line(Tag, Data, latin1, Any).
425
528
 
426
 
collect_line(start, Data, _) when is_binary(Data) ->
427
 
%    erlang:display({?MODULE,?LINE,[start,Data]}),
428
 
    collect_line_bin(Data, Data, []);
429
 
collect_line(start, Data, _) when is_list(Data) ->
430
 
%    erlang:display({?MODULE,?LINE,[start,Data]}),
 
529
%% Now we are aware of encoding...    
 
530
collect_line(start, Data, Encoding, _) when is_binary(Data) ->
 
531
    collect_line_bin(Data, Data, [], Encoding);
 
532
collect_line(start, Data, _, _) when is_list(Data) ->
431
533
    collect_line_list(Data, []);
432
 
collect_line(start, eof, _) ->
433
 
%    erlang:display({?MODULE,?LINE,[start,eof]}),
 
534
collect_line(start, eof, _, _) ->
434
535
    {stop,eof,eof};
435
 
collect_line(Stack, Data, _) when is_binary(Data) ->
436
 
%    erlang:display({?MODULE,?LINE,[Stack,Data]}),
437
 
    collect_line_bin(Data, Data, Stack);
438
 
collect_line(Stack, Data, _) when is_list(Data) ->
439
 
%    erlang:display({?MODULE,?LINE,[Stack,Data]}),
 
536
collect_line(Stack, Data, Encoding, _) when is_binary(Data) ->
 
537
    collect_line_bin(Data, Data, Stack, Encoding);
 
538
collect_line(Stack, Data, _, _) when is_list(Data) ->
440
539
    collect_line_list(Data, Stack);
441
 
collect_line([B|_]=Stack, eof, _) when is_binary(B) ->
442
 
%    erlang:display({?MODULE,?LINE,[Stack,eof]}),
 
540
collect_line([B|_]=Stack, eof, _, _) when is_binary(B) ->
443
541
    {stop,binrev(Stack),eof};
444
 
collect_line(Stack, eof, _) ->
445
 
%    erlang:display({?MODULE,?LINE,[Stack,eof]}),
 
542
collect_line(Stack, eof, _, _) ->
446
543
    {stop,lists:reverse(Stack, []),eof}.
447
544
 
448
 
collect_line_bin(<<$\n,T/binary>>, Data, Stack0) ->
 
545
 
 
546
collect_line_bin(<<$\n,T/binary>>, Data, Stack0, _) ->
449
547
    N = byte_size(Data) - byte_size(T),
450
548
    <<Line:N/binary,_/binary>> = Data,
451
549
    case Stack0 of
456
554
        _ ->
457
555
            {stop,binrev(Stack0, [Line]),T}
458
556
    end;
459
 
collect_line_bin(<<$\r,$\n,T/binary>>, Data, Stack) ->
 
557
collect_line_bin(<<$\r,$\n,T/binary>>, Data, Stack, _) ->
460
558
    N = byte_size(Data) - byte_size(T) - 2,
461
559
    <<Line:N/binary,_/binary>> = Data,
462
560
    {stop,binrev(Stack, [Line,$\n]),T};
463
 
collect_line_bin(<<$\r>>, Data0, Stack) ->
 
561
collect_line_bin(<<$\r>>, Data0, Stack, _) ->
464
562
    N = byte_size(Data0) - 1,
465
563
    <<Data:N/binary,_/binary>> = Data0,
466
564
    [<<$\r>>,Data|Stack];
467
 
collect_line_bin(<<_,T/binary>>, Data, Stack) ->
468
 
    collect_line_bin(T, Data, Stack);
469
 
collect_line_bin(<<>>, Data, Stack) ->
 
565
collect_line_bin(<<_,T/binary>>, Data, Stack, Enc) ->
 
566
    collect_line_bin(T, Data, Stack, Enc);
 
567
collect_line_bin(<<>>, Data, Stack, _) ->
470
568
    %% Need more data here.
471
569
    [Data|Stack].
472
570
 
484
582
%%
485
583
%% Implements a middleman that is get_until server and get_chars client.
486
584
 
487
 
get_until(start, Data, XtraArg) ->
488
 
    get_until([], Data, XtraArg);
489
 
get_until(Cont, Data, {Mod, Func, XtraArgs}) ->
490
 
    Chars = if is_binary(Data) ->
 
585
%%% BC (with pre-R13).
 
586
get_until(Any,Data,Arg) ->
 
587
    get_until(Any,Data,latin1,Arg).
 
588
 
 
589
%% Now we are aware of encoding...    
 
590
get_until(start, Data, Encoding, XtraArg) ->
 
591
    get_until([], Data, Encoding, XtraArg);
 
592
get_until(Cont, Data, Encoding, {Mod, Func, XtraArgs}) ->
 
593
    Chars = if is_binary(Data), Encoding =:= unicode ->
 
594
                    unicode:characters_to_list(Data,utf8);
 
595
               is_binary(Data) ->
491
596
                    binary_to_list(Data);
492
597
               true ->
493
598
                    Data
494
599
            end,
495
600
    case apply(Mod, Func, [Cont,Chars|XtraArgs]) of
496
601
        {done,Result,Buf} ->
497
 
            {stop,Result,Buf};
 
602
            {stop,if is_binary(Data), 
 
603
                     is_list(Result), 
 
604
                     Encoding =:= unicode ->
 
605
                          unicode:characters_to_binary(Result,unicode,unicode);
 
606
                     is_binary(Data), 
 
607
                     is_list(Result) ->
 
608
                          erlang:iolist_to_binary(Result);
 
609
%%                   is_list(Data),
 
610
%%                   is_list(Result),
 
611
%%                   Encoding =:= latin1 ->
 
612
%%                        % Should check for only latin1, but skip that for
 
613
%%                        % efficiency reasons.
 
614
%%                        [ exit({cannot_convert, unicode, latin1}) || 
 
615
%%                            X <- List, X > 255 ];
 
616
                     true ->
 
617
                          Result
 
618
                  end,
 
619
             Buf};
498
620
        {more,NewCont} ->
499
621
            NewCont
500
622
    end.