------------------------------------------------------------------------------
-- Copyright (c) 2013-2014, Natacha Porté --
-- --
-- Permission to use, copy, modify, and distribute this software for any --
-- purpose with or without fee is hereby granted, provided that the above --
-- copyright notice and this permission notice appear in all copies. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Sxcat concatenates and pretty prints input S-expressions to standard --
-- output. --
-- Pretty printer options can be given through command-line options or --
-- loaded from a S-expression file. --
------------------------------------------------------------------------------
with Ada.Command_Line;
with Ada.Streams.Stream_IO;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Text_IO.Text_Streams;
with Natools.Getopt_Long;
with Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Encodings;
with Natools.S_Expressions.File_Readers;
with Natools.S_Expressions.Lockable;
with Natools.S_Expressions.Parsers;
with Natools.S_Expressions.Printers.Pretty.Config;
procedure Sxcat is
package SE renames Natools.S_Expressions;
Param : SE.Printers.Pretty.Parameters :=
(Char_Encoding => SE.Printers.Pretty.ASCII,
Fallback => SE.Printers.Pretty.Hexadecimal,
Hex_Casing => SE.Encodings.Upper,
Indent => SE.Printers.Pretty.Tabs,
Indentation => 1,
Newline => SE.Printers.Pretty.LF,
Newline_At => (SE.Printers.Pretty.Opening =>
(SE.Printers.Pretty.Opening => True,
SE.Printers.Pretty.Atom_Data => False,
SE.Printers.Pretty.Closing => False),
SE.Printers.Pretty.Atom_Data =>
(SE.Printers.Pretty.Opening => True,
SE.Printers.Pretty.Atom_Data => True,
SE.Printers.Pretty.Closing => True),
SE.Printers.Pretty.Closing =>
(SE.Printers.Pretty.Opening => True,
SE.Printers.Pretty.Atom_Data => True,
SE.Printers.Pretty.Closing => True)),
Quoted => SE.Printers.Pretty.When_Shorter,
Quoted_Escape => SE.Printers.Pretty.Octal_Escape,
Space_At => (others => (others => False)),
Tab_Stop => 8,
Token => SE.Printers.Pretty.Standard_Token,
Width => 79);
To_Print : SE.Printers.Pretty.Parameters := Param;
Output_Stream : constant Ada.Text_IO.Text_Streams.Stream_Access
:= Ada.Text_IO.Text_Streams.Stream (Ada.Text_IO.Current_Output);
function Is_Natural (Argument : in String) return Boolean;
package Options is
type Id is
(ASCII,
Atom,
Base64_Expr,
Base64_Atom,
Canonical,
Dos_Newline,
Dump_Config,
Eight_Bit,
Extended_Token,
Load_Config,
Hex_Atom,
Hex_Escape,
Help,
Newline_At,
Newline_Encoding,
No_Indent,
No_Quoted,
No_Token,
Indent,
Octal_Escape,
Quoted_Single_Line,
Quoted_When_Shorter,
Space_At,
Tab_Stop,
Token,
Unix_Newline,
UTF_8,
Verbatim,
Width,
Upper_Hex,
Lower_Hex,
Atom_List);
type Action is
(Error,
Print_Help,
Run,
Run_Base64,
Print_Atom,
Print_Atom_List,
Print_Config);
end Options;
package Getopt is new Natools.Getopt_Long (Options.Id);
function Getopt_Config return Getopt.Configuration;
type Callback is new Getopt.Handlers.Callback with record
Action : Options.Action := Options.Run;
Arg_Count : Natural := 0;
end record;
overriding procedure Option
(Handler : in out Callback;
Id : in Options.Id;
Argument : in String);
overriding procedure Argument
(Handler : in out Callback;
Argument : in String);
procedure Parse_Separator
(Separator : in out SE.Printers.Pretty.Entity_Separator;
Image : in String);
procedure Process
(Handler : in Callback'Class;
Input : access Ada.Streams.Root_Stream_Type'Class);
procedure Process
(Printer : in out SE.Printers.Pretty.Stream_Printer;
Input : access Ada.Streams.Root_Stream_Type'Class;
Parse : in Boolean := True);
procedure Print_Help
(Opt : in Getopt.Configuration;
Output : in Ada.Text_IO.File_Type);
type Base64_Stream (Backend : access Ada.Streams.Root_Stream_Type'Class) is
new Ada.Streams.Root_Stream_Type with record
Buffer : Ada.Streams.Stream_Element_Array (1 .. 3);
Cursor : Ada.Streams.Stream_Element_Offset := 1;
end record;
procedure Read
(Stream : in out Base64_Stream;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
procedure Write
(Stream : in out Base64_Stream;
Item : in Ada.Streams.Stream_Element_Array);
procedure Open (Stream : in out Base64_Stream'Class);
procedure Close (Stream : in out Base64_Stream'Class);
function Is_Natural (Argument : in String) return Boolean is
begin
if Argument = "" then
return False;
end if;
for I in Argument'Range loop
if Argument (I) not in '0' .. '9' then
return False;
end if;
end loop;
return True;
end Is_Natural;
function Getopt_Config return Getopt.Configuration is
use Getopt;
Result : Getopt.Configuration;
begin
Result.Add_Option
("8-bit", '8', No_Argument, Options.Eight_Bit);
Result.Add_Option
("ASCII", 'A', No_Argument, Options.ASCII);
Result.Add_Option
("atom", 'a', No_Argument, Options.Atom);
Result.Add_Option
("brace", 'B', No_Argument, Options.Base64_Expr);
Result.Add_Option
("base64", 'b', No_Argument, Options.Base64_Atom);
Result.Add_Option
("canonical", 'c', No_Argument, Options.Canonical);
Result.Add_Option
("dos-newline", 'D', No_Argument, Options.Dos_Newline);
Result.Add_Option
("dump-config", 'd', No_Argument, Options.Dump_Config);
Result.Add_Option
("escape-hex", 'E', No_Argument, Options.Hex_Escape);
Result.Add_Option
("ext-token", 'e', No_Argument, Options.Extended_Token);
Result.Add_Option
("config", 'f', Required_Argument, Options.Load_Config);
Result.Add_Option
("hex-atom", 'H', No_Argument, Options.Hex_Atom);
Result.Add_Option
("help", 'h', No_Argument, Options.Help);
Result.Add_Option
("no-indent", 'I', No_Argument, Options.No_Indent);
Result.Add_Option
("indent", 'i', Required_Argument, Options.Indent);
Result.Add_Option
("single-line", 'l', No_Argument, Options.Quoted_Single_Line);
Result.Add_Option
("newline-at", 'N', Required_Argument, Options.Newline_At);
Result.Add_Option
("nl-encoding", 'n', Required_Argument, Options.Newline_Encoding);
Result.Add_Option
("escape-octal", 'o', No_Argument, Options.Octal_Escape);
Result.Add_Option
("no-quoted", 'Q', No_Argument, Options.No_Quoted);
Result.Add_Option
("quoted", 'q', No_Argument, Options.Quoted_When_Shorter);
Result.Add_Option
("space-at", 'S', Required_Argument, Options.Space_At);
Result.Add_Option
("tab-stop", 's', Required_Argument, Options.Tab_Stop);
Result.Add_Option
("no-token", 'T', No_Argument, Options.No_Token);
Result.Add_Option
("token", 't', No_Argument, Options.Token);
Result.Add_Option
("unix-newline", 'U', No_Argument, Options.Unix_Newline);
Result.Add_Option
("utf-8", 'u', No_Argument, Options.UTF_8);
Result.Add_Option
("verbatim", 'v', No_Argument, Options.Verbatim);
Result.Add_Option
("width", 'w', Required_Argument, Options.Width);
Result.Add_Option
("upper-hex", 'X', No_Argument, Options.Upper_Hex);
Result.Add_Option
("lower-hex", 'x', No_Argument, Options.Lower_Hex);
Result.Add_Option
("atom-list", No_Argument, Options.Atom_List);
return Result;
end Getopt_Config;
overriding procedure Option
(Handler : in out Callback;
Id : in Options.Id;
Argument : in String)
is
use type Options.Action;
begin
case Id is
when Options.ASCII =>
Param.Char_Encoding := SE.Printers.Pretty.ASCII;
when Options.Atom =>
if Handler.Action in Options.Run .. Options.Print_Config then
Handler.Action := Options.Print_Atom;
end if;
when Options.Atom_List =>
if Handler.Action in Options.Run .. Options.Print_Config then
Handler.Action := Options.Print_Atom_List;
end if;
when Options.Base64_Atom =>
Param.Quoted := SE.Printers.Pretty.No_Quoted;
Param.Fallback := SE.Printers.Pretty.Base64;
when Options.Base64_Expr =>
if Handler.Action in Options.Run .. Options.Print_Config then
Handler.Action := Options.Run_Base64;
end if;
when Options.Canonical =>
Param.Width := 0;
Param.Newline_At := (others => (others => False));
Param.Space_At := (others => (others => False));
Param.Indentation := 0;
Param.Quoted := SE.Printers.Pretty.No_Quoted;
Param.Token := SE.Printers.Pretty.No_Token;
Param.Fallback := SE.Printers.Pretty.Verbatim;
when Options.Dos_Newline =>
Param.Newline := SE.Printers.Pretty.CR_LF;
when Options.Dump_Config =>
if Handler.Action in Options.Run .. Options.Print_Config then
To_Print := Param;
Handler.Action := Options.Print_Config;
end if;
when Options.Eight_Bit =>
Param.Char_Encoding := SE.Printers.Pretty.Latin;
when Options.Extended_Token =>
Param.Token := SE.Printers.Pretty.Extended_Token;
when Options.Indent =>
declare
package Fixed renames Ada.Strings.Fixed;
package Maps renames Ada.Strings.Maps;
Last : constant Natural := Fixed.Index
(Source => Argument,
Set => Maps.To_Set ("0123456789"),
Going => Ada.Strings.Backward);
begin
if Last = 0 then
Handler.Action := Options.Error;
elsif Last = Argument'Last then
Param.Indentation := SE.Printers.Pretty.Screen_Offset'Value
(Argument);
elsif Argument (Last + 1 .. Argument'Last) = "t"
or else Argument (Last + 1 .. Argument'Last) = "T"
then
Param.Indentation := SE.Printers.Pretty.Screen_Offset'Value
(Argument (Argument'First .. Last));
Param.Indent := SE.Printers.Pretty.Tabs;
elsif Argument (Last + 1 .. Argument'Last) = "s"
or else Argument (Last + 1 .. Argument'Last) = "S"
then
Param.Indentation := SE.Printers.Pretty.Screen_Offset'Value
(Argument (Argument'First .. Last));
Param.Indent := SE.Printers.Pretty.Spaces;
elsif Argument (Last + 1 .. Argument'Last) = "ts"
or else Argument (Last + 1 .. Argument'Last) = "TS"
or else Argument (Last + 1 .. Argument'Last) = "st"
or else Argument (Last + 1 .. Argument'Last) = "ST"
then
Param.Indentation := SE.Printers.Pretty.Screen_Offset'Value
(Argument (Argument'First .. Last));
Param.Indent := SE.Printers.Pretty.Tabs_And_Spaces;
else
Handler.Action := Options.Error;
end if;
exception
when Constraint_Error =>
Handler.Action := Options.Error;
end;
when Options.Hex_Atom =>
Param.Fallback := SE.Printers.Pretty.Hexadecimal;
when Options.Hex_Escape =>
Param.Quoted_Escape := SE.Printers.Pretty.Hex_Escape;
when Options.Help =>
Handler.Action := Options.Print_Help;
when Options.Load_Config =>
declare
Conf : SE.Lockable.Descriptor'Class
:= SE.File_Readers.Reader (Argument);
begin
SE.Printers.Pretty.Config.Update (Param, Conf);
end;
when Options.Newline_At =>
Parse_Separator (Param.Newline_At, Argument);
when Options.Newline_Encoding =>
begin
case Argument'Length is
when 2 =>
Param.Newline := SE.Printers.Pretty.Newline_Encoding'Value
(Argument);
when 4 | 5 =>
Param.Newline := SE.Printers.Pretty.Newline_Encoding'Value
(Argument (Argument'First .. Argument'First + 1)
& '_'
& Argument (Argument'Last - 1 .. Argument'Last));
when others =>
raise Constraint_Error;
end case;
exception
when Constraint_Error =>
Ada.Text_IO.Put_Line
(Ada.Text_IO.Current_Error,
"Invalid newline encoding """ & Argument & '"');
Handler.Action := Options.Error;
end;
when Options.No_Quoted =>
Param.Quoted := SE.Printers.Pretty.No_Quoted;
when Options.No_Indent =>
Param.Indentation := 0;
when Options.No_Token =>
Param.Token := SE.Printers.Pretty.No_Token;
when Options.Octal_Escape =>
Param.Quoted_Escape := SE.Printers.Pretty.Octal_Escape;
when Options.Quoted_Single_Line =>
Param.Quoted := SE.Printers.Pretty.Single_Line;
when Options.Quoted_When_Shorter =>
Param.Quoted := SE.Printers.Pretty.When_Shorter;
when Options.Space_At =>
Parse_Separator (Param.Space_At, Argument);
when Options.Tab_Stop =>
if Is_Natural (Argument) then
Param.Tab_Stop
:= SE.Printers.Pretty.Screen_Offset'Value (Argument);
else
Handler.Action := Options.Error;
end if;
when Options.Token =>
Param.Token := SE.Printers.Pretty.Standard_Token;
when Options.Unix_Newline =>
Param.Newline := SE.Printers.Pretty.LF;
when Options.UTF_8 =>
Param.Char_Encoding := SE.Printers.Pretty.UTF_8;
when Options.Verbatim =>
Param.Fallback := SE.Printers.Pretty.Verbatim;
when Options.Width =>
if Is_Natural (Argument) then
Param.Width
:= SE.Printers.Pretty.Screen_Offset'Value (Argument);
else
Handler.Action := Options.Error;
end if;
when Options.Upper_Hex =>
Param.Hex_Casing := SE.Encodings.Upper;
when Options.Lower_Hex =>
Param.Hex_Casing := SE.Encodings.Lower;
end case;
end Option;
overriding procedure Argument
(Handler : in out Callback;
Argument : in String)
is
use type Options.Action;
begin
Handler.Arg_Count := Handler.Arg_Count + 1;
if Handler.Action not in Options.Run .. Options.Print_Config then
return;
end if;
if Argument = "-" then
Process
(Handler,
Ada.Text_IO.Text_Streams.Stream (Ada.Text_IO.Current_Input));
else
declare
File : Ada.Streams.Stream_IO.File_Type;
begin
Ada.Streams.Stream_IO.Open
(File, Ada.Streams.Stream_IO.In_File, Argument);
Process
(Handler,
Ada.Streams.Stream_IO.Stream (File));
Ada.Streams.Stream_IO.Close (File);
end;
end if;
end Argument;
procedure Parse_Separator
(Separator : in out SE.Printers.Pretty.Entity_Separator;
Image : in String)
is
procedure Parse
(C : in Character;
Entity : out SE.Printers.Pretty.Entity;
Valid : out Boolean);
procedure Parse
(C : in Character;
Entity : out SE.Printers.Pretty.Entity;
Valid : out Boolean) is
begin
case C is
when '(' | 'o' | 'O' =>
Entity := SE.Printers.Pretty.Opening;
Valid := True;
when ')' | 'c' | 'C' =>
Entity := SE.Printers.Pretty.Closing;
Valid := True;
when 'a' | 'A' | 'd' | 'D' | 'x' | 'X' =>
Entity := SE.Printers.Pretty.Atom_Data;
Valid := True;
when others =>
Valid := False;
end case;
end Parse;
I : Positive := Image'First;
Before, After : SE.Printers.Pretty.Entity := SE.Printers.Pretty.Opening;
Valid : Boolean;
Result : SE.Printers.Pretty.Entity_Separator
:= (others => (others => False));
begin
while I + 1 in Image'Range loop
Parse (Image (I), Before, Valid);
if Valid then
Parse (Image (I + 1), After, Valid);
if Valid then
Result (Before, After) := True;
end if;
I := I + 1;
end if;
I := I + 1;
end loop;
Separator := Result;
end Parse_Separator;
Printer_Direct : SE.Printers.Pretty.Stream_Printer (Output_Stream);
Base64_Output : aliased Base64_Stream (Output_Stream);
Printer_Base64 : SE.Printers.Pretty.Stream_Printer (Base64_Output'Access);
First_Atom_In_List : Boolean := True;
procedure Process
(Handler : in Callback'Class;
Input : access Ada.Streams.Root_Stream_Type'Class) is
begin
case Handler.Action is
when Options.Error | Options.Print_Help | Options.Print_Config =>
raise Program_Error;
when Options.Run =>
Printer_Direct.Set_Parameters (Param);
Process (Printer_Direct, Input, True);
when Options.Run_Base64 =>
if Handler.Arg_Count = 1 then
Open (Base64_Output);
end if;
Printer_Base64.Set_Parameters (Param);
Process (Printer_Base64, Input, True);
when Options.Print_Atom =>
Printer_Direct.Set_Parameters (Param);
Process (Printer_Direct, Input, False);
when Options.Print_Atom_List =>
if First_Atom_In_List then
Printer_Direct.Open_List;
First_Atom_In_List := False;
end if;
Printer_Direct.Set_Parameters (Param);
Process (Printer_Direct, Input, False);
end case;
end Process;
procedure Process
(Printer : in out SE.Printers.Pretty.Stream_Printer;
Input : access Ada.Streams.Root_Stream_Type'Class;
Parse : in Boolean := True)
is
Parser : SE.Parsers.Stream_Parser (Input);
Event : SE.Events.Event;
begin
if Parse then
loop
Parser.Next (Event);
case Event is
when SE.Events.Error =>
raise Program_Error;
when SE.Events.Open_List =>
Printer.Open_List;
when SE.Events.Close_List =>
Printer.Close_List;
when SE.Events.Add_Atom =>
Printer.Append_Atom (Parser.Current_Atom);
when SE.Events.End_Of_Input =>
exit;
end case;
end loop;
else
declare
use type Ada.Streams.Stream_Element_Offset;
Buffer : SE.Atom_Buffers.Atom_Buffer;
Chunk : Ada.Streams.Stream_Element_Array (1 .. 1024);
Last : Ada.Streams.Stream_Element_Offset;
begin
loop
Input.Read (Chunk, Last);
exit when Last + 1 = Chunk'First;
Buffer.Append (Chunk (1 .. Last));
exit when Last < Chunk'Last;
end loop;
Printer.Append_Atom (Buffer.Data
(Buffer.Data'First .. Buffer.Data'First + Buffer.Length - 1));
end;
end if;
end Process;
procedure Print_Help
(Opt : in Getopt.Configuration;
Output : in Ada.Text_IO.File_Type)
is
use Ada.Text_IO;
Indent : constant String := " ";
begin
Put_Line (Output, "Usage:");
for Id in Options.Id loop
Put (Output, Indent & Opt.Format_Names (Id));
case Id is
when Options.ASCII =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Assume ASCII encoding of output");
when Options.Atom =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Treat intputs as individual atoms");
when Options.Atom_List =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Treat intputs as a list of individual atoms");
when Options.Base64_Expr =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Output the expression in base-64 encoding");
when Options.Base64_Atom =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Output atoms using base-64 encoding");
when Options.Canonical =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Output canonical representation");
when Options.Dos_Newline =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Use DOS newlines (CR+LF)");
when Options.Dump_Config =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Output printer configuration instead of input");
when Options.Eight_Bit =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Assume 8-bit wide encoding of output (e.g. ISO-8859-*)");
when Options.Extended_Token =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Output atoms as extended tokens when possible");
when Options.Hex_Atom =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Use hexadecimal encoding for atoms");
when Options.Hex_Escape =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Use hexadecimal escape sequences in quoted strings");
when Options.Help =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Display help");
when Options.Indent =>
Put_Line (Output, " <number>[st]");
Put_Line (Output, Indent & Indent
& "Set indentation to that number of spaces or tabs or both");
when Options.Load_Config =>
Put_Line (Output, " <filename>");
Put_Line (Output, Indent & Indent
& "Load printer configuration from file");
when Options.Newline_At =>
Put_Line (Output, " <position list>");
Put_Line (Output, Indent & Indent
& "Insert newlines at the given positions");
when Options.Newline_Encoding =>
Put_Line (Output, " <newline encoding>");
Put_Line (Output, Indent & Indent
& "Use given newline encoding (CR, LF, CR_LF or LF_CR)");
when Options.No_Quoted =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Disable quoted-string encoding for atoms");
when Options.No_Indent =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Disable indentation");
when Options.No_Token =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Disable token encoding for atoms");
when Options.Octal_Escape =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Use octal escape sequences in quoted strings");
when Options.Quoted_Single_Line =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Use quoted-string atom encoding when it fits on the line");
when Options.Quoted_When_Shorter =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Use quoted-string atom encoding when shorter");
when Options.Space_At =>
Put_Line (Output, " <position list>");
Put_Line (Output, Indent & Indent
& "Insert a space at the given positions");
when Options.Tab_Stop =>
Put_Line (Output, " <columns>");
Put_Line (Output, Indent & Indent
& "Place tab stops at each multiple of given length");
when Options.Token =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Output atoms as standard tokens when possible");
when Options.Unix_Newline =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Use UNIX newlines (LF)");
when Options.UTF_8 =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Assume UTF-8 encoding of output");
when Options.Verbatim =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Output atoms using verbatim encoding");
when Options.Width =>
Put_Line (Output, " <columns>");
Put_Line (Output, Indent & Indent
& "Maximum width of output (0 to disable width limit)");
when Options.Upper_Hex =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Output atoms using upper-case hexadecimal encoding");
when Options.Lower_Hex =>
New_Line (Output);
Put_Line (Output, Indent & Indent
& "Output atoms using lower-case hexadecimal encoding");
end case;
end loop;
end Print_Help;
procedure Read
(Stream : in out Base64_Stream;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset) is
begin
Stream.Backend.Read (Item, Last);
end Read;
procedure Write
(Stream : in out Base64_Stream;
Item : in Ada.Streams.Stream_Element_Array)
is
use type Ada.Streams.Stream_Element_Offset;
I : Ada.Streams.Stream_Element_Offset := Item'First;
begin
while Stream.Cursor in Stream.Buffer'Range loop
if I not in Item'Range then
return;
end if;
Stream.Buffer (Stream.Cursor) := Item (I);
Stream.Cursor := Stream.Cursor + 1;
I := I + 1;
end loop;
loop
Stream.Backend.Write (SE.Encodings.Encode_Base64
(Stream.Buffer));
exit when I + Stream.Buffer'Length - 1 not in Item'Range;
Stream.Buffer := Item (I .. I + Stream.Buffer'Length - 1);
I := I + Stream.Buffer'Length;
end loop;
Stream.Cursor := Stream.Buffer'First;
while I in Item'Range loop
Stream.Buffer (Stream.Cursor) := Item (I);
Stream.Cursor := Stream.Cursor + 1;
I := I + 1;
end loop;
end Write;
procedure Open (Stream : in out Base64_Stream'Class) is
begin
Stream.Backend.Write
((1 => SE.Encodings.Base64_Expr_Begin));
end Open;
procedure Close (Stream : in out Base64_Stream'Class) is
use type Ada.Streams.Stream_Element_Offset;
begin
if Stream.Cursor > Stream.Buffer'First then
Stream.Backend.Write (SE.Encodings.Encode_Base64
(Stream.Buffer (Stream.Buffer'First .. Stream.Cursor - 1)));
end if;
Stream.Backend.Write
((1 => SE.Encodings.Base64_Expr_End));
end Close;
Opt_Config : constant Getopt.Configuration := Getopt_Config;
Handler : Callback;
begin
Opt_Config.Process (Handler);
case Handler.Action is
when Options.Error =>
Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
Print_Help (Opt_Config, Ada.Text_IO.Current_Error);
when Options.Print_Help =>
Print_Help (Opt_Config, Ada.Text_IO.Current_Output);
when Options.Print_Config =>
Printer_Direct.Set_Parameters (Param);
SE.Printers.Pretty.Config.Print (Printer_Direct, To_Print);
when Options.Run .. Options.Print_Atom_List =>
if Handler.Arg_Count = 0 then
Handler.Argument ("-");
end if;
if Options."=" (Handler.Action, Options.Run_Base64) then
Close (Base64_Output);
elsif Options."=" (Handler.Action, Options.Print_Atom_List) then
if First_Atom_In_List then
Printer_Direct.Open_List;
end if;
Printer_Direct.Close_List;
end if;
end case;
end Sxcat;