← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ad-known_units.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-known_units.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
--   Keeps a list of known filename/unitname pairs.</DL>
 
28
--
 
29
-- <!--
 
30
-- Revision History
 
31
--
 
32
--   09-JUL-2003   TW  Initial version
 
33
-- -->
 
34
-------------------------------------------------------------------------------
 
35
 
 
36
pragma License (GPL);
 
37
 
 
38
with GAL.ADT.Hash_Tables;
 
39
with GAL.Support.Hashing;
 
40
with GAL.Storage.Standard;
 
41
 
 
42
pragma Elaborate_All (GAL.ADT.Hash_Tables);
 
43
 
 
44
with Util.Pathes;
 
45
with Util.Strings;
 
46
 
 
47
package body AD.Known_Units is
 
48
 
 
49
   package ASU renames Ada.Strings.Unbounded;
 
50
 
 
51
   --  All right. We need several different access methods:
 
52
   --  case sensitive first, then case insensitive. Exact match, and
 
53
   --  basename match. We hash on the greatest common denominator: the
 
54
   --  case insensitive base name.
 
55
 
 
56
   Prefix           : Boolean := False;
 
57
   Case_Insensitive : Boolean := False;
 
58
 
 
59
   function Equal
 
60
     (Left, Right : in String)
 
61
     return Boolean
 
62
   is
 
63
      function Match
 
64
        (Left, Right : in String)
 
65
        return Boolean
 
66
      is
 
67
      begin
 
68
         if not Case_Insensitive then
 
69
            return Left = Right;
 
70
         else
 
71
            return Util.Strings.Equal (Left, Right);
 
72
         end if;
 
73
      end Match;
 
74
 
 
75
      use Util.Pathes;
 
76
 
 
77
   begin --  Equal
 
78
      if Prefix then
 
79
         return Match (Base_Name (Left), Base_Name (Right));
 
80
      else
 
81
         return Match (Left, Right);
 
82
      end if;
 
83
   end Equal;
 
84
 
 
85
   function Hash
 
86
     (S : in String)
 
87
     return GAL.Support.Hashing.Hash_Type
 
88
   is
 
89
      use Util.Pathes;
 
90
   begin
 
91
      return GAL.Support.Hashing.Hash_Case_Insensitive (Base_Name (S));
 
92
   end Hash;
 
93
 
 
94
   type Unit_Desc is
 
95
      record
 
96
         File, Path, Unit : ASU.Unbounded_String;
 
97
      end record;
 
98
 
 
99
   package Units is
 
100
      new GAL.ADT.Hash_Tables
 
101
       (Key_Type => String,
 
102
        Item     => Unit_Desc,
 
103
        Memory   => GAL.Storage.Standard,
 
104
        Hash     => Hash,
 
105
        "="      => Equal);
 
106
 
 
107
   Known : Units.Hash_Table;
 
108
 
 
109
   procedure Add
 
110
     (File_Name : in String;
 
111
      Unit_Name : in String)
 
112
   is
 
113
      New_Entry : Unit_Desc;
 
114
      The_Name : constant String := Util.Pathes.Name (File_Name);
 
115
   begin
 
116
      Prefix := False; Case_Insensitive := False;
 
117
      New_Entry.File := ASU.To_Unbounded_String (The_Name);
 
118
      New_Entry.Path := ASU.To_Unbounded_String (Util.Pathes.Path (File_Name));
 
119
      New_Entry.Unit := ASU.To_Unbounded_String (Unit_Name);
 
120
      Units.Insert (Known, The_Name, New_Entry);
 
121
   exception
 
122
      when Units.Duplicate_Key =>
 
123
         null;
 
124
   end Add;
 
125
 
 
126
   procedure Find
 
127
     (Given_File_Name  : in     String;
 
128
      Stored_File_Name :    out Ada.Strings.Unbounded.Unbounded_String;
 
129
      Stored_Path      :    out Ada.Strings.Unbounded.Unbounded_String;
 
130
      Unit_Name        :    out Ada.Strings.Unbounded.Unbounded_String)
 
131
   is
 
132
      procedure Get
 
133
        (Key   : in     String;
 
134
         Found :    out Boolean)
 
135
      is
 
136
         Item  : Unit_Desc;
 
137
      begin
 
138
         Item := Units.Retrieve (Known, Key);
 
139
         Stored_File_Name := Item.File;
 
140
         Stored_Path      := Item.Path;
 
141
         Unit_Name        := Item.Unit;
 
142
         Found            := True;
 
143
      exception
 
144
         when Units.Not_Found =>
 
145
            Found := False;
 
146
      end Get;
 
147
 
 
148
      Found : Boolean;
 
149
 
 
150
      use Util.Pathes;
 
151
 
 
152
      The_Name : constant String := Name (Given_File_Name);
 
153
 
 
154
   begin
 
155
      Stored_File_Name := ASU.Null_Unbounded_String;
 
156
      Unit_Name        := ASU.Null_Unbounded_String;
 
157
      if not Units.Is_Empty (Known) then
 
158
         for B in Boolean loop
 
159
            Prefix := False; Case_Insensitive := B;
 
160
            Get (The_Name, Found);
 
161
            if Found then return; end if;
 
162
            Get (Replace_Extension (The_Name, "ads"), Found);
 
163
            if Found then return; end if;
 
164
            Prefix := True;
 
165
            Get (Base_Name (The_Name), Found);
 
166
            if Found then return; end if;
 
167
         end loop;
 
168
      end if;
 
169
   end Find;
 
170
 
 
171
begin
 
172
   Units.Set_Resize (Known, 0.75);
 
173
   declare
 
174
      Linear_Growth : GAL.Support.Hashing.Linear_Growth_Policy (50);
 
175
   begin
 
176
      Units.Set_Growth_Policy (Known, Linear_Growth);
 
177
   end;
 
178
end AD.Known_Units;