1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114 | -- Abstract :
--
-- See spec.
--
-- Copyright (C) 2017, 2019, 2021 - 2022 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN-
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-- As a special exception under Section 7 of GPL version 3, you are granted
-- additional permissions described in the GCC Runtime Library Exception,
-- version 3.1, as published by the Free Software Foundation.
pragma License (Modified_GPL);
with Ada.Calendar.Formatting;
with Ada.Strings.Fixed;
package body WisiToken.Text_IO_Trace is
function Insert_Prefix_At_Newlines (Trace : in Text_IO_Trace.Trace; Item : in String) return String
is
use Ada.Strings.Fixed;
use Ada.Strings.Unbounded;
Result : Unbounded_String;
First : Integer := Item'First;
Last : Integer;
begin
loop
Last := Index (Pattern => "" & ASCII.LF, Source => Item (First .. Item'Last));
exit when Last = 0;
Result := Result & Item (First .. Last) & Trace.Prefix;
First := Last + 1;
end loop;
Result := Result & Item (First .. Item'Last);
return -Result;
end Insert_Prefix_At_Newlines;
----------
-- Public subprograms, declaration order
overriding
procedure Set_Prefix (Trace : in out Text_IO_Trace.Trace; Prefix : in String)
is begin
Trace.Prefix := +Prefix;
end Set_Prefix;
overriding
procedure Put (Trace : in out Text_IO_Trace.Trace; Item : in String; Prefix : in Boolean := True)
is
use Ada.Text_IO;
begin
if Trace.File /= null and then Is_Open (Trace.File.all) then
Ada.Text_IO.Put (Trace.File.all, (if Prefix then -Trace.Prefix else "") & Item);
else
Ada.Text_IO.Put ((if Prefix then -Trace.Prefix else "") & Item);
end if;
end Put;
overriding
procedure Put_Line (Trace : in out Text_IO_Trace.Trace; Item : in String)
is
use Ada.Strings.Fixed;
use Ada.Text_IO;
Temp : constant String :=
(if 0 /= Index (Item, "" & ASCII.LF)
then Insert_Prefix_At_Newlines (Trace, Item)
else Item);
begin
if Trace.File /= null and then Is_Open (Trace.File.all) then
Ada.Text_IO.Put (Trace.File.all, -Trace.Prefix);
Ada.Text_IO.Put_Line (Trace.File.all, Temp);
Ada.Text_IO.Flush (Trace.File.all);
else
Ada.Text_IO.Put (-Trace.Prefix);
Ada.Text_IO.Put_Line (Temp);
Ada.Text_IO.Flush;
end if;
end Put_Line;
overriding
procedure New_Line (Trace : in out Text_IO_Trace.Trace)
is
use Ada.Text_IO;
begin
if Trace.File /= null and then Is_Open (Trace.File.all) then
Ada.Text_IO.New_Line (Trace.File.all);
else
Ada.Text_IO.New_Line;
end if;
end New_Line;
overriding
procedure Put_Clock (Trace : in out Text_IO_Trace.Trace; Label : in String)
is begin
Trace.Put_Line
(Ada.Calendar.Formatting.Image
(Ada.Calendar.Clock, Include_Time_Fraction => True) & " " & Label);
end Put_Clock;
procedure Set_File (Trace : in out Text_IO_Trace.Trace; File : in Ada.Text_IO.File_Access)
is begin
Trace.File := File;
end Set_File;
procedure Clear_File (Trace : in out Text_IO_Trace.Trace)
is begin
Trace.File := null;
end Clear_File;
end WisiToken.Text_IO_Trace;
|