excel_writer_17.0.1_acea6a01/excel_out.adb

-- Version 01 is derived from ExcelOut by Frank Schoonjans in Modula-2 - thanks!
-- Modula-2 code has been translated with Mod2Pas and P2Ada.
--
-- References to documentation are to: http://www.openoffice.org/sc/excelfileformat.pdf
--
-- To do:
-- =====
--  - Unicode (for binary Excel: requires BIFF8, but BIFF8 is pretty difficult)
--  - border line styles (5.115 XF - Extended Format)
--  - XML-based formats support
--  - ...

with Ada.Unchecked_Deallocation, Ada.Unchecked_Conversion;
with Ada.Strings.Fixed;

with Interfaces;                        use Interfaces;

-- Package IEEE_754 is from: Simple components for Ada by Dmitry A. Kazakov
-- http://www.dmitry-kazakov.de/ada/components.htm
with IEEE_754.Generic_Double_Precision;

package body Excel_Out is

  use Ada.Streams.Stream_IO, Ada.Streams;

  --  Very low level part which deals with transferring data in an endian-neutral way,
  --  and floats in the IEEE format. This is needed for having Excel Writer
  --  totally portable on all systems and processor architectures.

  type Byte_buffer is array (Integer range <>) of Unsigned_8;
  empty_buffer : constant Byte_buffer := (1 .. 0 => 0);

  -- Put numbers with correct endianess as bytes:
  generic
    type Number is mod <>;
    size : Positive;
  function Intel_x86_buffer (n : Number) return Byte_buffer;
  pragma Inline (Intel_x86_buffer);

  function Intel_x86_buffer (n : Number) return Byte_buffer is
    b : Byte_buffer (1 .. size);
    m : Number := n;
  begin
    for i in b'Range loop
      b (i) := Unsigned_8 (m and 255);
      m := m / 256;
    end loop;
    return b;
  end Intel_x86_buffer;

  function Intel_32 is new Intel_x86_buffer (Unsigned_32, 4);

  function Intel_16 (n : Unsigned_16) return Byte_buffer is
    pragma Inline (Intel_16);
  begin
    return (Unsigned_8 (n and 255), Unsigned_8 (Shift_Right (n, 8)));
  end Intel_16;

  --  2.5.2 Byte Strings, 8-bit string length (BIFF2-BIFF5), p. 187
  function To_buf_8_bit_length (s : String) return Byte_buffer is
    b : Byte_buffer (s'Range);
  begin
    if s'Length > 255 then -- length doesn't fit in a byte
      raise Constraint_Error;
    end if;
    for i in b'Range loop
      b (i) := Character'Pos (s (i));
    end loop;
    return Unsigned_8 (s'Length) & b;
  end To_buf_8_bit_length;

  --  2.5.2 Byte Strings, 16-bit string length (BIFF2-BIFF5), p. 187
  function To_buf_16_bit_length (s : String) return Byte_buffer is
    b : Byte_buffer (s'Range);
  begin
    if s'Length > 2**16 - 1 then -- length doesn't fit in a 16-bit number
      raise Constraint_Error;
    end if;
    for i in b'Range loop
      b (i) := Character'Pos (s (i));
    end loop;
    return Intel_16 (s'Length) & b;
  end To_buf_16_bit_length;

  --  --  2.5.3 Unicode Strings, 16-bit string length (BIFF2-BIFF5), p. 17
  --  function To_buf_16_bit_length(s: Wide_String) return Byte_buffer is
  --    b: Byte_buffer(1 .. 2 * s'Length);
  --    j: Integer:= 1;
  --  begin
  --    if s'Length > 2**16-1 then -- length doesn't fit in a 16-bit number
  --      raise Constraint_Error;
  --    end if;
  --    for i in s'Range loop
  --      b(j)  := Unsigned_8(Unsigned_32'(Wide_Character'Pos(s(i))) and 255);
  --      b(j+1):= Unsigned_8(Shift_Right(Unsigned_32'(Wide_Character'Pos(s(i))), 8));
  --      j:= j + 2;
  --    end loop;
  --    return
  --      Intel_16(s'Length) &
  --      (1 => 1) &  --  Character compression (ccompr): 1 = Uncompressed (16-bit characters)
  --      b;
  --  end To_buf_16_bit_length;

  -- Gives a byte sequence of an IEEE 64-bit number as if taken
  -- from an Intel machine (i.e. with the same endianess).
  --
  -- http://en.wikipedia.org/wiki/IEEE_754-1985#Double-precision_64_bit
  --

   package IEEE_LF is new IEEE_754.Generic_Double_Precision (Long_Float);

  function IEEE_Double_Intel_Portable (x : Long_Float) return Byte_buffer is
    pragma Inline (IEEE_Double_Intel_Portable);
    d : Byte_buffer (1 .. 8);
    --
    f64 : constant IEEE_LF.Float_64 := IEEE_LF.To_IEEE (x);
  begin
    for i in d'Range loop
      d (i) := f64 (9 - i); -- Order is reversed
    end loop;
    -- Fully tested in Test_IEEE.adb
    return d;
  end IEEE_Double_Intel_Portable;

  -- Just spit the bytes of the long float - fast way.
  -- Of course this will work only on an Intel(-like) machine. We check this later.
  subtype Byte_buffer_8 is Byte_buffer (0 .. 7);
  function IEEE_Double_Intel_Native is new
    Ada.Unchecked_Conversion (Long_Float, Byte_buffer_8);

  x_test : constant Long_Float := -12345.0e-67;
  Can_use_native_IEEE : constant Boolean :=
    IEEE_Double_Intel_Portable (x_test) = IEEE_Double_Intel_Native (x_test);

  function IEEE_Double_Intel (x : Long_Float) return Byte_buffer is
    pragma Inline (IEEE_Double_Intel);
  begin
    if Can_use_native_IEEE then
      return IEEE_Double_Intel_Native (x);   -- Fast, non-portable
    else
      return IEEE_Double_Intel_Portable (x); -- Slower but portable
    end if;
  end IEEE_Double_Intel;

  -- Workaround for the severe xxx'Read xxx'Write performance
  -- problems in the GNAT and ObjectAda compilers (as in 2009)
  -- This is possible if and only if Byte = Stream_Element and
  -- arrays types are both packed and aligned the same way.
  --
  subtype Size_test_a is Byte_buffer (1 .. 19);
  subtype Size_test_b is Ada.Streams.Stream_Element_Array (1 .. 19);
  workaround_possible : constant Boolean :=
    Size_test_a'Size = Size_test_b'Size and
    Size_test_a'Alignment = Size_test_b'Alignment;

  procedure Block_Write (
    stream : in out Ada.Streams.Root_Stream_Type'Class;
    buffer : in     Byte_buffer
  )
  is
    pragma Inline (Block_Write);
    SE_Buffer   : Stream_Element_Array (1 .. buffer'Length);
    for SE_Buffer'Address use buffer'Address;
    pragma Import (Ada, SE_Buffer);
  begin
    if workaround_possible then
      Ada.Streams.Write (stream, SE_Buffer);
    else
      Byte_buffer'Write (stream'Access, buffer);
      -- ^ This was 30x to 70x slower on GNAT 2009
      --   Test in the Zip-Ada project.
    end if;
  end Block_Write;

  ----------------
  -- Excel BIFF --
  ----------------

  -- The original Modula-2 code counted on certain assumptions about
  -- record packing & endianess. We write data without these assumptions.

  procedure WriteBiff (
    xl     : Excel_Out_Stream'Class;
    biff_id : Unsigned_16;
    data   : Byte_buffer
  )
  is
    pragma Inline (WriteBiff);
  begin
    Block_Write (xl.xl_stream.all, Intel_16 (biff_id));
    Block_Write (xl.xl_stream.all, Intel_16 (Unsigned_16 (data'Length)));
    Block_Write (xl.xl_stream.all, data);
  end WriteBiff;

  -- 5.8  BOF: Beginning of File, p.135
  procedure Write_BOF (xl : Excel_Out_Stream'Class) is

    function BOF_suffix return Byte_buffer is  --  5.8.1 Record BOF
    begin
      case xl.format is
        when BIFF2 =>
          return empty_buffer;
        when BIFF3 | BIFF4 =>
          return (0, 0);  --  Not used
        --  when BIFF8 =>
        --    return (1,1,1,1);
      end case;
    end BOF_suffix;

    --  0005H = Workbook globals
    --  0006H = Visual Basic module
    --  0010H = Sheet or dialogue (see SHEETPR, S5.97)
    Sheet_or_dialogue : constant := 16#10#;
    --  0020H = Chart
    --  0040H = Macro sheet
    biff_record_identifier : constant array (Excel_type) of Unsigned_16 :=
      (BIFF2 => 16#0009#,
       BIFF3 => 16#0209#,
       BIFF4 => 16#0409#
       --  BIFF8 => 16#0809#
      );
    biff_version : constant array (Excel_type) of Unsigned_16 :=
      (BIFF2 => 16#0200#,
       BIFF3 => 16#0300#,
       BIFF4 => 16#0400#
       --  BIFF8 => 16#0600#
      );
  begin
    WriteBiff (xl,
      biff_record_identifier (xl.format),
      Intel_16 (biff_version (xl.format)) &
      Intel_16 (Sheet_or_dialogue) &
      BOF_suffix
    );
  end Write_BOF;

  -- 5.49 FORMAT (number format)
  procedure WriteFmtStr (xl : Excel_Out_Stream'Class; s : String) is
  begin
    case xl.format is
      when BIFF2 | BIFF3 =>
        WriteBiff (xl, 16#001E#, To_buf_8_bit_length (s));
      when BIFF4 =>
        WriteBiff (xl, 16#041E#, (0, 0) & To_buf_8_bit_length (s));
     --   when BIFF8 =>
     --     WriteBiff(xl, 16#041E#, (0, 0) &  --  should be: format index used in other records
     --       To_buf_8_bit_length(s));
    end case;
  end WriteFmtStr;

  -- Write built-in number formats (internal)
  procedure WriteFmtRecords (xl : Excel_Out_Stream'Class) is
    sep_1000 : constant Character := ','; -- US format
    sep_deci : constant Character := '.'; -- US format
    -- ^ If there is any evidence of an issue with those built-in separators,
    -- we may make them configurable. NB: MS Excel 2002 and 2007 use only
    -- the index of built-in formats and discards the strings for BIFF2, but not for BIFF3...
  begin
    -- 5.12 BUILTINFMTCOUNT
    case xl.format is
      when BIFF2 =>
        WriteBiff (xl, 16#001F#, Intel_16 (Unsigned_16 (last_built_in - 5)));
      when BIFF3 =>
        WriteBiff (xl, 16#0056#, Intel_16 (Unsigned_16 (last_built_in - 3)));
      when BIFF4 =>
        WriteBiff (xl, 16#0056#, Intel_16 (Unsigned_16 (last_built_in + 1)));
      --  when BIFF8 =>
      --    null;
    end case;
    -- loop & case avoid omitting any choice
    for n in Number_format_type'First .. last_custom loop
      case n is
        when general    =>  WriteFmtStr (xl, "General");
        when decimal_0  =>  WriteFmtStr (xl, "0");
        when decimal_2  =>  WriteFmtStr (xl, "0" & sep_deci & "00"); -- 'Comma' built-in style
        when decimal_0_thousands_separator =>
          WriteFmtStr (xl, "#" & sep_1000 & "##0");
        when decimal_2_thousands_separator =>
          WriteFmtStr (xl, "#" & sep_1000 & "##0" & sep_deci & "00");
        when no_currency_0       =>
          if xl.format >= BIFF4 then
            WriteFmtStr (xl, "#" & sep_1000 & "##0;-#" & sep_1000 & "##0");
          end if;
        when no_currency_red_0   =>
          if xl.format >= BIFF4 then
            WriteFmtStr (xl, "#" & sep_1000 & "##0;-#" & sep_1000 & "##0");
          -- [Red] doesn't go with non-English versions of Excel !!
          end if;
        when no_currency_2       =>
          if xl.format >= BIFF4 then
            WriteFmtStr (xl,  "#" & sep_1000 & "##0" & sep_deci & "00;" &
                          "-#" & sep_1000 & "##0" & sep_deci & "00");
          end if;
        when no_currency_red_2   =>
          if xl.format >= BIFF4 then
            WriteFmtStr (xl,  "#" & sep_1000 & "##0" & sep_deci & "00;" &
                          "-#" & sep_1000 & "##0" & sep_deci & "00");
          end if;
        when currency_0       =>
          WriteFmtStr (xl, "$ #" & sep_1000 & "##0;$ -#" & sep_1000 & "##0");
        when currency_red_0   =>
          WriteFmtStr (xl, "$ #" & sep_1000 & "##0;$ -#" & sep_1000 & "##0");
          -- [Red] doesn't go with non-English versions of Excel !!
        when currency_2       =>
          WriteFmtStr (xl,  "$ #" & sep_1000 & "##0" & sep_deci & "00;" &
                          "$ -#" & sep_1000 & "##0" & sep_deci & "00");
        when currency_red_2   =>
          WriteFmtStr (xl,  "$ #" & sep_1000 & "##0" & sep_deci & "00;" &
                          "$ -#" & sep_1000 & "##0" & sep_deci & "00");
        when percent_0        =>  WriteFmtStr (xl, "0%");   -- 'Percent' built-in style
        when percent_2        =>  WriteFmtStr (xl, "0" & sep_deci & "00%");
        when scientific       =>  WriteFmtStr (xl, "0" & sep_deci & "00E+00");
        when fraction_1       =>
          if xl.format >= BIFF3 then
            WriteFmtStr (xl, "#\ ?/?");
          end if;
        when fraction_2       =>
          if xl.format >= BIFF3 then
            WriteFmtStr (xl, "#\ ??/??");
          end if;
        when dd_mm_yyyy       =>  WriteFmtStr (xl, "dd/mm/yyyy");
        when dd_mmm_yy        =>  WriteFmtStr (xl, "dd/mmm/yy");
        when dd_mmm           =>  WriteFmtStr (xl, "dd/mmm");
        when mmm_yy           =>  WriteFmtStr (xl, "mmm/yy");
        when h_mm_AM_PM       =>  WriteFmtStr (xl, "h:mm\ AM/PM");
        when h_mm_ss_AM_PM    =>  WriteFmtStr (xl, "h:mm:ss\ AM/PM");
        when hh_mm            =>  WriteFmtStr (xl, "hh:mm");
        when hh_mm_ss         =>  WriteFmtStr (xl, "hh:mm:ss");
        when dd_mm_yyyy_hh_mm =>  WriteFmtStr (xl, "dd/mm/yyyy\ hh:mm");
        when percent_0_plus  =>
          WriteFmtStr (xl, "+0%;-0%;0%");
        when percent_2_plus  =>
          WriteFmtStr (xl, "+0" & sep_deci & "00%;-0" & sep_deci & "00%;0" & sep_deci & "00%");
        when date_iso        => WriteFmtStr (xl, "yyyy\-mm\-dd");
        when date_h_m_iso    => WriteFmtStr (xl, "yyyy\-mm\-dd\ hh:mm");
        when date_h_m_s_iso  => WriteFmtStr (xl, "yyyy\-mm\-dd\ hh:mm:ss");
          -- !! Trouble: Excel (German Excel/French locale) writes yyyy, reads it,
          --    understands it and translates it into aaaa, but is unable to
          --    understand *our* yyyy
          -- Same issue as [Red] vs [Rot] above.
      end case;
    end loop;
    -- ^ Some formats in the original list caused problems, probably
    --   because of regional placeholder symbols
    case xl.format is
      when BIFF2 =>
        for i in 1 .. 6 loop
          WriteFmtStr (xl, "@");
        end loop;
      when BIFF3 =>
        for i in 1 .. 4 loop
          WriteFmtStr (xl, "@");
        end loop;
      when BIFF4 =>
        null;
    end case;
    -- ^ Stuffing for having the same number of built-in and EW custom
  end WriteFmtRecords;

  -- 5.35 DIMENSION
  procedure Write_Dimensions (xl : Excel_Out_Stream'Class) is
    -- sheet bounds:   0 2 Index to first used row
    --                 2 2 Index to last used row, increased by 1
    --                 4 2 Index to first used column
    --                 6 2 Index to last used column, increased by 1
    --
    -- Since our row / column counts are 1-based, no need to increase by 1.
    sheet_bounds : constant Byte_buffer :=
      Intel_16 (0) &
      Intel_16 (Unsigned_16 (xl.maxrow)) &
      Intel_16 (0) &
      Intel_16 (Unsigned_16 (xl.maxcolumn));
    --  sheet_bounds_32_16: constant Byte_buffer:=
    --    Intel_32(0) &
    --    Intel_32(Unsigned_32(xl.maxrow)) &
    --    Intel_16(0) &
    --    Intel_16(Unsigned_16(xl.maxcolumn));
  begin
    case xl.format is
      when BIFF2 =>
        WriteBiff (xl, 16#0000#, sheet_bounds);
      when BIFF3 | BIFF4 =>
        WriteBiff (xl, 16#0200#, sheet_bounds & (0, 0));
      --  when BIFF8 =>
      --    WriteBiff(xl, 16#0200#, sheet_bounds_32_16 & (0,0));
    end case;
  end Write_Dimensions;

  procedure Define_number_format (
    xl           : in out Excel_Out_Stream;
    format       :    out Number_format_type;
    format_string : in     String
  )
  is
  begin
    xl.number_fmt := xl.number_fmt + 1;
    format := xl.number_fmt;
    WriteFmtStr (xl, format_string);
  end Define_number_format;

  procedure Write_Worksheet_header (xl : in out Excel_Out_Stream'Class) is

    procedure Define_style (fmt : Format_type; style_id : Unsigned_8) is
      Base_Level : constant := 255;
    begin
      WriteBiff (xl,
        16#0293#,
        Intel_16 (Unsigned_16 (fmt) + 16#8000#) & style_id & Base_Level
      );
    end Define_style;
    --
    Comma_Style     : constant := 3;
    Currency_Style  : constant := 4;
    Percent_Style   : constant := 5;
    font_for_styles, font_2, font_3 : Font_type;
    --
    function Encoding_code return Unsigned_16 is  --  5.17 CODEPAGE, p. 145
    begin
      case xl.encoding is
        when Windows_CP_874  => return 874;
        when Windows_CP_932  => return 932;
        when Windows_CP_936  => return 936;
        when Windows_CP_949  => return 949;
        when Windows_CP_950  => return 950;
        when Windows_CP_1250 => return 1250;
        when Windows_CP_1251 => return 1251;
        when Windows_CP_1252 =>
          case xl.format is
            when BIFF2 .. BIFF3 =>
              return 16#8001#;
            when BIFF4 =>
              return 1252;
          end case;
        when Windows_CP_1253 => return 1253;
        when Windows_CP_1254 => return 1254;
        when Windows_CP_1255 => return 1255;
        when Windows_CP_1256 => return 1256;
        when Windows_CP_1257 => return 1257;
        when Windows_CP_1258 => return 1258;
        when Windows_CP_1361 => return 1361;
        when Apple_Roman     => return 10000;
      end case;
    end Encoding_code;
    --
  begin
    Write_BOF (xl);
    --  5.17 CODEPAGE, p. 145
    case xl.format is
      --  when BIFF8 =>   --  UTF-16
      --    WriteBiff(xl, 16#0042#, Intel_16(16#04B0#));
      when others =>
        WriteBiff (xl, 16#0042#, Intel_16 (Encoding_code));
    end case;
    -- 5.14 CALCMODE
    WriteBiff (xl, 16#000D#, Intel_16 (1)); --  1 => automatic
    -- 5.85 REFMODE
    WriteBiff (xl, 16#000F#, Intel_16 (1)); --  1 => A1 mode
    -- 5.28 DATEMODE
    WriteBiff (xl, 16#0022#, Intel_16 (0)); --  0 => 1900; 1 => 1904 Date system
    -- NB: the 1904 variant (Mac) is ignored by LibreOffice (<= 3.5), then wrong dates !
    --
    Define_font (xl, "Arial",   10, xl.def_font);
    Define_font (xl, "Arial",   10, font_for_styles); -- Used by BIFF3+'s styles
    Define_font (xl, "Calibri", 10, font_2); -- Defined in BIFF3 files written by Excel 2002
    Define_font (xl, "Calibri", 10, font_3); -- Defined in BIFF3 files written by Excel 2002
    WriteFmtRecords (xl);
    -- 5.111 WINDOWPROTECT
    WriteBiff (xl, 16#0019#, Intel_16 (0));
    -- Define default format
    Define_format (xl, xl.def_font, general, xl.def_fmt);
    if xl.format >= BIFF3 then
      -- Don't ask why we need the following useless formats, but it is as Excel 2002
      -- write formats. Additionally, the default format is turned into decimal_2
      -- when a file without those useless formats is opened in Excel (2002) !
      Define_format (xl, font_for_styles, general, xl.def_fmt);
      Define_format (xl, font_for_styles, general, xl.def_fmt);
      Define_format (xl, font_2, general, xl.def_fmt);
      Define_format (xl, font_2, general, xl.def_fmt);
      for i in 5 .. 15 loop
        Define_format (xl, xl.def_font, general, xl.def_fmt);
      end loop;
      -- Final default format index is the last changed xl.def_fmt
    end if;
    Use_default_format (xl);
    -- Define formats for the BIFF3+ "styles":
    Define_format (xl, font_for_styles, decimal_2, xl.cma_fmt);
    Define_format (xl, font_for_styles, currency_0, xl.ccy_fmt);
    Define_format (xl, font_for_styles, percent_0, xl.pct_fmt);
    -- Define styles - 5.103 STYLE p. 212
    -- NB: - it is BIFF3+ (we cheat a bit if selected format is BIFF2).
    --     - these "styles" seem to be a zombie feature of Excel 3
    --     - the whole purpose of including this is because format
    --       buttons (%)(,) in Excel 95 through 2007 are using these styles;
    --       if the styles are not defined, those buttons are not working
    --       when an Excel Writer sheet is open in MS Excel.
    Define_style (xl.cma_fmt, Comma_Style);
    Define_style (xl.ccy_fmt, Currency_Style);
    Define_style (xl.pct_fmt, Percent_Style);
    xl.dimrecpos := Index (xl);
    Write_Dimensions (xl);
    xl.is_created := True;
  end Write_Worksheet_header;

  type Font_or_Background is (for_font, for_background);
  type Color_pair is array (Font_or_Background) of Unsigned_16;
  auto_color : constant Color_pair :=
    (16#7FFF#, -- system window text colour
     16#0019#  -- system window background colour
    );

  color_code : constant array (Excel_type, Color_type) of Color_pair :=
    (BIFF2 =>
       (
         black      => (0, 0),
         white      => (1, 1),
         red        => (2, 2),
         green      => (3, 3),
         blue       => (4, 4),
         yellow     => (5, 5),
         magenta    => (6, 6),
         cyan       => (7, 7),
         others     => auto_color
        ),
      BIFF3 | BIFF4 =>
        (black      => (8, 8),
         white      => (9, 9),
         red        => (10, 10),
         green      => (11, 11),
         blue       => (12, 12),
         yellow     => (13, 13),
         magenta    => (14, 14),
         cyan       => (15, 15),
         dark_red   => (16, 16),
         dark_green => (17, 17),
         dark_blue  => (18, 18),
         olive      => (19, 19),
         purple     => (20, 20),
         teal       => (21, 21),
         silver     => (22, 22),
         grey       => (23, 23),
         automatic  => auto_color
        )
     );

  -- *** Exported procedures **********************************************

  -- 5.115 XF - Extended Format
  procedure Define_format (
    xl               : in out Excel_Out_Stream;
    font             : in     Font_type;          -- Default_font(xl), or given by Define_font
    number_format    : in     Number_format_type; -- built-in, or given by Define_number_format
    cell_format      :    out Format_type;
    -- Optional parameters --
    horizontal_align : in     Horizontal_alignment := general_alignment;
    border           : in     Cell_border := no_border;
    shaded           : in     Boolean := False;    -- Add a dotted background pattern
    background_color : in     Color_type := automatic;
    wrap_text        : in     Boolean := False;
    vertical_align   : in     Vertical_alignment := bottom_alignment;
    text_orient      : in     Text_orientation := normal
  )
  is
    actual_number_format : Number_format_type := number_format;
    cell_is_locked : constant := 1;
    -- ^ Means actually: cell formula protection is possible, and enabled when sheet is protected.
    procedure Define_BIFF2_XF is
      border_bits, mask : Unsigned_8;
    begin
      border_bits := 0;
      mask := 8;
      for s in Cell_border_single loop
        if border (s) then
          border_bits := border_bits + mask;
        end if;
        mask := mask * 2;
      end loop;
      -- 5.115.2 XF Record Contents, p. 221 for BIFF3
      WriteBiff (
        xl,
        16#0043#, -- XF code in BIFF2
        (Unsigned_8 (font),
         -- ^ Index to FONT record
         0,
         -- ^ Not used
         Number_format_type'Pos (actual_number_format) + 16#40# * cell_is_locked,
         -- ^ Number format and cell flags
         Horizontal_alignment'Pos (horizontal_align) +
         border_bits +
         Boolean'Pos (shaded) * 128
         -- ^ Horizontal alignment, border style, and background
        )
      );
    end Define_BIFF2_XF;

    area_code : Unsigned_16;

    procedure Define_BIFF3_XF is
    begin
      -- 5.115.2 XF Record Contents, p. 221 for BIFF3
      WriteBiff (
        xl,
        16#0243#, -- XF code in BIFF3
        (Unsigned_8 (font),
         -- ^ 0 - Index to FONT record
         Number_format_type'Pos (actual_number_format),
         -- ^ 1 - Number format and cell flags
         cell_is_locked,
         -- ^ 2 - XF_TYPE_PROT (5.115.1)
         16#FF#
         -- ^ 3 - XF_USED_ATTRIB
        ) &
        Intel_16 (
          Horizontal_alignment'Pos (horizontal_align) +
          Boolean'Pos (wrap_text) * 8
        ) &
        -- ^ 4 - Horizontal alignment, text break, parent style XF
        Intel_16 (area_code) &
        -- ^ 6 - XF_AREA_34
        (Boolean'Pos (border (top_single)),
           Boolean'Pos (border (left_single)),
           Boolean'Pos (border (bottom_single)),
           Boolean'Pos (border (right_single))
        )
        -- ^ 8 - XF_BORDER_34 - thin (=1) line; we could have other line styles:
        --       Thin, Medium, Dashed, Dotted, Thick, Double, Hair
      );
    end Define_BIFF3_XF;

    procedure Define_BIFF4_XF is
    begin
      -- 5.115.2 XF Record Contents, p. 222 for BIFF4
      WriteBiff (
        xl,
        16#0443#, -- XF code in BIFF4
        (Unsigned_8 (font),
         -- ^ 0 - Index to FONT record
         Number_format_type'Pos (actual_number_format),
         -- ^ 1 - Number format and cell flags
         cell_is_locked, 0,
         -- ^ 2 - XF type, cell protection, and parent style XF
         Horizontal_alignment'Pos (horizontal_align) +
         Boolean'Pos (wrap_text) * 8 +
         (Vertical_alignment'Pos (vertical_align) and 3) * 16 +
         Text_orientation'Pos (text_orient) * 64,
         -- ^ 4 - Alignment (hor & ver), text break, and text orientation
         16#FF#
         -- ^ 3 - XF_USED_ATTRIB
        ) &
        -- ^ 4 - Horizontal alignment, text break, parent style XF
        Intel_16 (area_code) &
        -- ^ 6 - XF_AREA_34
        (Boolean'Pos (border (top_single)),
           Boolean'Pos (border (left_single)),
           Boolean'Pos (border (bottom_single)),
           Boolean'Pos (border (right_single))
        )
        -- ^ 8 - XF_BORDER_34 - thin (=1) line; we could have other line styles:
        --       Thin, Medium, Dashed, Dotted, Thick, Double, Hair
      );
    end Define_BIFF4_XF;

  begin
    -- 2.5.12 Patterns for Cell and Chart Background Area
    -- This is for BIFF3+
    if shaded then
      area_code :=
        Boolean'Pos (shaded) * 17 +                        -- Sparse pattern, like BIFF2 "shade"
        16#40#  * color_code (BIFF3, black)(for_background) +           -- pattern colour
        16#800# * color_code (BIFF3, background_color)(for_background); -- pattern background
    elsif background_color = automatic then
      area_code := 0;
    else
      area_code :=
        1 +                                                          -- Full pattern
        16#40#  * color_code (BIFF3, background_color)(for_background) +  -- pattern colour
        16#800# * color_code (BIFF3, background_color)(for_background);   -- pattern background
    end if;
    case xl.format is
      when BIFF2 =>
        case actual_number_format is
          when general .. no_currency_2 =>
            null;
          when currency_0 .. fraction_2 =>
            actual_number_format := actual_number_format - 4;
          when dd_mm_yyyy .. last_custom =>
            actual_number_format := actual_number_format - 6;
          when others =>
            null;
        end case;
        Define_BIFF2_XF;
      when BIFF3 =>
        if actual_number_format in currency_0 .. last_custom then
          actual_number_format := actual_number_format - 4;
        end if;
        Define_BIFF3_XF;
      when BIFF4 =>
        Define_BIFF4_XF;
      --  when BIFF8 =>
      --    Define_BIFF8_XF;  --  BIFF8: 16#00E0#, p. 224
    end case;
    xl.xfs := xl.xfs + 1;
    cell_format := Format_type (xl.xfs);
    xl.xf_def (xl.xfs) := (font => font, numb => number_format);
  end Define_format;

  procedure Header (xl : Excel_Out_Stream; page_header_string : String) is
  begin
    WriteBiff (xl, 16#0014#, To_buf_8_bit_length (page_header_string)); -- 5.55 p.180
  end Header;

  procedure Footer (xl : Excel_Out_Stream; page_footer_string : String) is
  begin
    WriteBiff (xl, 16#0015#, To_buf_8_bit_length (page_footer_string)); -- 5.48 p.173
  end Footer;

  procedure Left_Margin (xl : Excel_Out_Stream; inches : Long_Float) is
  begin
    WriteBiff (xl, 16#0026#, IEEE_Double_Intel (inches));
  end Left_Margin;

  procedure Right_Margin (xl : Excel_Out_Stream; inches : Long_Float) is
  begin
    WriteBiff (xl, 16#0027#, IEEE_Double_Intel (inches));
  end Right_Margin;

  procedure Top_Margin (xl : Excel_Out_Stream; inches : Long_Float) is
  begin
    WriteBiff (xl, 16#0028#, IEEE_Double_Intel (inches));
  end Top_Margin;

  procedure Bottom_Margin (xl : Excel_Out_Stream; inches : Long_Float) is
  begin
    WriteBiff (xl, 16#0029#, IEEE_Double_Intel (inches));
  end Bottom_Margin;

  procedure Margins (xl : Excel_Out_Stream; left, right, top, bottom : Long_Float) is
  begin
    Left_Margin (xl, left);
    Right_Margin (xl, right);
    Top_Margin (xl, top);
    Bottom_Margin (xl, bottom);
  end Margins;

  procedure Print_Row_Column_Headers (xl : Excel_Out_Stream) is
  begin
    WriteBiff (xl, 16#002A#, Intel_16 (1)); -- 5.81 PRINTHEADERS p.199
  end  Print_Row_Column_Headers;

  procedure Print_Gridlines (xl : Excel_Out_Stream) is
  begin
    WriteBiff (xl, 16#002B#, Intel_16 (1)); -- 5.80 PRINTGRIDLINES p.199
  end Print_Gridlines;

  procedure Page_Setup (
    xl                     : Excel_Out_Stream;
    scaling_percents       : Positive := 100;
    fit_width_with_n_pages : Natural := 1; -- 0: as many as possible
    fit_height_with_n_pages : Natural := 1; -- 0: as many as possible
    orientation            : Orientation_choice := portrait;
    scale_or_fit           : Scale_or_fit_choice := scale
  )
  is
  begin
    -- 5.73 PAGESETUP p.192 - this is BIFF4+ (cheat if xl.format below)!
    WriteBiff (xl,
      16#00A1#,
      Intel_16 (0) & -- paper type undefined
      Intel_16 (Unsigned_16 (scaling_percents)) &
      Intel_16 (1) & -- start page number
      Intel_16 (Unsigned_16 (fit_width_with_n_pages)) &
      Intel_16 (Unsigned_16 (fit_height_with_n_pages)) &
      Intel_16 (2 * Orientation_choice'Pos (orientation))
    );
    -- 5.97 SHEETPR p.207 - this is BIFF3+ (cheat if xl.format below) !
    -- NB: this field contains other informations, should be delayed
    --       in case other preferences are to be set
    WriteBiff (xl,
      16#0081#,
      Intel_16 (256 * Scale_or_fit_choice'Pos (scale_or_fit))
    );
  end Page_Setup;

  y_scale : constant := 20; -- scaling to obtain character point (pt) units

  -- 5.31 DEFAULTROWHEIGHT
  procedure Write_default_row_height (
        xl     : Excel_Out_Stream;
        height : Positive
  )
  is
    default_twips : constant Byte_buffer := Intel_16 (Unsigned_16 (height * y_scale));
    options_flags : constant Byte_buffer := (1, 0);
    -- 1 = Row height and default font height do not match
  begin
    case xl.format is
      when BIFF2 =>
        WriteBiff (xl, 16#0025#, default_twips);
      when BIFF3 | BIFF4 =>
        WriteBiff (xl, 16#0225#, options_flags & default_twips);
    end case;
  end Write_default_row_height;

  -- 5.32 DEFCOLWIDTH
  procedure Write_default_column_width (
        xl : in out Excel_Out_Stream;
        width  : Positive)
  is
  begin
    WriteBiff (xl, 16#0055#, Intel_16 (Unsigned_16 (width)));
    xl.defcolwdth := 256 * width;
  end Write_default_column_width;

  procedure Write_column_width (
        xl     : in out Excel_Out_Stream;
        column : Positive;
        width  : Natural)
  is
  begin
    Write_column_width (xl, column, column, width);
  end Write_column_width;

  procedure Write_column_width (
    xl            : in out Excel_Out_Stream;
    first_column,
    last_column   : Positive;
    width         : Natural
  )
  is
  begin
    case xl.format is
      when BIFF2 =>
        -- 5.20 COLWIDTH (BIFF2 only)
        WriteBiff (xl, 16#0024#,
          Unsigned_8 (first_column - 1) &
          Unsigned_8 (last_column - 1) &
          Intel_16 (Unsigned_16 (width * 256)));
      when BIFF3 | BIFF4 =>
        -- 5.18 COLINFO (BIFF3+)
        WriteBiff (xl, 16#007D#,
          Intel_16 (Unsigned_16 (first_column - 1)) &
          Intel_16 (Unsigned_16 (last_column - 1)) &
          Intel_16 (Unsigned_16 (width * 256)) &
          Intel_16 (0) & -- Index to XF record (5.115) for default column formatting
          Intel_16 (0) & -- Option flags
          (0, 0)         -- Not used
        );
        for j in first_column .. last_column loop
          xl.std_col_width (j) := False;
        end loop;
    end case;
  end Write_column_width;

  -- 5.88 ROW
  -- The OpenOffice documentation tells nice stories about row blocks,
  -- but single ROW commands can also be put before in the data stream,
  -- where the column widths are set. Excel saves with blocks of ROW
  -- commands, most of them useless.

  procedure Write_row_height (
    xl     : Excel_Out_Stream;
    row    : Positive;
    height : Natural
  )
  is
    row_info_base : Byte_buffer :=
      Intel_16 (Unsigned_16 (row - 1)) &
      Intel_16 (0)   & -- col. min.
      Intel_16 (255) & -- col. max.
      Intel_16 (Unsigned_16 (height * y_scale));
    fDyZero : Unsigned_8 := 0;
  begin
    case xl.format is
      when BIFF2 =>
        WriteBiff (xl, 16#0008#,
          row_info_base &
          (1 .. 3 => 0) &
          Intel_16 (0) -- offset to data
        );
      when BIFF3 | BIFF4 =>
        if height = 0 then -- proper hiding (needed with LibreOffice)
          fDyZero := 1;
          row_info_base (row_info_base'Last - 1 .. row_info_base'Last) :=
            Intel_16 (16#8000#);
        end if;
        WriteBiff (xl, 16#0208#,
          row_info_base &
          -- http://msdn.microsoft.com/en-us/library/dd906757(v=office.12).aspx
          (0, 0,  -- reserved1 (2 bytes): MUST be zero, and MUST be ignored.
           0, 0,  -- unused1 (2 bytes): Undefined and MUST be ignored.
           fDyZero *  32 +  -- D - fDyZero (1 bit): row is hidden
                 1 *  64 +  -- E - fUnsynced (1 bit): row height was manually set
                 0 * 128,   -- F - fGhostDirty (1 bit): the row was formatted
           1) &   -- reserved3 (1 byte): MUST be 1, and MUST be ignored
           Intel_16 (15)
           -- ^ ixfe_val, then 4 bits.
           --   If fGhostDirty is 0, ixfe_val is undefined and MUST be ignored.
        );
    end case;
  end Write_row_height;

  -- 5.45 FONT, p.171
  procedure Define_font (
    xl           : in out Excel_Out_Stream;
    font_name    :        String;
    height       :        Positive;
    font         :    out Font_type;
    style        :        Font_style := regular;
    color        :        Color_type := automatic
  )
  is
    style_bits, mask : Unsigned_16;
  begin
    style_bits := 0;
    mask := 1;
    for s in Font_style_single loop
      if style (s) then
        style_bits := style_bits + mask;
      end if;
      mask := mask * 2;
    end loop;
    xl.fonts := xl.fonts + 1;
    if xl.fonts = 4 then
      xl.fonts := 5;
      -- Anomaly! The font with index 4 is omitted in all BIFF versions.
      -- Numbering is 0, 1, 2, 3, *5*, 6,...
    end if;
    case xl.format is
      when BIFF2 =>
        WriteBiff (xl, 16#0031#,
          Intel_16 (Unsigned_16 (height * y_scale)) &
          Intel_16 (style_bits) &
          To_buf_8_bit_length (font_name)
        );
        if color /= automatic then
          -- 5.47 FONTCOLOR
          WriteBiff (xl, 16#0045#, Intel_16 (color_code (BIFF2, color)(for_font)));
        end if;
      when BIFF3 | BIFF4 =>  --  BIFF8 has 16#0031#, p. 171
        WriteBiff (xl, 16#0231#,
          Intel_16 (Unsigned_16 (height * y_scale)) &
          Intel_16 (style_bits) &
          Intel_16 (color_code (BIFF3, color)(for_font)) &
          To_buf_8_bit_length (font_name)
        );
    end case;
    font := Font_type (xl.fonts);
  end Define_font;

  procedure Jump_to_and_store_max (xl : in out Excel_Out_Stream; r, c : Integer) is
    pragma Inline (Jump_to_and_store_max);
  begin
    if not xl.is_created then
      raise Excel_stream_not_created;
    end if;
    Jump_to (xl, r, c); -- Store and check current position
    if r > xl.maxrow then
      xl.maxrow := r;
    end if;
    if c > xl.maxcolumn then
      xl.maxcolumn := c;
    end if;
  end Jump_to_and_store_max;

  -- 2.5.13 Cell Attributes (BIFF2 only)
  function Cell_attributes (xl : Excel_Out_Stream) return Byte_buffer is
  begin
    return
      (Unsigned_8 (xl.xf_in_use),
       Unsigned_8 (xl.xf_def (xl.xf_in_use).numb) + 16#40# *
       Unsigned_8 (xl.xf_def (xl.xf_in_use).font),
       0
      );
  end Cell_attributes;

  function Almost_zero (x : Long_Float) return Boolean is
  begin
    return abs x <= Long_Float'Model_Small;
  end Almost_zero;

  -- Internal
  --
  -- 5.71 NUMBER
  procedure Write_as_double (
        xl     : in out Excel_Out_Stream;
        r,
        c      : Positive;
        num    : Long_Float
  )
  is
    pragma Inline (Write_as_double);
  begin
    Jump_to_and_store_max (xl, r, c);
    case xl.format is
      when BIFF2 =>
        WriteBiff (xl, 16#0003#,
          Intel_16 (Unsigned_16 (r - 1)) &
          Intel_16 (Unsigned_16 (c - 1)) &
          Cell_attributes (xl) &
          IEEE_Double_Intel (num)
        );
      when BIFF3 | BIFF4 =>
        WriteBiff (xl, 16#0203#,
          Intel_16 (Unsigned_16 (r - 1)) &
          Intel_16 (Unsigned_16 (c - 1)) &
          Intel_16 (Unsigned_16 (xl.xf_in_use)) &
          IEEE_Double_Intel (num)
        );
    end case;
    Jump_to (xl, r, c + 1); -- Store and check new position
  end Write_as_double;

  -- Internal. This is BIFF2 only. BIFF format choice unchecked here.
  --
  procedure Write_as_16_bit_unsigned (
        xl : in out Excel_Out_Stream;
        r,
        c      : Positive;
        num    : Unsigned_16)
  is
    pragma Inline (Write_as_16_bit_unsigned);
  begin
    Jump_to_and_store_max (xl, r, c);
    -- 5.60 INTEGER
    WriteBiff (xl, 16#0002#,
      Intel_16 (Unsigned_16 (r - 1)) &
      Intel_16 (Unsigned_16 (c - 1)) &
      Cell_attributes (xl) &
      Intel_16 (num)
    );
    Jump_to (xl, r, c + 1); -- Store and check new position
  end Write_as_16_bit_unsigned;

  -- Internal. This is BIFF3+. BIFF format choice unchecked here.
  --
  procedure Write_as_30_bit_signed (
        xl : in out Excel_Out_Stream;
        r,
        c      : Positive;
        num    : Integer_32)
  is
    pragma Inline (Write_as_30_bit_signed);
    RK_val : Unsigned_32;
    RK_code : constant := 2; -- Code for signed integer. See 2.5.5 RK Values
  begin
    if num >= 0 then
      RK_val := Unsigned_32 (num) * 4 + RK_code;
    else
      RK_val := (-Unsigned_32 (-num)) * 4 + RK_code;
    end if;
    Jump_to_and_store_max (xl, r, c);
    -- 5.87 RK
    WriteBiff (xl, 16#027E#,
      Intel_16 (Unsigned_16 (r - 1)) &
      Intel_16 (Unsigned_16 (c - 1)) &
      Intel_16 (Unsigned_16 (xl.xf_in_use)) &
      Intel_32 (RK_val)
    );
    Jump_to (xl, r, c + 1); -- Store and check new position
  end Write_as_30_bit_signed;

  --
  -- Profile with floating-point number
  --
  procedure Write (
        xl     : in out Excel_Out_Stream;
        r,
        c      : Positive;
        num    : Long_Float
  )
  is
    max_16_u : constant := 2.0 ** 16 - 1.0;
    min_30_s : constant := -(2.0 ** 29);
    max_30_s : constant := 2.0 ** 29 - 1.0;
  begin
    case xl.format is
      when BIFF2 =>
        if num >= 0.0 and then
           num <= max_16_u and then
           Almost_zero (num - Long_Float'Floor (num))
        then
          Write_as_16_bit_unsigned (xl, r, c, Unsigned_16 (Long_Float'Floor (num)));
        else
          Write_as_double (xl, r, c, num);
        end if;
      when BIFF3 | BIFF4 =>
        if num >= min_30_s and then
           num <= max_30_s and then
           Almost_zero (num - Long_Float'Floor (num))
        then
          Write_as_30_bit_signed (xl, r, c, Integer_32 (Long_Float'Floor (num)));
        else
          Write_as_double (xl, r, c, num);
        end if;
    end case;
  end Write;

  --
  -- Profile with integer number
  --
  procedure Write (
        xl : in out Excel_Out_Stream;
        r,
        c      : Positive;
        num    : Integer)
  is
  begin
    -- We use an integer representation (and small storage) if possible;
    -- we need to use a floating-point in all other cases
    case xl.format is
      when BIFF2 =>
        if num in 0 .. 2**16 - 1 then
          Write_as_16_bit_unsigned (xl, r, c, Unsigned_16 (num));
        else
          Write_as_double (xl, r, c, Long_Float (num));
        end if;
      when BIFF3 | BIFF4 =>
        if num in -2**29 .. 2**29 - 1 then
          Write_as_30_bit_signed (xl, r, c, Integer_32 (num));
        else
          Write_as_double (xl, r, c, Long_Float (num));
        end if;
    end case;
  end Write;

  --  --  Function taken from Wasabee.Encoding.
  --  function ISO_8859_1_to_UTF_16(s: String) return Wide_String is
  --    --  This conversion is a trivial 8-bit to 16-bit copy.
  --    r: Wide_String(s'Range);
  --  begin
  --    for i in s'Range loop
  --      r(i):= Wide_Character'Val(Character'Pos(s(i)));
  --    end loop;
  --    return r;
  --  end ISO_8859_1_to_UTF_16;

  -- 5.63 LABEL
  procedure Write (
        xl : in out Excel_Out_Stream;
        r,
        c      : Positive;
        str    : String)
  is
  begin
    Jump_to_and_store_max (xl, r, c);
    if str'Length > 0 then
      case xl.format is
        when BIFF2 =>
          WriteBiff (xl, 16#0004#,
            Intel_16 (Unsigned_16 (r - 1)) &
            Intel_16 (Unsigned_16 (c - 1)) &
            Cell_attributes (xl) &
            To_buf_8_bit_length (str)
          );
        when BIFF3 | BIFF4 =>
          WriteBiff (xl, 16#0204#,
            Intel_16 (Unsigned_16 (r - 1)) &
            Intel_16 (Unsigned_16 (c - 1)) &
            Intel_16 (Unsigned_16 (xl.xf_in_use)) &
            To_buf_16_bit_length (str)
          );
        --  when BIFF8 =>
        --    WriteBiff(xl, 16#0204#,
        --      Intel_16(Unsigned_16(r-1)) &
        --      Intel_16(Unsigned_16(c-1)) &
        --      Intel_16(Unsigned_16(xl.xf_in_use)) &
        --      To_buf_16_bit_length(ISO_8859_1_to_UTF_16(str))
        --    );
      end case;
    end if;
    Jump_to (xl, r, c + 1); -- Store and check new position
  end Write;

  procedure Write (xl : in out Excel_Out_Stream; r, c : Positive; str : Unbounded_String)
  is
  begin
    Write (xl, r, c, To_String (str));
  end Write;

  --  Excel uses a floating-point type for time - ouch!
  --
  function To_Number (date : Time) return Long_Float is
    --  1901 is the lowest year supported by Ada.Calendar.
    --  1900 is not a leap year, but Lotus 1-2-3, then Excel, consider it
    --  as a leap year. So, with 1901, we skip that issue anyway...
    --
    function Days_since_1901 (y, m, d : Integer) return Integer is
      function Is_leap (y : Integer) return Boolean is
      begin
        if y mod 4 = 0 then
          if y mod 100 = 0 then
            if y mod 400 = 0 then
              return True;
            else
              return False;
            end if;
          else
            return True;
          end if;
        else
          return False;
        end if;
      end Is_leap;
      days_of_previous_months : Integer;
      days_of_previous_years  : Integer;
      y_diff, y_diff_4, y_diff_100, y_diff_400 : Integer;
    begin
      case m is
        when 02 => days_of_previous_months := 31;
        when 03 => days_of_previous_months := 59;
        when 04 => days_of_previous_months := 90;
        when 05 => days_of_previous_months := 120;
        when 06 => days_of_previous_months := 151;
        when 07 => days_of_previous_months := 181;
        when 08 => days_of_previous_months := 212;
        when 09 => days_of_previous_months := 243;
        when 10 => days_of_previous_months := 273;
        when 11 => days_of_previous_months := 304;
        when 12 => days_of_previous_months := 334;
        when others => days_of_previous_months := 0;
      end case;
      if m > 2 and then Is_leap (y) then  --  February has 29 days in leap years.
        days_of_previous_months := days_of_previous_months + 1;
      end if;
      --
      y_diff     := (y - 1)       - 1900;
      y_diff_4   := (y - 1) / 4   - 1900 / 4;
      y_diff_100 := (y - 1) / 100 - 1900 / 100;
      y_diff_400 := (y - 1) / 400 - 1900 / 400;
      --  Add extra days of leap years from 1901 (included) to year y (excluded).
      days_of_previous_years := 365 * y_diff + y_diff_4 - y_diff_100 + y_diff_400;
      --
      return days_of_previous_years + days_of_previous_months + d - 1;
    end Days_since_1901;
    --
    sec : constant Day_Duration := Seconds (date);
  begin
    --  With GNAT and perhaps other systems, Duration's range allows the following:
    --    return Long_Float(date - Time_Of(1901, 01, 01, 0.0)) / 86_400.0 + 367.0;
    --  With ObjectAda and perhaps other systems, we need to count days since 1900 ourselves.
    return
      Long_Float (sec) / 86_400.0 +
      Long_Float (Days_since_1901 (Year (date), Month (date), Day (date))) +
      367.0;  --  Days from 1899-12-31 to 1901-01-01.
      --  Lotus 1-2-3, then Excel, are based on 1899-12-31 (and believe it is 1900-01-01).
  end To_Number;

  procedure Write (xl : in out Excel_Out_Stream; r, c : Positive; date : Time)
  is
  begin
    Write (xl, r, c, To_Number (date));
  end Write;

  -- Ada.Text_IO - like. No need to specify row & column each time
  procedure Put (xl : in out Excel_Out_Stream; num : Long_Float) is
  begin
    Write (xl, xl.curr_row, xl.curr_col, num);
  end Put;

  procedure Put (xl    : in out Excel_Out_Stream;
                num   : in Integer;
                width : in Ada.Text_IO.Field := 0; -- ignored
                base  : in Ada.Text_IO.Number_Base := 10
            )
  is
  begin
    if base = 10 then
      Write (xl, xl.curr_row, xl.curr_col, num);
    else
      declare
        use Ada.Strings.Fixed;
        s : String (1 .. 50 + 0 * width);
        -- 0*width is just to skip a warning of width being unused
        package IIO is new Ada.Text_IO.Integer_IO (Integer);
      begin
        IIO.Put (s, num, Base => base);
        Put (xl, Trim (s, Ada.Strings.Left));
      end;
    end if;
  end Put;

  procedure Put (xl : in out Excel_Out_Stream; str : String) is
  begin
    Write (xl, xl.curr_row, xl.curr_col, str);
  end Put;

  procedure Put (xl : in out Excel_Out_Stream; str : Unbounded_String) is
  begin
    Put (xl, To_String (str));
  end Put;

  procedure Put (xl : in out Excel_Out_Stream; date : Time) is
  begin
    Put (xl, To_Number (date));
  end Put;

  procedure Merge (xl : in out Excel_Out_Stream; cells : Positive) is

    -- 5.7 BLANK
    procedure Blank (r, c : Positive) is
    begin
      Jump_to_and_store_max (xl, r, c);
      case xl.format is
        -- NB: Only with BIFF4, and only OpenOffice
        -- considers the cells really merged.
        when BIFF2 =>
          WriteBiff (xl, 16#0001#,
            Intel_16 (Unsigned_16 (r - 1)) &
            Intel_16 (Unsigned_16 (c - 1)) &
            Cell_attributes (xl)
          );
        when BIFF3 | BIFF4 =>
          WriteBiff (xl, 16#0201#,
            Intel_16 (Unsigned_16 (r - 1)) &
            Intel_16 (Unsigned_16 (c - 1)) &
            Intel_16 (Unsigned_16 (xl.xf_in_use))
          );
      end case;
      Jump_to (xl, r, c + 1); -- Store and check new position
    end Blank;
  begin
    for i in 1 .. cells loop
      Blank (xl.curr_row, xl.curr_col);
    end loop;
  end Merge;

  procedure Write_cell_comment (xl : Excel_Out_Stream; row, column : Positive; text : String) is
  begin
    if text'Length >= 2048 then
      raise Constraint_Error;
    end if;
    -- 5.70 Note
    case xl.format is
      --  when BIFF8 =>  --  https://msdn.microsoft.com/en-us/library/dd945371(v=office.12).aspx
      --    WriteBiff(xl, 16#001C#,
      --      Intel_16(Unsigned_16(row-1)) &
      --      Intel_16(Unsigned_16(column-1)) &
      --      (0, 0) &  --  Show / hide options
      --      (0, 0) --  idObj - it begins to be tough there...
      --    );
      when others =>
        WriteBiff (xl, 16#001C#,
          Intel_16 (Unsigned_16 (row - 1)) &
          Intel_16 (Unsigned_16 (column - 1)) &
          To_buf_16_bit_length (text)
        );
    end case;
  end Write_cell_comment;

  procedure Write_cell_comment_at_cursor (xl : Excel_Out_Stream; text : String) is
  begin
    Write_cell_comment (xl, Row (xl), Column (xl), text);
  end Write_cell_comment_at_cursor;

  procedure Put_Line (xl : in out Excel_Out_Stream; num : Long_Float) is
  begin
    Put (xl, num);
    New_Line (xl);
  end Put_Line;

  procedure Put_Line (xl : in out Excel_Out_Stream; num : Integer) is
  begin
    Put (xl, num);
    New_Line (xl);
  end Put_Line;

  procedure Put_Line (xl : in out Excel_Out_Stream; str : String) is
  begin
    Put (xl, str);
    New_Line (xl);
  end Put_Line;

  procedure Put_Line (xl : in out Excel_Out_Stream; str : Unbounded_String) is
  begin
    Put_Line (xl, To_String (str));
  end Put_Line;

  procedure Put_Line (xl : in out Excel_Out_Stream; date : Time) is
  begin
    Put (xl, date);
    New_Line (xl);
  end Put_Line;

  procedure New_Line (xl : in out Excel_Out_Stream; Spacing : Positive := 1) is
  begin
    Jump_to (xl, xl.curr_row + Spacing, 1);
  end New_Line;

  function Col (xl : in Excel_Out_Stream) return Positive is
  begin
    return xl.curr_col;
  end Col;

  function Column (xl : in Excel_Out_Stream) return Positive renames Col;

  function Line (xl : in Excel_Out_Stream) return Positive is
  begin
    return xl.curr_row;
  end Line;

  function Row (xl : in Excel_Out_Stream) return Positive renames Line;

  -- Relative / absolute jumps
  procedure Jump (xl : in out Excel_Out_Stream; rows, columns : Natural) is
  begin
    Jump_to (xl, xl.curr_row + rows, xl.curr_col + columns);
  end Jump;

  procedure Jump_to (xl : in out Excel_Out_Stream; row, column : Positive) is
  begin
    if row < xl.curr_row then -- trying to overwrite cells ?...
      raise Decreasing_row_index;
    end if;
    if row = xl.curr_row and then
      column < xl.curr_col
    then -- trying to overwrite cells on same row ?...
      raise Decreasing_column_index;
    end if;
    if row > 65536 then
      raise Row_out_of_range;
    elsif column > 256 then
      raise Column_out_of_range;
    end if;
    xl.curr_row := row;
    xl.curr_col := column;
  end Jump_to;

  procedure Next (xl : in out Excel_Out_Stream; columns : Natural := 1) is
  begin
    Jump (xl, rows => 0, columns => columns);
  end Next;

  procedure Next_Row (xl : in out Excel_Out_Stream; rows : Natural := 1) is
  begin
    Jump (xl, rows => rows, columns => 0);
  end Next_Row;

  procedure Use_format (
    xl           : in out Excel_Out_Stream;
    format       : in     Format_type
  )
  is
  begin
    xl.xf_in_use := XF_Range (format);
  end Use_format;

  procedure Use_default_format (xl : in out Excel_Out_Stream) is
  begin
    Use_format (xl, xl.def_fmt);
  end Use_default_format;

  function Default_font (xl : Excel_Out_Stream) return Font_type is
  begin
    return xl.def_font;
  end Default_font;

  function Default_format (xl : Excel_Out_Stream) return Format_type is
  begin
    return xl.def_fmt;
  end Default_format;

  procedure Freeze_Panes (xl : in out Excel_Out_Stream; row, column : Positive) is
  begin
    xl.frz_panes := True;
    xl.freeze_row := row;
    xl.freeze_col := column;
  end Freeze_Panes;

  procedure Freeze_Panes_at_cursor (xl : in out Excel_Out_Stream) is
  begin
    Freeze_Panes (xl, xl.curr_row, xl.curr_col);
  end Freeze_Panes_at_cursor;

  procedure Freeze_Top_Row (xl : in out Excel_Out_Stream) is
  begin
    Freeze_Panes (xl, 2, 1);
  end Freeze_Top_Row;

  procedure Freeze_First_Column (xl : in out Excel_Out_Stream) is
  begin
    Freeze_Panes (xl, 1, 2);
  end Freeze_First_Column;

  procedure Zoom_level (xl : in out Excel_Out_Stream; numerator, denominator : Positive) is
  begin
    xl.zoom_num := numerator;
    xl.zoom_den := denominator;
  end Zoom_level;

  procedure Reset (
    xl           : in out Excel_Out_Stream'Class;
    excel_format :        Excel_type;
    encoding     :        Encoding_type
  )
  is
    dummy_xl_with_defaults : Excel_Out_Pre_Root_Type;
  begin
    -- Check if we are trying to re-use a half-finished object (ouch!):
    if xl.is_created and not xl.is_closed then
      raise Excel_stream_not_closed;
    end if;
    -- We will reset everything with defaults, except this:
    dummy_xl_with_defaults.format   := excel_format;
    dummy_xl_with_defaults.encoding := encoding;
    -- Now we reset xl:
    Excel_Out_Pre_Root_Type (xl) := dummy_xl_with_defaults;
  end Reset;

  procedure Finish (xl : in out Excel_Out_Stream'Class) is

    procedure Write_Window1 is
    begin
      -- 5.109 WINDOW1, p. 215
      case xl.format is
        when BIFF2 | BIFF3 | BIFF4 =>  --  NB: more options in BIFF8
          WriteBiff (xl, 16#003D#,
            Intel_16 (120)   & -- Window x
            Intel_16 (120)   & -- Window y
            Intel_16 (21900) & -- Window w
            Intel_16 (13425) & -- Window h
            Intel_16 (0)       -- Hidden
          );
      end case;
    end Write_Window1;

    procedure Write_Window2 is
    begin
      -- 5.110 WINDOW2
      case xl.format is
        when BIFF2 =>
          WriteBiff (xl, 16#003E#,
            (0, -- Display formulas, not results
             1, -- Show grid lines
             1, -- Show sheet headers
             Boolean'Pos (xl.frz_panes),
             1  -- Show zero values as zeros, not empty cells
            )
             &
            Intel_16 (0) & -- First visible row
            Intel_16 (0) & -- First visible column
            (1, -- Use automatic grid line colour
             0, 0, 0, 0) -- Grid line RGB colour
          );
        when BIFF3 | BIFF4 =>  --  NB: more options in BIFF8
          WriteBiff (xl, 16#023E#,
            -- http://msdn.microsoft.com/en-us/library/dd947893(v=office.12).aspx
            Intel_16 (   -- Option flags:
              0 *   1 + -- Display formulas, not results
              1 *   2 + -- Show grid lines
              1 *   4 + -- Show sheet headers
              Boolean'Pos (xl.frz_panes)
                *   8 + -- Panes are frozen
              1 *  16 + -- Show zero values as zeros, not empty cells
              1 *  32 + -- Gridlines of the window drawn in the default window foreground color
              0 *  64 + -- Right-to-left mode
              1 * 128 + -- Show outlines (guts ?!)
              0 * 256   -- Frozen, not split
            ) &
            Intel_16 (0) & -- First visible row
            Intel_16 (0) & -- First visible column
            Intel_32 (0)   -- Grid line colour
          );
      end case;
    end Write_Window2;

    procedure Write_Pane is
      active_pane : Unsigned_8;
    begin
      if xl.freeze_col = 1 then
        if xl.freeze_row = 1 then
          active_pane := 3;
        else
          active_pane := 2;
        end if;
      else
        if xl.freeze_row = 1 then
          active_pane := 1;
        else
          active_pane := 0;
        end if;
      end if;
      -- 5.75 PANE
      WriteBiff (xl, 16#0041#,
        Intel_16 (Unsigned_16 (xl.freeze_col) - 1) &
        Intel_16 (Unsigned_16 (xl.freeze_row) - 1) &
        Intel_16 (Unsigned_16 (xl.freeze_row) - 1) &
        Intel_16 (Unsigned_16 (xl.freeze_col) - 1) &
        (1 => active_pane)
      );
    end Write_Pane;

    col_bits : Byte_buffer (1 .. 32) := (others => 0);
    byte_idx, bit_idx : Positive := 1;

  begin
    -- Calling Window1 and Window2 is not necessary for default settings, but without these calls,
    -- a Write_row_height call with a positive height results, on all MS Excel versions, in a
    -- completely blank row, including the header letters - clearly an Excel bug !
    Write_Window1;
    Write_Window2;
    --  5.92 SCL = Zoom, Magnification. Defined for BIFF4+ only, but works with BIFF2, BIFF3.
    WriteBiff (xl, 16#00A0#,
      Intel_16 (Unsigned_16 (xl.zoom_num)) &
      Intel_16 (Unsigned_16 (xl.zoom_den))
    );
    if xl.frz_panes and xl.format > BIFF2 then
      -- Enabling PANE for BIFF2 causes a very strange behaviour on MS Excel 2002.
      Write_Pane;
    end if;
    -- 5.93 SELECTION here !!
    if xl.format >= BIFF4 then
      for i in 1 .. 256 loop
        col_bits (byte_idx) := col_bits (byte_idx) +
          Boolean'Pos (xl.std_col_width (i)) * (2**(bit_idx - 1));
        bit_idx := bit_idx + 1;
        if bit_idx = 9 then
          bit_idx := 1;
          byte_idx := byte_idx + 1;
        end if;
      end loop;
      -- 5.51 GCW: Global Column Width - trying to get a correct display by LibreOffice
      -- Result: OK but useless on MS Excel, not working on LibreOffice :-(
      WriteBiff (xl, 16#00AB#, Intel_16 (32) & col_bits);
      -- if xl.defcolwdth > 0 then
      --   -- 5.101 STANDARDWIDTH -- this confuses MS Excel...
      --   WriteBiff(xl, 16#0099#, Intel_16(Unsigned_16(xl.defcolwdth)));
      -- end if;
    end if;
    -- 5.37 EOF: End of File:
    WriteBiff (xl, 16#000A#, empty_buffer);
    Set_Index (xl, xl.dimrecpos); -- Go back to overwrite the DIMENSION record with correct data
    Write_Dimensions (xl);
    xl.is_closed := True;
  end Finish;

  ----------------------
  -- Output to a file --
  ----------------------

  procedure Create (
    xl           : in out Excel_Out_File;
    file_name    :        String;
    excel_format :        Excel_type    := Default_Excel_type;
    encoding     :        Encoding_type := Default_encoding
  )
  is
  begin
    Reset (xl, excel_format, encoding);
    xl.xl_file := new Ada.Streams.Stream_IO.File_Type;
    Create (xl.xl_file.all, Out_File, file_name);
    xl.xl_stream := XL_Raw_Stream_Class (Stream (xl.xl_file.all));
    Write_Worksheet_header (xl);
  end Create;

  procedure Close (xl : in out Excel_Out_File) is
    procedure Dispose is new
      Ada.Unchecked_Deallocation (Ada.Streams.Stream_IO.File_Type, XL_file_acc);
  begin
    Finish (xl);
    Close (xl.xl_file.all);
    Dispose (xl.xl_file);
  end Close;

  -- Set the index on the file
  procedure Set_Index (xl : in out Excel_Out_File;
                       To : Ada.Streams.Stream_IO.Positive_Count)
  is
  begin
    Ada.Streams.Stream_IO.Set_Index (xl.xl_file.all, To);
  end Set_Index;

  -- Return the index of the file
  function Index (xl : Excel_Out_File) return Ada.Streams.Stream_IO.Count
  is
  begin
    return Ada.Streams.Stream_IO.Index (xl.xl_file.all);
  end Index;

  function Is_Open (xl : in Excel_Out_File) return Boolean is
  begin
    if xl.xl_file = null then
      return False;
    end if;
    return Ada.Streams.Stream_IO.Is_Open (xl.xl_file.all);
  end Is_Open;

  ------------------------
  -- Output to a string --
  ------------------------
  -- Code reused from Zip_Streams

  procedure Read
    (Stream : in out Unbounded_Stream;
     Item   : out Stream_Element_Array;
     Last   : out Stream_Element_Offset) is
  begin
    -- Item is read from the stream. If (and only if) the stream is
    -- exhausted, Last will be < Item'Last. In that case, T'Read will
    -- raise an End_Error exception.
    --
    -- Cf: RM 13.13.1(8), RM 13.13.1(11), RM 13.13.2(37) and
    -- explanations by Tucker Taft
    --
    Last := Item'First - 1;
    -- if Item is empty, the following loop is skipped; if Stream.Loc
    -- is already indexing out of Stream.Unb, that value is also appropriate
    for i in Item'Range loop
      Item (i) := Character'Pos (Element (Stream.Unb, Stream.Loc));
      Stream.Loc := Stream.Loc + 1;
      Last := i;
    end loop;
  exception
    when Ada.Strings.Index_Error =>
      null; -- what could be read has been read; T'Read will raise End_Error
  end Read;

  procedure Write
    (Stream : in out Unbounded_Stream;
     Item   : Stream_Element_Array) is
  begin
    for I in Item'Range loop
      if Length (Stream.Unb) < Stream.Loc then
        Append (Stream.Unb, Character'Val (Item (I)));
      else
        Replace_Element (Stream.Unb, Stream.Loc, Character'Val (Item (I)));
      end if;
      Stream.Loc := Stream.Loc + 1;
    end loop;
  end Write;

  procedure Set_Index (S : access Unbounded_Stream; To : Positive) is
  begin
    if Length (S.Unb) < To then
      for I in Length (S.Unb) .. To loop
        Append (S.Unb, ASCII.NUL);
      end loop;
    end if;
    S.Loc := To;
  end Set_Index;

  function Index (S : access Unbounded_Stream) return Integer is
  begin
    return S.Loc;
  end Index;

  --- ***

  procedure Create (
    xl           : in out Excel_Out_String;
    excel_format :        Excel_type    := Default_Excel_type;
    encoding     :        Encoding_type := Default_encoding
  )
  is
  begin
    Reset (xl, excel_format, encoding);
    xl.xl_memory := new Unbounded_Stream;
    xl.xl_memory.Unb := Null_Unbounded_String;
    xl.xl_memory.Loc := 1;
    xl.xl_stream := XL_Raw_Stream_Class (xl.xl_memory);
    Write_Worksheet_header (xl);
  end Create;

  procedure Close (xl : in out Excel_Out_String) is
  begin
    Finish (xl);
  end Close;

  function Contents (xl : Excel_Out_String) return String is
  begin
    if not xl.is_closed then
      raise Excel_stream_not_closed;
    end if;
    return To_String (xl.xl_memory.Unb);
  end Contents;

  -- Set the index on the Excel string stream
  procedure Set_Index (xl : in out Excel_Out_String;
                       To : Ada.Streams.Stream_IO.Positive_Count)
  is
  begin
    Set_Index (xl.xl_memory, Integer (To));
  end Set_Index;

  -- Return the index of the Excel string stream
  function Index (xl : Excel_Out_String) return Ada.Streams.Stream_IO.Count
  is
  begin
    return Ada.Streams.Stream_IO.Count (Index (xl.xl_memory));
  end Index;

  function "&"(a, b : Font_style) return Font_style is
  begin
    return a or b; -- "or" is predefined for sets (=array of Boolean)
  end "&";

  function "&"(a, b : Cell_border) return Cell_border is
  begin
    return a or b; -- "or" is predefined for sets (=array of Boolean)
  end "&";

end Excel_Out;