← Back to branch summary

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

« back to all changes in this revision

Viewing changes to gps/src/welcome.adb

  • 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:
gps/src/welcome.adb
1
1
-----------------------------------------------------------------------
2
2
--                               G P S                               --
3
3
--                                                                   --
 
4
--                 Copyright (C) 2001-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 --
40
40
 
41
41
with Config;
42
42
with GPS.Kernel;                use GPS.Kernel;
 
43
with GPS.Kernel.MDI;            use GPS.Kernel.MDI;
43
44
with GPS.Kernel.Preferences;    use GPS.Kernel.Preferences;
44
45
with GPS.Kernel.Project;        use GPS.Kernel.Project;
45
46
with GPS.Intl;                  use GPS.Intl;
46
47
with Logo_Boxes;                use Logo_Boxes;
47
48
with Histories;                 use Histories;
 
49
with Project_Templates.GPS;
48
50
with Creation_Wizard.Selector;  use Creation_Wizard.Selector;
49
 
with GNATCOLL.VFS;                       use GNATCOLL.VFS;
50
 
with Projects;                  use Projects;
 
51
with GNATCOLL.Projects;         use GNATCOLL.Projects;
 
52
with GNATCOLL.VFS;              use GNATCOLL.VFS;
 
53
with GNATCOLL.VFS_Utils;        use GNATCOLL.VFS_Utils;
51
54
with Traces;                    use Traces;
52
55
 
53
56
package body Welcome is
119
122
      Pack_Start (Get_Contents (Screen), Box, Expand => True, Fill => True);
120
123
      Set_Border_Width (Box, 10);
121
124
 
 
125
      --  Project templates
 
126
 
 
127
      Gtk_New
 
128
        (Screen.Project_Templates,
 
129
         Label => -"Create new project from template");
 
130
      Pack_Start (Box, Screen.Project_Templates, Expand => False);
 
131
      Set_Tip
 
132
        (Get_Tooltips (Kernel), Screen.Project_Templates,
 
133
         -"Create a new project using the Project Templates assistant.");
 
134
 
122
135
      --  Default project
123
136
 
 
137
      Gtk_New_Hseparator (Sep);
 
138
      Pack_Start (Box, Sep, Expand => False, Padding => 5);
 
139
 
124
140
      Gtk_New
125
141
        (Screen.Default_Project,
 
142
         Group => Screen.Project_Templates,
126
143
         Label => -"Start with default project in directory:");
127
144
      Pack_Start (Box, Screen.Default_Project, Expand => False);
128
145
      Set_Tip
157
174
 
158
175
      Gtk_New
159
176
        (Screen.Create_Project,
160
 
         Screen.Default_Project,
 
177
         Screen.Project_Templates,
161
178
         -"Create new project with wizard");
162
179
      Pack_Start (Box, Screen.Create_Project, Expand => False);
163
180
      Set_Tip
176
193
 
177
194
      Gtk_New
178
195
        (Screen.Open_Project_Button,
179
 
         Screen.Create_Project,
 
196
         Screen.Project_Templates,
180
197
         -"Open existing project:");
181
198
      Pack_Start (Box, Screen.Open_Project_Button, Expand => False);
182
199
      Set_Tip
198
215
 
199
216
      if Project_Name /= No_File then
200
217
         Set_Text
201
 
           (Get_Entry (Screen.Open_Project),
202
 
            Full_Name (Project_Name, Normalize => False).all);
 
218
           (Gtk_Entry (Get_Entry (Screen.Open_Project)),
 
219
            Display_Full_Name (Project_Name, Normalize => False));
 
220
         --  ??? What if the filesystem path is non-UTF8?
203
221
      end if;
204
222
 
205
223
      Gtk_New (Screen.Open_Browse, -"Browse");
208
226
      Widget_Callback.Object_Connect
209
227
        (Screen.Open_Browse, Signal_Clicked, On_Browse_Load'Access, Screen);
210
228
 
211
 
      if Get_Text (Get_Entry (Screen.Open_Project)) = "" then
 
229
      if Get_Text (Gtk_Entry (Get_Entry (Screen.Open_Project))) = "" then
212
230
         Clicked (Screen.Default_Project);
213
231
      else
214
232
         Clicked (Screen.Open_Project_Button);
276
294
                  return Project_Loaded;
277
295
               end if;
278
296
 
 
297
            elsif Get_Active (Screen.Project_Templates) then
 
298
               --  First load the default project: this is needed as a fallback
 
299
               --  resource in case the pre-script hook fails, for instance.
 
300
               On_Default_Project (Screen);
 
301
               Hide_All (Screen);
 
302
               declare
 
303
                  Cancelled : Boolean;
 
304
               begin
 
305
                  Project_Templates.GPS.Launch_Dialog
 
306
                    (Screen.Kernel, Gtk_Widget (Screen), Cancelled);
 
307
 
 
308
                  if Cancelled then
 
309
                     Show_All (Screen);
 
310
                  else
 
311
                     return Project_Loaded;
 
312
                  end if;
 
313
               end;
279
314
            else
280
 
               --  A new project was loaded.
 
315
               --  A new project was loaded
281
316
               return Project_Loaded;
282
317
            end if;
283
318
         else
309
344
   procedure On_Default_Project (Screen : access Gtk_Widget_Record'Class) is
310
345
      S : constant Welcome_Screen := Welcome_Screen (Screen);
311
346
   begin
312
 
      Load_Default_Project (S.Kernel, Create (Get_Text (S.Default_Dir)));
 
347
      Load_Default_Project
 
348
        (S.Kernel, Create (+Get_Text (S.Default_Dir)),
 
349
         Clear => False);
 
350
      --  ??? What if the filesystem path is non-UTF8?
313
351
      Response (S, Gtk_Response_OK);
314
352
 
315
353
   exception
325
363
   is
326
364
      S            : constant Welcome_Screen := Welcome_Screen (Screen);
327
365
      Project_Name : Virtual_File := Create
328
 
        (Get_Text (Get_Entry (S.Open_Project)));
 
366
        (+Get_Text (Gtk_Entry (Get_Entry (S.Open_Project))));
 
367
      --  ??? What if the filesystem path is non-UTF8?
329
368
      Button       : Message_Dialog_Buttons;
330
369
      pragma Unreferenced (Button);
331
370
 
332
371
   begin
333
372
      Response (S, Gtk_Response_OK);
334
373
 
335
 
      if File_Extension (Project_Name) /= Project_File_Extension then
 
374
      if not Equal (File_Extension (Project_Name), Project_File_Extension) then
336
375
         Project_Name := Create
337
 
           (Full_Name (Project_Name).all & Project_File_Extension);
 
376
           (Full_Name (Project_Name) & Project_File_Extension);
338
377
      end if;
339
378
 
340
379
      if not Is_Regular_File (Project_Name) then
341
380
         Button := Message_Dialog
342
381
           ((-"Project file ")
343
 
            & Full_Name (Project_Name).all & (-" doesn't exist"),
 
382
            & Display_Full_Name (Project_Name) & (-" doesn't exist"),
344
383
            Error, Button_OK, Parent => Gtk_Window (S));
345
384
         return False;
346
385
      end if;
353
392
      when E : others => Trace (Exception_Handle, E);
354
393
         Button := Message_Dialog
355
394
           ((-"Project file ")
356
 
            & Full_Name (Project_Name).all & (-" couldn't be loaded"),
 
395
            & Display_Full_Name (Project_Name) & (-" couldn't be loaded"),
357
396
            Error, Button_OK, Parent => Gtk_Window (S));
358
397
         return False;
359
398
   end On_Load_Project;
366
405
      S : constant Welcome_Screen := Welcome_Screen (Screen);
367
406
      Dir : constant Virtual_File := Select_Directory
368
407
        (Title             => -"Select a directory",
369
 
         Base_Directory    => Create (Get_Text (S.Default_Dir)),
 
408
         Base_Directory    => Create (+Get_Text (S.Default_Dir)),
 
409
         --  ??? What if the filesystem path is non-UTF8?
370
410
         Parent            => Gtk_Window (S),
371
411
         Use_Native_Dialog => Use_Native_Dialogs.Get_Pref,
372
412
         History           => Get_History (S.Kernel));
373
413
   begin
374
414
      if Dir /= No_File then
375
 
         Set_Text (S.Default_Dir, Full_Name (Dir).all);
 
415
         Set_Text (S.Default_Dir, Display_Full_Name (Dir));
376
416
      end if;
377
417
 
378
418
   exception
385
425
 
386
426
   procedure On_Browse_Load (Screen : access Gtk_Widget_Record'Class) is
387
427
      S            : constant Welcome_Screen := Welcome_Screen (Screen);
388
 
      Project_Name : constant String := Get_Text (Get_Entry (S.Open_Project));
 
428
      Project_Name : constant Filesystem_String :=
 
429
        +Get_Text (Gtk_Entry (Get_Entry (S.Open_Project)));
 
430
      --  ??? What if the filesystem path is non-UTF8?
389
431
      Dir          : Virtual_File;
390
432
   begin
391
433
      Push_State (S.Kernel, Busy);
392
 
      if Project_Name = "" then
393
 
         Dir := Create (Get_Text (S.Default_Dir));
 
434
      if Project_Name'Length > 0 then
 
435
         Dir := Create (+Get_Text (S.Default_Dir));
394
436
      else
395
437
         Dir := Create (Dir_Name (Project_Name));
396
438
      end if;
408
450
 
409
451
      begin
410
452
         if File /= GNATCOLL.VFS.No_File then
411
 
            Set_Text (Get_Entry (S.Open_Project), Full_Name (File).all);
 
453
            Set_Text (Gtk_Entry (Get_Entry (S.Open_Project)), Display_Full_Name (File));
412
454
         end if;
413
455
      end;
414
456