src/morzhol-os.adb

   1 ------------------------------------------------------------------------------
   2 --                                Morzhol                                   --
   3 --                                                                          --
   4 --                           Copyright (C) 2008                             --
   5 --                      Pascal Obry - Olivier Ramonat                       --
   6 --                                                                          --
   7 --  This library is free software; you can redistribute it and/or modify    --
   8 --  it under the terms of the GNU General Public License as published by    --
   9 --  the Free Software Foundation; either version 2 of the License, or (at   --
  10 --  your option) any later version.                                         --
  11 --                                                                          --
  12 --  This library is distributed in the hope that it will be useful, but     --
  13 --  WITHOUT ANY WARRANTY; without even the implied warranty of              --
  14 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
  15 --  General Public License for more details.                                --
  16 --                                                                          --
  17 --  You should have received a copy of the GNU General Public License       --
  18 --  along with this library; if not, write to the Free Software Foundation, --
  19 --  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.       --
  20 ------------------------------------------------------------------------------
  21
  22 with Ada.Characters.Handling;
  23
  24 package body Morzhol.OS is
  25
  26    -------------
  27    -- Compose --
  28    -------------
  29
  30    function Compose (Containing_Directory, Path : in String) return String is
  31
  32       function CD_Sep return String;
  33       --  Returns the Containing_Directory with an ending directory separator
  34
  35       ------------
  36       -- CD_Sep --
  37       ------------
  38
  39       function CD_Sep return String is
  40          CD : String renames Containing_Directory;
  41       begin
  42          if CD'Length > 1
  43            and then
  44            (CD (CD'Last) = '/' or else CD (CD'Last) = Directory_Separator)
  45          then
  46             return CD;
  47          else
  48             return CD & Directory_Separator;
  49          end if;
  50       end CD_Sep;
  51
  52       Last : Natural := Path'Last;
  53
  54    begin
  55       --  Removes any trailing directory separator
  56
  57       while Last > Path'First
  58         and then Is_Directory_Separator (Path (Last))
  59       loop
  60          Last := Last - 1;
  61       end loop;
  62
  63       if (Path'Length > 1
  64           and then Is_Directory_Separator (Path (Path'First)))
  65         or else (Path'Length > 3
  66                  and then Characters.Handling.Is_Letter (Path (Path'First))
  67                  and then Path (Path'First + 1 .. Path'First + 2) = ":\")
  68       then
  69          --  Absolute Path
  70          return Path (Path'First .. Last);
  71
  72       elsif Path'Length > 2
  73             and then
  74               (Path (Path'First .. Path'First + 1) = "./"
  75                or else Path (Path'First .. Path'First + 1) = ".\")
  76       then
  77          return CD_Sep & Path (Path'First + 2 .. Last);
  78
  79       else
  80          return CD_Sep & Path (Path'First .. Last);
  81       end if;
  82    end Compose;
  83
  84    ----------------------------
  85    -- Is_Directory_Separator --
  86    ----------------------------
  87
  88    function Is_Directory_Separator (C : in Character) return Boolean is
  89    begin
  90       return C = '/' or else C = Directory_Separator;
  91    end Is_Directory_Separator;
  92
  93 end Morzhol.OS;