← Back to branch summary

~ubuntu-branches/ubuntu/precise/topal/precise

« back to all changes in this revision

Viewing changes to attachments.adb

  • Committer: Bazaar Package Importer
  • Author(s): Phil Brooke
  • Date: 2008-07-18 07:57:38 UTC
  • mto: This revision was merged to the branch mainline in revision 3.
  • Revision ID: james.westby@ubuntu.com-20080718075738-i1szqvmxz0evz32p
Tags: upstream-62
Import upstream version 62

Show diffs side-by-side

added added

removed removed

Lines of Context:
attachments.adb
1
 
--
2
 
--
3
 
--
4
 
--
 
1
-- Topal: GPG/GnuPG and Alpine/Pine integration
 
2
-- Copyright (C) 2001--2008  Phillip J. Brooke
 
3
--
 
4
-- This program is free software: you can redistribute it and/or modify
 
5
-- it under the terms of the GNU General Public License version 3 as
 
6
-- published by the Free Software Foundation.
 
7
--
 
8
-- This program is distributed in the hope that it will be useful,
 
9
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
11
-- GNU General Public License for more details.
 
12
--
 
13
-- You should have received a copy of the GNU General Public License
 
14
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
5
15
 
6
 
with Ada.IO_Exceptions;
7
 
with Ada.Strings.Fixed;
8
 
with Ada.Strings.Unbounded;
9
16
with Ada.Text_IO;
10
 
with Configuration;
11
 
with Expanding_Array;
12
17
with Externals;             use Externals;
13
18
with Externals.Mail;
14
19
with Externals.Simple;
110
102
         A_Menu := new Attachlist_Menus.MNA(1..List.Count);
111
103
         for I in 1..List.Count loop
112
104
            declare
113
 
               S : String := ToStr(UAP.Value(List.AA, I));
 
105
               S : constant String := ToStr(UAP.Value(List.AA, I));
114
106
            begin
115
107
               if S'Length < A_Head_Length then
116
108
                  A_Menu(I) := ToUBS(S);
137
129
      Generate_A_List;
138
130
  List_Keys_Loop:
139
131
      loop
 
132
         Ada.Text_IO.New_Line(5);
 
133
         Ada.Text_IO.Put_Line("** Attachment menu:");
 
134
         Ada.Text_IO.Put_Line(Integer'Image(Attachments.Count(List))
 
135
                              & " attachment(s)");
140
136
         Selection := Attachlist_Menu(A_Menu.all);
141
137
         if not Selection.Is_Num then
142
138
            case Selection.I is
155
151
                                                    Enable_Tab_Completion => True));
156
152
                     -- Deal with the last space that we'll often get.
157
153
                     declare
158
 
                        NFN : String := ToStr(New_Filename);
 
154
                        NFN : constant String := ToStr(New_Filename);
159
155
                     begin
160
156
                        if NFN(NFN'Last) = ' ' then
161
157
                           Alt_Filename := ToUBS(NFN(NFN'First..NFN'Last-1));
191
187
         raise;
192
188
   end List;
193
189
 
194
 
   procedure Empty_Attachmentlist (List : in out Attachment_List) is
 
190
   procedure Empty_Attachment_List (List : in out Attachment_List) is
195
191
   begin
196
192
      UAP.Create(List.AA, Attachment_List_Initial_Size);
197
193
      List.Count := 0;
198
194
   exception
199
195
      when others =>
200
196
         Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error,
201
 
                              "Exception raised in Attachments.Empty_Attachmentlist");
 
197
                              "Exception raised in Attachments.Empty_Attachment_List");
202
198
         raise;
203
 
   end;
 
199
   end Empty_Attachment_List;
204
200
 
205
201
   function Count (List : in Attachment_List) return Natural is
206
202
   begin
213
209
   end Count;
214
210
 
215
211
   procedure Replace_Tmpfile (Tmpfile           : in String;
216
 
                              List              : in out Attachment_List;
217
 
                              Internal_Mimetype :    out UBS) is
 
212
                              List              : in Attachment_List) is
218
213
      AL : UBS_Array(1..Count(List)+1);
219
 
      TF : String := Temp_File_Name("attrtf");
 
214
      BF : constant String := Temp_File_Name("att64-");
 
215
      TF : constant String := Temp_File_Name("attrtf");
 
216
      CT : UBS;
220
217
   begin
221
218
      -- Do nothing if the attachment list is empty.
222
219
      if List.Count /= 0 then
223
220
         -- Now, construct a list of items.
224
221
         AL(1) := ToUBS(Tmpfile);
225
222
         for I in 1..List.Count loop
226
 
            AL(I+1) := UAP.Value(List.AA, I);
 
223
            -- Guess the content type.
 
224
            CT := ToUBS(Externals.Simple.Guess_Content_Type(ToStr(UAP.Value(List.AA, I))) & "; name="""&Basename(ToStr(UAP.Value(List.AA, I)))&"""");
 
225
            -- Create a base64 subpart.
 
226
            Externals.Mail.Mimeconstruct_Subpart(Infile => ToStr(UAP.Value(List.AA, I)),
 
227
                                                 Outfile => BF & Trim_Leading_Spaces(Integer'Image(I)),
 
228
                                                 Content_Type => ToStr(CT),
 
229
                                                 Dos2UnixU => True,
 
230
                                                 Use_Header => False,
 
231
                                                 Header => "Content-Type: " & ToStr(CT),
 
232
                                                 Use_Encoding => True,
 
233
                                                 Encoding => "base64");
 
234
            -- Add the base64's file to the list.
 
235
            AL(I+1) := ToUBS(BF & Trim_Leading_Spaces(Integer'Image(I)));
 
236
            Ada.Text_IO.Put_Line("Added file `"&ToStr(UAP.Value(List.AA, I))&"' with content-type `"&ToStr(CT)&"'");
227
237
         end loop;
228
238
         -- And call mimeconstruct.
229
239
         Externals.Mail.Mimeconstruct_Mixed(AL, TF);
230
240
         -- Then replace the original tmpfile.
231
 
         Externals.Mail.Extract_Body(TF, Tmpfile);
232
 
         -- We guess that the mimetype is in fact multipart/mixed.
233
 
      else
234
 
         Internal_Mimetype := ToUBS("");
 
241
         Externals.Simple.Mv_F(TF, Tmpfile);
 
242
         -- Convert to CR-LF line endings.
 
243
         Externals.Simple.Dos2Unix_U(Tmpfile);
235
244
      end if;
236
245
   exception
237
246
      when others =>