← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ad-options.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-options.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
--   Global storage of file names.</DL>
 
28
--
 
29
-- <!--
 
30
-- Revision History
 
31
--
 
32
--   09-AUG-2002   TW  Initial version.
 
33
-- -->
 
34
-------------------------------------------------------------------------------
 
35
 
 
36
pragma License (GPL);
 
37
 
 
38
with Ada.Strings.Unbounded;
 
39
 
 
40
with Util.Pathes;
 
41
 
 
42
package body AD.Options is
 
43
 
 
44
   package ASU renames Ada.Strings.Unbounded;
 
45
 
 
46
   Do_Private_Parts : Boolean := False;
 
47
 
 
48
   procedure Set_Private_Too
 
49
     (Flag : in Boolean)
 
50
   is
 
51
   begin
 
52
      Do_Private_Parts := Flag;
 
53
   end Set_Private_Too;
 
54
 
 
55
   function Private_Too
 
56
     return Boolean
 
57
   is
 
58
   begin
 
59
      return Do_Private_Parts;
 
60
   end Private_Too;
 
61
 
 
62
   Overwrite         : Boolean       := True;
 
63
   Mode              : File_Handling := Single_File;
 
64
   Out_File, Out_Dir : ASU.Unbounded_String;
 
65
 
 
66
   procedure Set_Output_Name
 
67
     (Name : in String)
 
68
   is
 
69
   begin
 
70
      if Util.Pathes.Name (Name) /= "" then
 
71
         Out_File := ASU.To_Unbounded_String (Name);
 
72
      else
 
73
         Out_File := ASU.Null_Unbounded_String;
 
74
      end if;
 
75
      declare
 
76
         S : constant String := Util.Pathes.Path (Name);
 
77
      begin
 
78
         if S'Last >= S'First then
 
79
            Out_Dir := ASU.To_Unbounded_String (S);
 
80
         else
 
81
            Out_Dir := ASU.Null_Unbounded_String;
 
82
         end if;
 
83
      end;
 
84
   end Set_Output_Name;
 
85
 
 
86
   procedure Set_Output_Directory
 
87
     (Name : in String)
 
88
   is
 
89
   begin
 
90
      Out_Dir := ASU.To_Unbounded_String (Util.Pathes.Path (Name));
 
91
   end Set_Output_Directory;
 
92
 
 
93
   function Output_Name
 
94
     return String
 
95
   is
 
96
   begin
 
97
      return ASU.To_String (Out_File);
 
98
   end Output_Name;
 
99
 
 
100
   function Output_Directory
 
101
     return String
 
102
   is
 
103
   begin
 
104
      return ASU.To_String (Out_Dir);
 
105
   end Output_Directory;
 
106
 
 
107
   procedure Set_Processing_Mode
 
108
     (To : in File_Handling)
 
109
   is
 
110
   begin
 
111
      Mode := To;
 
112
   end Set_Processing_Mode;
 
113
 
 
114
   function Processing_Mode
 
115
     return File_Handling
 
116
   is
 
117
   begin
 
118
      return Mode;
 
119
   end Processing_Mode;
 
120
 
 
121
   procedure Set_Overwrite
 
122
     (Allowed : in Boolean)
 
123
   is
 
124
   begin
 
125
      Overwrite := Allowed;
 
126
   end Set_Overwrite;
 
127
 
 
128
   function Allow_Overwrite
 
129
     return Boolean
 
130
   is
 
131
   begin
 
132
      return Overwrite;
 
133
   end Allow_Overwrite;
 
134
 
 
135
end AD.Options;
 
136
 
 
137