← Back to branch summary

~ubuntu-branches/debian/stretch/adabrowse/stretch

« back to all changes in this revision

Viewing changes to ad-text_utilities.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2004-02-14 13:22:40 UTC
  • Revision ID: james.westby@ubuntu.com-20040214132240-cqumhiq1677pkvzo
Tags: upstream-4.0.2
Import upstream version 4.0.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
ad-text_utilities.adb
 
1
-------------------------------------------------------------------------------
 
2
--
 
3
--  This file is part of AdaBrowse.
 
4
--
 
5
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
 
6
-- <BLOCKQUOTE>
 
7
--    AdaBrowse is free software; you can redistribute it and/or modify it
 
8
--    under the terms of the  GNU General Public License as published by the
 
9
--    Free Software  Foundation; either version 2, or (at your option) any
 
10
--    later version. AdaBrowse is distributed in the hope that it will be
 
11
--    useful, but <EM>without any warranty</EM>; without even the implied
 
12
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
 
13
--    See the GNU General Public License for  more details. You should have
 
14
--    received a copy of the GNU General Public License with this distribution,
 
15
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
 
16
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
 
17
--    USA.
 
18
-- </BLOCKQUOTE>
 
19
--
 
20
-- <DL><DT><STRONG>
 
21
-- Author:</STRONG><DD>
 
22
--   Thomas Wolf  (TW)
 
23
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
 
24
--
 
25
-- <DL><DT><STRONG>
 
26
-- Purpose:</STRONG><DD>
 
27
--   Miscellaneous text utilities.</DL>
 
28
--
 
29
-- <!--
 
30
-- Revision History
 
31
--
 
32
--   02-FEB-2002   TW  First release.
 
33
--   07-FEB-2002   TW  Added 'Quote'.
 
34
--   06-JUN-2003   TW  Added 'To_Lower' and 'To_Upper'.
 
35
--   11-JUN-2003   TW  Added 'Canonical'.
 
36
-- -->
 
37
-------------------------------------------------------------------------------
 
38
 
 
39
pragma License (GPL);
 
40
 
 
41
with Ada.Strings.Fixed;
 
42
with Ada.Strings.Maps;
 
43
with Util.Pathes;
 
44
with Util.Strings;
 
45
 
 
46
pragma Elaborate_All (Util.Pathes);
 
47
 
 
48
package body AD.Text_Utilities is
 
49
 
 
50
   package ASF renames Ada.Strings.Fixed;
 
51
   package ASM renames Ada.Strings.Maps;
 
52
 
 
53
   use Util.Strings;
 
54
 
 
55
   ----------------------------------------------------------------------------
 
56
 
 
57
   To_Dir_Sep : constant ASM.Character_Mapping :=
 
58
     ASM.To_Mapping
 
59
       ("\/",
 
60
        Util.Pathes.Directory_Separator & Util.Pathes.Directory_Separator);
 
61
   --  Map both, so that this works on Unix and Windows!
 
62
 
 
63
   function Canonical
 
64
     (Suspicious_Name : in String)
 
65
     return String
 
66
   is
 
67
   begin
 
68
      return ASF.Translate (Suspicious_Name, To_Dir_Sep);
 
69
   end Canonical;
 
70
 
 
71
   ----------------------------------------------------------------------------
 
72
 
 
73
   function To_File_Name
 
74
     (Unit_Name : in String;
 
75
      Suffix    : in String := "ads")
 
76
     return String
 
77
   is
 
78
      Result : String (1 .. Unit_Name'Length + 1 + Suffix'Length);
 
79
      I      : Positive := 1;
 
80
   begin
 
81
      for J in Unit_Name'Range loop
 
82
         if Unit_Name (J) = '.' then
 
83
            Result (I) := '-';
 
84
         else
 
85
            Result (I) := To_Lower (Unit_Name (J));
 
86
         end if;
 
87
         I := I + 1;
 
88
      end loop;
 
89
      if Suffix'Last < Suffix'First then
 
90
         return Result (1 .. I - 1);
 
91
      end if;
 
92
      Result (I) := '.';
 
93
      Result (I + 1 .. Result'Last) := Suffix;
 
94
      return Result;
 
95
   end To_File_Name;
 
96
 
 
97
   ----------------------------------------------------------------------------
 
98
 
 
99
   function Quote
 
100
     (S : in String)
 
101
     return String
 
102
   is
 
103
      I : constant Natural := ASF.Index (S, Blanks);
 
104
   begin
 
105
      if I = 0 then return S; end if; --  No white space
 
106
      declare
 
107
         Result : String (1 .. I - S'First + 2 * (S'Last - I + 1) + 2);
 
108
         --  Maximum needed length.
 
109
         K      : Natural := 2;
 
110
      begin
 
111
         Result (1) := '"';
 
112
         for J in S'Range loop
 
113
            if S (J) = '"' then
 
114
               Result (K) := '\'; K := K + 1;
 
115
            end if;
 
116
            Result (K) := S (J); K := K + 1;
 
117
         end loop;
 
118
         Result (K) := '"';
 
119
         return Result (1 .. K);
 
120
      end;
 
121
   end Quote;
 
122
 
 
123
end AD.Text_Utilities;