~ubuntu-branches/ubuntu/precise/gnat-gps/precise

« back to all changes in this revision

Viewing changes to gnatlib/src/gnatcoll-vfs.ads

  • Committer: Package Import Robot
  • Author(s): Ludovic Brenta
  • Date: 2012-01-15 15:42:21 UTC
  • mfrom: (10.1.10 sid)
  • Revision ID: package-import@ubuntu.com-20120115154221-ccysuzvh02pkhuwq
Tags: 5.0-6
Rebuild against libgtkada 2.24.1.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
-----------------------------------------------------------------------
2
2
--                          G N A T C O L L                          --
3
3
--                                                                   --
 
4
--                 Copyright (C) 2003-2010, AdaCore                  --
4
5
--                                                                   --
5
6
-- GPS is free  software;  you can redistribute it and/or modify  it --
6
7
-- under the terms of the GNU General Public License as published by --
41
41
--  one memory allocation when the file is created to store the name.
42
42
 
43
43
with Ada.Calendar;
 
44
with Ada.Containers;
 
45
with Ada.Unchecked_Deallocation;
44
46
with Ada.Finalization;
45
 
with Ada.Containers;
 
47
 
46
48
with GNAT.OS_Lib;
47
49
with GNAT.Strings;
48
 
with GNATCOLL.Filesystem;
 
50
 
 
51
private with GNATCOLL.IO;
 
52
private with GNATCOLL.IO.Native;
49
53
 
50
54
package GNATCOLL.VFS is
51
55
 
52
 
   VFS_Directory_Error : exception;
 
56
   ------------------------
 
57
   -- Filesystem strings --
 
58
   ------------------------
 
59
 
 
60
   type Filesystem_String is new String;
 
61
   type Filesystem_String_Access is access all Filesystem_String;
 
62
   --  A Filesystem_String represents an array of characters as they are
 
63
   --  represented on the filesystem, without any encoding consideration.
 
64
 
 
65
   function "+" (S : Filesystem_String) return String;
 
66
   pragma Inline ("+");
 
67
   function "+" (S : String) return Filesystem_String;
 
68
   pragma Inline ("+");
 
69
   function Equal (S1, S2 : Filesystem_String) return Boolean;
 
70
   pragma Inline (Equal);
 
71
   procedure Free is new Ada.Unchecked_Deallocation
 
72
     (Filesystem_String, Filesystem_String_Access);
 
73
   --  Conversion/Comparison/Concatenation functions
 
74
 
 
75
   type Cst_Filesystem_String_Access is access constant Filesystem_String;
 
76
 
 
77
   ----------------
 
78
   -- Exceptions --
 
79
   ----------------
 
80
 
 
81
   VFS_Directory_Error    : exception;
 
82
   VFS_Invalid_File_Error : exception;
 
83
 
 
84
   ------------------------------
 
85
   --  Virtual File definition --
 
86
   ------------------------------
53
87
 
54
88
   type Virtual_File is tagged private;
55
 
   No_File        : constant Virtual_File;
56
 
 
57
 
   type Virtual_File_Access is access constant Virtual_File;
 
89
   No_File : aliased constant Virtual_File;
 
90
 
 
91
   ---------------
 
92
   -- Constants --
 
93
   ---------------
 
94
 
 
95
   Local_Host : aliased constant String;
 
96
 
 
97
   -------------------
 
98
   -- Configuration --
 
99
   -------------------
 
100
 
 
101
   procedure Symbolic_Links_Support (Active : Boolean);
 
102
   --  Whether this package should do extra system calls to handle symbolic
 
103
   --  links.
 
104
   --  This is automatically False on platforms like Windows where this notion
 
105
   --  does not exist, but when you know you have no symbolic links manipulated
 
106
   --  by your application you can significantly reduce the number of system
 
107
   --  calls (which in turns speeds things up). If you set it to False, two
 
108
   --  symbolic links that point to the same physical file will be considered
 
109
   --  different by the "=" operator. If you set it to True they will be
 
110
   --  considered equal.
 
111
   --  Changing this is not thread safe. In fact, you should call this before
 
112
   --  manipulating any of the Virtual_File, because GNATCOLL.VFS caches the
 
113
   --  normalization of file names, and would not redo it for existing files
 
114
   --  after you call this function, so the results of "=" in particular might
 
115
   --  be unexpected.
58
116
 
59
117
   ----------------------------
60
118
   --  Creating Virtual_File --
70
128
   --  filename needs to be converted to a known encoding, generally utf8.
71
129
   --  See the "Retrieving names" section below.
72
130
 
73
 
   function Create (Full_Filename : String) return Virtual_File;
 
131
   function Create
 
132
     (Full_Filename : Filesystem_String;
 
133
      Host          : String := Local_Host;
 
134
      Normalize     : Boolean := False) return Virtual_File;
74
135
   --  Return a file, given its full filename.
75
136
   --  The latter can be found, for source files, through the functions in
76
137
   --  projects-registry.ads.
77
 
 
78
 
   function Create
79
 
     (FS            : GNATCOLL.Filesystem.Filesystem_Access;
80
 
      Full_Filename : String) return Virtual_File;
81
 
   --  Return a file, given its full filename and an instance of a file
82
 
   --  system. The filesystem can possibly be running on a remote host, in
83
 
   --  which case the file will also be hosted on that machine.
84
 
   --  FS must not be freed while the file exists, since no copy is made
 
138
   --  If Normalize is set, then the VFS is created using the normalized
 
139
   --  Full_Filename.
85
140
 
86
141
   function Create_From_Dir
87
142
     (Dir       : Virtual_File;
88
 
      Base_Name : String) return Virtual_File;
 
143
      Base_Name : Filesystem_String;
 
144
      Normalize : Boolean := False) return Virtual_File;
89
145
   --  Creates a file from its directory and base name
90
 
 
91
 
   function Create_From_Base (Base_Name : String) return Virtual_File;
92
 
   --  Return a file, given its base name.
93
 
   --  The full name will never be computable. Consider using Projects.Create
94
 
   --  if you know to which project the file belongs. Also consider using
95
 
   --  GPS.Kernel.Create
96
 
   --  ??? Currently, this does the same thing as create, but it is
97
 
   --  preferable to distinguish both cases just in case.
 
146
   --  If Normalize is set, then Create_From_Dir will make sure that the
 
147
   --  path is normalized
 
148
 
 
149
   function Create_From_Base
 
150
     (Base_Name : Filesystem_String;
 
151
      Base_Dir  : Filesystem_String := "";
 
152
      Host      : String := Local_Host) return Virtual_File;
 
153
   --  Create a file from its base name.
 
154
   --  if Base_Name is an absolute path, then the file is created as is
 
155
   --  else the file is created relative to Base_Dir or the Current Directory
 
156
   --  if furnished.
 
157
 
 
158
   function Create_From_UTF8
 
159
     (Full_Filename : String;
 
160
      Host          : String := Local_Host;
 
161
      Normalize     : Boolean := False) return Virtual_File;
 
162
   --  Creates a file from its display name
 
163
   --  If Normalize is set, then the VFS is created using the normalized
 
164
   --  Full_Filename.
 
165
 
 
166
   function Locate_On_Path
 
167
     (Base_Name : Filesystem_String;
 
168
      Host      : String := Local_Host) return Virtual_File;
 
169
   --  Locate the file from its base name and the PATH environment variable
98
170
 
99
171
   ----------------------
100
172
   -- Retrieving names --
110
182
   --  functions above, and therefore make no guarantee on the encoding of the
111
183
   --  file name.
112
184
 
113
 
   type Cst_String_Access is access constant String;
114
 
 
115
185
   function Base_Name
116
 
     (File : Virtual_File; Suffix : String := "") return String;
 
186
     (File : Virtual_File; Suffix : Filesystem_String := "")
 
187
      return Filesystem_String;
117
188
   --  Return the base name of the file
118
189
 
119
 
   function Base_Dir_Name (File : Virtual_File) return String;
 
190
   function Base_Dir_Name (File : Virtual_File) return Filesystem_String;
120
191
   --  Return the base name of the directory or the file
121
192
 
122
193
   function Full_Name
123
 
     (File : Virtual_File; Normalize : Boolean := False)
124
 
      return Cst_String_Access;
 
194
     (File          : Virtual_File;
 
195
      Normalize     : Boolean := False;
 
196
      Resolve_Links : Boolean := False) return Cst_Filesystem_String_Access;
125
197
   --  Return the full path to File.
126
198
   --  If Normalize is True, the file name is first normalized, note that links
127
 
   --  are not resolved there.
 
199
   --  are not resolved there by default, unless you specify Resolve_Links to
 
200
   --  True.
128
201
   --  The returned value can be used to recreate a Virtual_File instance.
129
202
   --  If file names are case insensitive, the normalized name will always
130
203
   --  be all lower cases.
131
204
 
 
205
   function Full_Name
 
206
     (File      : Virtual_File;
 
207
      Normalize : Boolean := False) return Filesystem_String;
 
208
   --  Same as above, returning a filesystem_string
 
209
 
132
210
   function Full_Name_Hash
133
211
     (Key : Virtual_File) return Ada.Containers.Hash_Type;
134
212
   --  Return a Hash_Type computed from the full name of the given VFS.
135
213
   --  Could be used to instantiate an Ada 2005 container that uses a VFS as
136
214
   --  key and requires a hash function.
137
215
 
138
 
   function File_Extension (File : Virtual_File) return String;
 
216
   function File_Extension
 
217
     (File      : Virtual_File;
 
218
      Normalize : Boolean := False) return Filesystem_String;
139
219
   --  Return the extension of the file, or the empty string if there is no
140
220
   --  extension. This extension includes the last dot and all the following
141
221
   --  characters.
 
222
   --  If Normalize is true, the casing is normalized (depending on whether the
 
223
   --  platform uses case insensitive file names).
142
224
 
143
 
   function Dir_Name (File : Virtual_File) return Cst_String_Access;
 
225
   function Dir_Name (File : Virtual_File) return Filesystem_String;
144
226
   --  Return the directory name for File. This includes any available
145
227
   --  on the protocol, so that relative files names are properly found.
146
228
 
147
 
   function Display_Full_Name (File : Virtual_File) return String;
 
229
   function Display_Full_Name
 
230
     (File      : Virtual_File;
 
231
      Normalize : Boolean := False) return String;
148
232
   --  Same as Full_Name
149
233
 
150
 
   function Display_Base_Name (File : Virtual_File) return String;
 
234
   function Display_Base_Name
 
235
     (File   : Virtual_File;
 
236
      Suffix : Filesystem_String := "") return String;
151
237
   --  Same as Base_Name
152
238
 
153
239
   function Display_Dir_Name (File : Virtual_File) return String;
154
240
   --  Same as Dir_Name
155
241
 
 
242
   function Display_Base_Dir_Name (File : Virtual_File) return String;
 
243
   --  Same as Base_Dir_Name
 
244
 
 
245
   function Unix_Style_Full_Name
 
246
     (File         : Virtual_File;
 
247
      Cygwin_Style : Boolean := False) return Filesystem_String;
 
248
   --  Returns the file path using a unix-style path
 
249
 
 
250
   function Relative_Path
 
251
     (File : Virtual_File;
 
252
      From : Virtual_File) return Filesystem_String;
 
253
   --  Return the path of File relative to From. Return the full_name in case
 
254
   --  From and File are not on the same drive.
 
255
 
 
256
   function Has_Suffix
 
257
     (File : Virtual_File; Suffix : Filesystem_String) return Boolean;
 
258
   --  Tell if File has suffix Suffix
 
259
 
 
260
   function To_Remote
 
261
     (File : Virtual_File; To_Host : String) return Virtual_File;
 
262
   --  Convert the file format of File to the convention used on To_Host,
 
263
   --  using all available mount points defined for To_Host.
 
264
 
 
265
   function To_Local
 
266
     (File : Virtual_File) return Virtual_File;
 
267
   --  Convert the file format of File to the local filesystem's convention,
 
268
   --  potentially using mount points defined between File's host and local
 
269
   --  host.
 
270
 
 
271
   function To_Arg
 
272
     (File : Virtual_File;
 
273
      Host : String := Local_Host) return GNAT.Strings.String_Access;
 
274
   --  Convert the File to a String Access that can be used as argument for
 
275
   --  spawning a process on "Host". The returned value needs to be freeed by
 
276
   --  the caller.
 
277
 
156
278
   ------------------------
157
279
   -- Getting attributes --
158
280
   ------------------------
159
281
 
160
 
   function Get_Filesystem
161
 
     (File : Virtual_File) return GNATCOLL.Filesystem.Filesystem_Access;
162
 
   --  Return the filesystem for File
 
282
   function Is_Local (File : Virtual_File) return Boolean;
 
283
   --  Whether File is local to the host or is a remote file
 
284
 
 
285
   function Get_Host (File : Virtual_File) return String;
 
286
   --  Retrieve the host of the file, or Local_Host if the file is local to the
 
287
   --  host.
163
288
 
164
289
   function Is_Regular_File (File : Virtual_File) return Boolean;
165
290
   --  Whether File corresponds to an actual file on the disk.
202
327
   --  created by anyone, and is just a private type.
203
328
   --  If the file doesn't exist, No_Time is returned.
204
329
 
 
330
   procedure Normalize_Path
 
331
     (File             : Virtual_File;
 
332
      Resolve_Symlinks : Boolean := False);
 
333
   --  Resolve '..' and '.' directories in path.
 
334
   --  If Resolve_Symlinks is set, then also resolve the symbolic links in
 
335
   --  path.
 
336
 
205
337
   --------------------
206
338
   -- Array of files --
207
339
   --------------------
208
340
 
209
 
   type File_Array is array (Positive range <>) of Virtual_File;
 
341
   type File_Array is array (Positive range <>) of aliased Virtual_File;
210
342
   type File_Array_Access is access all File_Array;
 
343
 
211
344
   procedure Unchecked_Free (Arr : in out File_Array_Access);
212
345
 
213
346
   Empty_File_Array : constant File_Array;
215
348
   procedure Sort (Files : in out File_Array);
216
349
   --  Sort the array of files, in the order given by the full names
217
350
 
 
351
   procedure Append (Files : in out File_Array_Access; F : Virtual_File);
 
352
   procedure Append (Files : in out File_Array_Access; F : File_Array);
 
353
   --  Appends one or more files to Files. Files can be null, in which case a
 
354
   --  new File_Array is created.
 
355
 
 
356
   procedure Remove (Files : in out File_Array_Access; F : Virtual_File);
 
357
   --  Remove F from Files
 
358
 
 
359
   function To_Path (Paths : File_Array) return Filesystem_String;
 
360
   --  Translates a list of Paths into a path string (e.g. the same format as
 
361
   --  $PATH)
 
362
 
 
363
   function From_Path (Path : Filesystem_String) return File_Array;
 
364
   --  Translate a PATH string into a list of Virtual_File
 
365
 
 
366
   function Locate_On_Path
 
367
     (Base_Name : Filesystem_String;
 
368
      Path      : File_Array) return Virtual_File;
 
369
   --  Locate the file from its base name and the furnished list of
 
370
   --  directories.
 
371
 
 
372
   function Greatest_Common_Path
 
373
     (L : GNATCOLL.VFS.File_Array) return Virtual_File;
 
374
   --  Return the greatest common path to a list of files or directories
 
375
   --  No_File is returned if some files do not have the same root directory.
 
376
 
 
377
   function Locate_Regular_File
 
378
     (File_Name : Filesystem_String;
 
379
      Path      : File_Array) return Virtual_File;
 
380
   --  Locate a regular file from its base name and a list of paths
 
381
 
218
382
   -------------------------
219
383
   --  Manipulating files --
220
384
   -------------------------
221
385
 
222
386
   procedure Rename
223
387
     (File      : Virtual_File;
224
 
      Full_Name : String;
 
388
      Full_Name : Virtual_File;
225
389
      Success   : out Boolean);
226
390
   --  Rename a file or directory. This does not work for remote files
227
391
 
228
392
   procedure Copy
229
393
     (File        : Virtual_File;
230
 
      Target_Name : String;
 
394
      Target_Name : Filesystem_String;
231
395
      Success     : out Boolean);
232
396
   --  Copy a file or directory. This does not work for remote files
233
397
 
248
412
 
249
413
   function Dir (File : Virtual_File) return Virtual_File;
250
414
   --  Return the virtual file corresponding to the directory of the file
251
 
 
252
 
   function Get_Current_Dir return Virtual_File;
 
415
   --  If File denotes a directory, then it is returned.
 
416
   --  To retrieve the container of File (e.g. get the parent of File, even if
 
417
   --  it is a directory), use Get_Parent instead.
 
418
 
 
419
   function Get_Current_Dir (Host : String := Local_Host) return Virtual_File;
 
420
   --  Current dir on host
 
421
 
 
422
   function Get_Tmp_Directory
 
423
     (Host : String := Local_Host) return Virtual_File;
 
424
   --  Tmp dir on host
 
425
 
 
426
   function Get_Home_Directory
 
427
     (Host : String := Local_Host) return Virtual_File;
 
428
   --  Home dir on host
 
429
 
 
430
   function Get_Logical_Drives
 
431
     (Host : String := Local_Host) return File_Array_Access;
 
432
   --  List of all logical drives on host, or null if none. The list needs to
 
433
   --  be freed by the caller.
253
434
 
254
435
   procedure Ensure_Directory (Dir : Virtual_File);
255
436
   --  Ensures that the file is a directory: add directory separator if
256
437
   --  needed.
257
438
 
258
439
   function Get_Root (File : Virtual_File) return Virtual_File;
259
 
   --  returns root directory of the file
 
440
   --  Return root directory of the file
260
441
 
261
442
   function Get_Parent (Dir : Virtual_File) return Virtual_File;
262
 
   --  return the parent directory if it exists, else No_File is returned
 
443
   --  Return the parent directory if it exists, else No_File is returned
263
444
 
264
 
   function Sub_Dir (Dir : Virtual_File; Name : String) return Virtual_File;
265
 
   --  returns sub directory Name if it exists, else No_File is returned
 
445
   function Sub_Dir
 
446
     (Dir : Virtual_File; Name : Filesystem_String) return Virtual_File;
 
447
   --  Return sub directory Name if it exists, else No_File is returned
266
448
 
267
449
   procedure Change_Dir (Dir : Virtual_File);
268
450
   --  Changes working directory. Raises Directory_Error if Dir_Name does not
283
465
   --  structure, including . (the current directory) and .. (the parent
284
466
   --  directory) in systems providing these entries.
285
467
 
 
468
   procedure Remove_Dir
 
469
     (Dir       : Virtual_File;
 
470
      Recursive : Boolean := False;
 
471
      Success   : out Boolean);
 
472
   --  Delete the directory Dir. If recursive is True, this also removes all
 
473
   --  files or subdirectories contained in it.
 
474
 
 
475
   function Read_Files_From_Dirs
 
476
     (Dirs : File_Array) return File_Array_Access;
 
477
   --  Read all files from the list of directories Dirs
 
478
 
286
479
   type Virtual_Dir is private;
287
480
 
288
481
   Invalid_Dir : constant Virtual_Dir;
329
522
   --  Closes File, and write the file to disk.
330
523
   --  Use_Error is raised if the file could not be saved.
331
524
 
 
525
   ----------------------------------
 
526
   -- Some internally used methods --
 
527
   ----------------------------------
 
528
 
 
529
   function Convert
 
530
     (File : Virtual_File; To_Host : String) return Virtual_File;
 
531
   function Convert
 
532
     (File     : Virtual_File;
 
533
      From_Dir : Virtual_File;
 
534
      To_Dir   : Virtual_File) return Virtual_File;
 
535
   --  Used in mount path conversions. These should be private, but can't
 
536
   --  as of RM 3.9.3(10)
 
537
 
332
538
private
333
539
   --  This type is implemented as a controlled type, to ease the memory
334
540
   --  management (so that we can have gtk+ callbacks that take a Virtual
337
543
   --  not work properly, since the functions above cannot modify File
338
544
   --  itself, although they do compute some information lazily).
339
545
 
340
 
   type File_Type is
341
 
     (Unknown,
342
 
      --  File is not determined
343
 
      File,
344
 
      --  Regular file
345
 
      Directory
346
 
      --  Directory
347
 
      );
348
 
 
349
 
   type Contents_Record is record
350
 
      FS              : GNATCOLL.Filesystem.Filesystem_Access;
351
 
      Ref_Count       : Natural := 1;
352
 
      Full_Name       : GNAT.Strings.String_Access;
353
 
      Normalized_Full : GNAT.Strings.String_Access;
354
 
      Dir_Name        : GNAT.Strings.String_Access;
355
 
      Kind            : File_Type := Unknown;
356
 
   end record;
357
 
   type Contents_Access is access Contents_Record;
358
 
 
359
546
   type Virtual_File is new Ada.Finalization.Controlled with record
360
 
      Value : Contents_Access;
 
547
      Value : GNATCOLL.IO.File_Access;
361
548
   end record;
362
549
 
363
550
   pragma Finalize_Storage_Only (Virtual_File);
367
554
   type Writable_File is record
368
555
      File     : Virtual_File;
369
556
      FD       : GNAT.OS_Lib.File_Descriptor := GNAT.OS_Lib.Invalid_FD;
370
 
      Filename : GNAT.Strings.String_Access;
371
557
      Append   : Boolean;
372
558
   end record;
373
559
 
374
560
   Invalid_File : constant Writable_File :=
375
561
     ((Ada.Finalization.Controlled with Value => null),
376
 
      GNAT.OS_Lib.Invalid_FD, null, False);
 
562
      GNAT.OS_Lib.Invalid_FD, False);
377
563
 
378
564
   type Virtual_Dir is record
379
565
      File       : Virtual_File;
381
567
      Current    : Natural;
382
568
   end record;
383
569
 
 
570
   Local_Host : aliased constant String := "";
 
571
 
384
572
   Local_Root_Dir : constant Virtual_File :=
385
 
     (Ada.Finalization.Controlled with Value => new Contents_Record'(
386
 
        FS              => GNATCOLL.Filesystem.Get_Local_Filesystem,
387
 
        Ref_Count       => 1,
388
 
        Full_Name       => new String'(1 => GNAT.OS_Lib.Directory_Separator),
389
 
        Normalized_Full => new String'(1 => GNAT.OS_Lib.Directory_Separator),
390
 
        Dir_Name        => new String'(1 => GNAT.OS_Lib.Directory_Separator),
391
 
        Kind            => Directory));
 
573
                      (Ada.Finalization.Controlled with
 
574
                       Value => GNATCOLL.IO.Native.Local_Root_Dir);
392
575
 
393
 
   No_File : constant Virtual_File :=
 
576
   No_File : aliased constant Virtual_File :=
394
577
     (Ada.Finalization.Controlled with Value => null);
395
578
 
396
579
   Empty_File_Array : constant File_Array :=
401
584
      null,
402
585
      0);
403
586
 
404
 
   procedure Finalize (Value : in out Contents_Access);
405
 
   --  Internal version of Finalize
406
 
 
407
587
end GNATCOLL.VFS;