← Back to branch summary

~ubuntu-branches/ubuntu/maverick/gnat-gps/maverick

« back to all changes in this revision

Viewing changes to .pc/libgtkada2-2.14.2.patch/prj_editor/src/project_explorers_common.adb

  • Committer: Bazaar Package Importer
  • Author(s): Matthias Klose
  • Date: 2010-03-15 15:12:34 UTC
  • mfrom: (10.1.3 sid)
  • Revision ID: james.westby@ubuntu.com-20100315151234-2qyonhb0vh6wxb17
Tags: 4.3-5ubuntu1
BUild on armel.

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/libgtkada2-2.14.2.patch/prj_editor/src/project_explorers_common.adb
 
1
-----------------------------------------------------------------------
 
2
--                               G P S                               --
 
3
--                                                                   --
 
4
--                 Copyright (C) 2001-2008, AdaCore                  --
 
5
--                                                                   --
 
6
-- GPS is free  software;  you can redistribute it and/or modify  it --
 
7
-- under the terms of the GNU General Public License as published by --
 
8
-- the Free Software Foundation; either version 2 of the License, or --
 
9
-- (at your option) any later version.                               --
 
10
--                                                                   --
 
11
-- This program is  distributed in the hope that it will be  useful, --
 
12
-- but  WITHOUT ANY WARRANTY;  without even the  implied warranty of --
 
13
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
 
14
-- General Public License for more details. You should have received --
 
15
-- a copy of the GNU General Public License along with this program; --
 
16
-- if not,  write to the  Free Software Foundation, Inc.,  59 Temple --
 
17
-- Place - Suite 330, Boston, MA 02111-1307, USA.                    --
 
18
-----------------------------------------------------------------------
 
19
 
 
20
with Ada.Containers;            use Ada.Containers;
 
21
with Ada.Containers.Indefinite_Hashed_Maps;
 
22
with Ada.Calendar;              use Ada.Calendar;
 
23
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
 
24
with GNAT.Strings;              use GNAT.Strings;
 
25
 
 
26
with Gdk.Pixbuf;                use Gdk.Pixbuf;
 
27
with Gdk.Types.Keysyms;         use Gdk.Types.Keysyms;
 
28
with Gtk.Enums;                 use Gtk.Enums;
 
29
with Gtk.Tree_Selection;        use Gtk.Tree_Selection;
 
30
with Glib.Convert;              use Glib.Convert;
 
31
 
 
32
with Basic_Types;               use Basic_Types;
 
33
with Entities;                  use Entities;
 
34
with GPS.Kernel.Contexts;       use GPS.Kernel.Contexts;
 
35
with GPS.Kernel.Project;        use GPS.Kernel.Project;
 
36
with GPS.Kernel.Standard_Hooks; use GPS.Kernel.Standard_Hooks;
 
37
with GPS.Intl;                  use GPS.Intl;
 
38
with GUI_Utils;                 use GUI_Utils;
 
39
with HTables;
 
40
with Language.Unknown;          use Language.Unknown;
 
41
with Language.Icons;            use Language.Icons;
 
42
with Language_Handlers;         use Language_Handlers;
 
43
with Projects.Registry;         use Projects, Projects.Registry;
 
44
with String_Utils;              use String_Utils;
 
45
with Traces;                    use Traces;
 
46
with Namet;                     use Namet;
 
47
with GNATCOLL.Utils;            use GNATCOLL.Utils;
 
48
with GNATCOLL.VFS;              use GNATCOLL.VFS;
 
49
 
 
50
package body Project_Explorers_Common is
 
51
 
 
52
   Me : constant Debug_Handle := Create ("Project_Explorers_Common");
 
53
 
 
54
   -------------------
 
55
   -- Columns_Types --
 
56
   -------------------
 
57
 
 
58
   function Columns_Types return GType_Array is
 
59
   begin
 
60
      return GType_Array'
 
61
        (Icon_Column          => Gdk.Pixbuf.Get_Type,
 
62
         Absolute_Name_Column => GType_String,
 
63
         Base_Name_Column     => GType_String,
 
64
         Node_Type_Column     => GType_Int,
 
65
         User_Data_Column     => GType_Pointer,
 
66
         Line_Column          => GType_Int,
 
67
         Column_Column        => GType_Int,
 
68
         Project_Column       => GType_Int,
 
69
         Category_Column      => GType_Int,
 
70
         Up_To_Date_Column    => GType_Boolean,
 
71
         Entity_Base_Column   => GType_String,
 
72
         Timestamp_Column     => GType_Int);
 
73
   end Columns_Types;
 
74
 
 
75
   -------------------
 
76
   -- Init_Graphics --
 
77
   -------------------
 
78
 
 
79
   procedure Init_Graphics (Widget : Gtk_Widget) is
 
80
 
 
81
      function R (Id : String) return Gdk_Pixbuf;
 
82
      --  Convenience function: create the Gdk_Pixbuf from stock Id
 
83
 
 
84
      -------
 
85
      -- R --
 
86
      -------
 
87
 
 
88
      function R (Id : String) return Gdk_Pixbuf is
 
89
      begin
 
90
         return Render_Icon (Widget, Id, Icon_Size_Menu);
 
91
      end R;
 
92
 
 
93
   begin
 
94
      --  If initialization has already been done, exit
 
95
      if Open_Pixbufs (Project_Node) /= null then
 
96
         return;
 
97
      end if;
 
98
 
 
99
      Language.Icons.Init_Graphics (Widget);
 
100
 
 
101
      Open_Pixbufs (Project_Node)  := R ("gps-project-open");
 
102
      Close_Pixbufs (Project_Node) := R ("gps-project-closed");
 
103
 
 
104
      Open_Pixbufs (Modified_Project_Node)  := R ("gps-project-modified-open");
 
105
      Close_Pixbufs (Modified_Project_Node) :=
 
106
        R ("gps-project-modified-closed");
 
107
 
 
108
      --  ??? Would be nice to have different pixbufs for these
 
109
      Open_Pixbufs (Extends_Project_Node)  := R ("gps-project-open");
 
110
      Close_Pixbufs (Extends_Project_Node) := R ("gps-project-closed");
 
111
 
 
112
      Open_Pixbufs (Directory_Node)  := R ("gps-folder-open");
 
113
      Close_Pixbufs (Directory_Node) := R ("gps-folder-closed");
 
114
      Open_Pixbufs (Obj_Directory_Node)  := R ("gps-folder-obj-open");
 
115
      Close_Pixbufs (Obj_Directory_Node) := R ("gps-folder-obj-closed");
 
116
 
 
117
      Open_Pixbufs (Exec_Directory_Node)  := R ("gps-folder-exec-open");
 
118
      Close_Pixbufs (Exec_Directory_Node) := R ("gps-folder-exec-closed");
 
119
      Open_Pixbufs (File_Node)  := R ("gps-file");
 
120
      Close_Pixbufs (File_Node) := R ("gps-file");
 
121
 
 
122
      Open_Pixbufs (Category_Node)  := R ("gps-box");
 
123
      Close_Pixbufs (Category_Node) := R ("gps-box");
 
124
   end Init_Graphics;
 
125
 
 
126
   -----------------
 
127
   -- Append_File --
 
128
   -----------------
 
129
 
 
130
   procedure Append_File
 
131
     (Kernel : Kernel_Handle;
 
132
      Model  : Gtk_Tree_Store;
 
133
      Base   : Gtk_Tree_Iter;
 
134
      File   : GNATCOLL.VFS.Virtual_File;
 
135
      Sorted : Boolean := False)
 
136
   is
 
137
      Iter  : Gtk_Tree_Iter;
 
138
      Iter2 : Gtk_Tree_Iter;
 
139
      Lang  : Language_Access;
 
140
      Done  : Boolean;
 
141
   begin
 
142
      if Sorted then
 
143
         Iter := Children (Model, Base);
 
144
         Done := False;
 
145
 
 
146
         while Iter /= Null_Iter loop
 
147
            Iter2 := Iter;
 
148
 
 
149
            if Get_Node_Type (Model, Iter) = File_Node then
 
150
               declare
 
151
                  Name : constant String := Get_Base_Name (Model, Iter);
 
152
               begin
 
153
                  if Name > File.Base_Name then
 
154
                     Insert_Before (Model, Iter2, Base, Iter);
 
155
                     Iter := Iter2;
 
156
                     Done := True;
 
157
 
 
158
                     exit;
 
159
                  end if;
 
160
               end;
 
161
            end if;
 
162
 
 
163
            Next (Model, Iter);
 
164
         end loop;
 
165
 
 
166
         if not Done then
 
167
            Append (Model, Iter, Base);
 
168
         end if;
 
169
      else
 
170
 
 
171
         Append (Model, Iter, Base);
 
172
      end if;
 
173
 
 
174
      Set (Model, Iter, Absolute_Name_Column, Full_Name (File).all);
 
175
      Set (Model, Iter, Base_Name_Column, Base_Name (File));
 
176
      Set (Model, Iter, Icon_Column, C_Proxy (Close_Pixbufs (File_Node)));
 
177
      Set (Model, Iter, Node_Type_Column, Gint (Node_Types'Pos (File_Node)));
 
178
      Set (Model, Iter, Up_To_Date_Column, False);
 
179
 
 
180
      Lang := Get_Language_From_File
 
181
        (Language_Handler (Get_Language_Handler (Kernel)), File);
 
182
 
 
183
      if Lang /= Unknown_Lang then
 
184
         Append_Dummy_Iter (Model, Iter);
 
185
      end if;
 
186
   end Append_File;
 
187
 
 
188
   -----------------------
 
189
   -- Append_Dummy_Iter --
 
190
   -----------------------
 
191
 
 
192
   procedure Append_Dummy_Iter
 
193
     (Model : Gtk_Tree_Store;
 
194
      Base  : Gtk_Tree_Iter)
 
195
   is
 
196
      Iter : Gtk_Tree_Iter;
 
197
   begin
 
198
      Append (Model, Iter, Base);
 
199
      Set_Node_Type (Model, Iter, Entity_Node, Expanded => False);
 
200
   end Append_Dummy_Iter;
 
201
 
 
202
   --------------------------
 
203
   -- Append_Category_Node --
 
204
   --------------------------
 
205
 
 
206
   function Append_Category_Node
 
207
     (Model         : Gtk_Tree_Store;
 
208
      File          : GNATCOLL.VFS.Virtual_File;
 
209
      Category      : Language_Category;
 
210
      Category_Name : Strings.String_Access;
 
211
      Parent_Iter   : Gtk_Tree_Iter) return Gtk_Tree_Iter
 
212
   is
 
213
      Name    : constant String :=
 
214
                  Language.Category_Name (Category, Category_Name);
 
215
      N       : Gtk_Tree_Iter;
 
216
      Sibling : Gtk_Tree_Iter;
 
217
   begin
 
218
      Sibling := Children (Model, Parent_Iter);
 
219
 
 
220
      if Sibling = Null_Iter then
 
221
         Append (Model, N, Parent_Iter);
 
222
      else
 
223
         while Sibling /= Null_Iter
 
224
           and then Get_String (Model, Sibling, Base_Name_Column) <= Name
 
225
         loop
 
226
            Next (Model, Sibling);
 
227
         end loop;
 
228
 
 
229
         if Sibling = Null_Iter then
 
230
            Append (Model, N, Parent_Iter);
 
231
         else
 
232
            Insert_Before (Model, N, Parent_Iter, Sibling);
 
233
         end if;
 
234
      end if;
 
235
 
 
236
      Set (Model, N, Absolute_Name_Column, Display_Full_Name (File));
 
237
      Set (Model, N, Base_Name_Column, Locale_To_UTF8 (Name));
 
238
      Set (Model, N, Icon_Column,
 
239
           C_Proxy (Entity_Icons (False, Visibility_Public) (Category)));
 
240
      Set (Model, N, Node_Type_Column, Gint (Node_Types'Pos (Category_Node)));
 
241
      Set (Model, N, Up_To_Date_Column, True);
 
242
      Set (Model, N, Category_Column, Language_Category'Pos (Category));
 
243
 
 
244
      return N;
 
245
   end Append_Category_Node;
 
246
 
 
247
   --------------------
 
248
   -- Entity_Name_Of --
 
249
   --------------------
 
250
 
 
251
   function Entity_Name_Of
 
252
     (Construct          : Construct_Information;
 
253
      Show_Profiles      : Boolean;
 
254
      Max_Profile_Length : Positive := Positive'Last) return String
 
255
   is
 
256
 
 
257
      function Escape return String;
 
258
      pragma Inline (Escape);
 
259
      --  Escape Construct.Name.all as a pango markup string.
 
260
      --  The characters which need to be escaped in pango markup language are
 
261
      --  '&', '<', '>', '\', and '"'.
 
262
      --  The code here assumes that Entity names, in any language, can only
 
263
      --  contain '&', '<', '>', or '"'  and that if it does, one of these
 
264
      --  characters is necessarily in the first position, for the overloading
 
265
      --  of operators such as '<' or '&&', or for a quoted name.
 
266
 
 
267
      ------------
 
268
      -- Escape --
 
269
      ------------
 
270
 
 
271
      function Escape return String is
 
272
         C : Character;
 
273
      begin
 
274
         if Construct.Name.all = "" then
 
275
            return "";
 
276
         end if;
 
277
 
 
278
         C := Construct.Name (Construct.Name'First);
 
279
 
 
280
         if C = '"' or else C = '&' or else C = '<' or else C = '>' then
 
281
            return Escape_Text (Construct.Name.all);
 
282
         else
 
283
            return Construct.Name.all;
 
284
         end if;
 
285
      end Escape;
 
286
 
 
287
      Name : constant String := Reduce (Escape);
 
288
 
 
289
   begin
 
290
      if Show_Profiles and then Construct.Profile /= null then
 
291
         return Name & " <span foreground=""#555555"">"
 
292
           & Escape_Text (Reduce (Construct.Profile.all, Max_Profile_Length))
 
293
           & "</span>";
 
294
      else
 
295
         return Name;
 
296
      end if;
 
297
   end Entity_Name_Of;
 
298
 
 
299
   --------------------
 
300
   -- Entity_Icon_Of --
 
301
   --------------------
 
302
 
 
303
   function Entity_Icon_Of
 
304
     (Construct : Construct_Information) return Gdk_Pixbuf is
 
305
   begin
 
306
      return Entity_Icons
 
307
        (Construct.Is_Declaration, Construct.Visibility) (Construct.Category);
 
308
   end Entity_Icon_Of;
 
309
 
 
310
   ------------------------
 
311
   -- Append_Entity_Node --
 
312
   ------------------------
 
313
 
 
314
   function Append_Entity_Node
 
315
     (Model       : Gtk_Tree_Store;
 
316
      File        : GNATCOLL.VFS.Virtual_File;
 
317
      Construct   : Construct_Information;
 
318
      Parent_Iter : Gtk_Tree_Iter) return Gtk_Tree_Iter
 
319
   is
 
320
      N       : Gtk_Tree_Iter;
 
321
      Sibling : Gtk_Tree_Iter;
 
322
   begin
 
323
      Sibling := Children (Model, Parent_Iter);
 
324
 
 
325
      if Sibling = Null_Iter then
 
326
         Append (Model, N, Parent_Iter);
 
327
      else
 
328
         while Sibling /= Null_Iter
 
329
           and then Get_String (Model, Sibling, Base_Name_Column)
 
330
           <= Construct.Name.all
 
331
         loop
 
332
            Next (Model, Sibling);
 
333
         end loop;
 
334
 
 
335
         if Sibling = Null_Iter then
 
336
            Append (Model, N, Parent_Iter);
 
337
         else
 
338
            Insert_Before (Model, N, Parent_Iter, Sibling);
 
339
         end if;
 
340
      end if;
 
341
 
 
342
      Set (Model, N, Absolute_Name_Column, Display_Full_Name (File));
 
343
      Set (Model, N, Base_Name_Column, Entity_Name_Of (Construct, True));
 
344
      Set (Model, N, Entity_Base_Column, Reduce (Construct.Name.all));
 
345
      Set (Model, N, Icon_Column, C_Proxy (Entity_Icon_Of (Construct)));
 
346
      Set (Model, N, Node_Type_Column, Gint (Node_Types'Pos (Entity_Node)));
 
347
      Set (Model, N, Line_Column, Gint (Construct.Sloc_Entity.Line));
 
348
      Set (Model, N, Column_Column, Gint (Construct.Sloc_Entity.Column));
 
349
      Set (Model, N, Up_To_Date_Column, True);
 
350
      return N;
 
351
   end Append_Entity_Node;
 
352
 
 
353
   ----------------------
 
354
   -- Append_File_Info --
 
355
   ----------------------
 
356
 
 
357
   procedure Append_File_Info
 
358
     (Kernel    : Kernel_Handle;
 
359
      Model     : Gtk_Tree_Store;
 
360
      Node      : Gtk_Tree_Iter;
 
361
      File_Name : GNATCOLL.VFS.Virtual_File)
 
362
   is
 
363
      Languages  : constant Language_Handler :=
 
364
                     Language_Handler (Get_Language_Handler (Kernel));
 
365
 
 
366
      N, N2      : Gtk_Tree_Iter;
 
367
      Iter       : Gtk_Tree_Iter;
 
368
 
 
369
      Lang       : Language_Access;
 
370
      Constructs : Construct_List;
 
371
      Category   : Language_Category;
 
372
 
 
373
      package Iter_Map is new Ada.Containers.Indefinite_Hashed_Maps
 
374
        (Key_Type        => String,
 
375
         Element_Type    => Gtk_Tree_Iter,
 
376
         Hash            => HTables.String_Hash,
 
377
         Equivalent_Keys => "=");
 
378
      use Iter_Map;
 
379
 
 
380
      Categories : Iter_Map.Map;
 
381
      Handler    : LI_Handler;
 
382
 
 
383
      Node_Appended : Boolean := False;
 
384
 
 
385
   begin
 
386
      --  Mark the file information as up-to-date
 
387
 
 
388
      Set (Model, Node, Timestamp_Column,
 
389
           Gint (File_Time_Stamp (File_Name) - GNATCOLL.Utils.No_Time));
 
390
 
 
391
      --  Remove any previous information for this file
 
392
 
 
393
      N := Children (Model, Node);
 
394
 
 
395
      while N /= Null_Iter loop
 
396
         N2 := N;
 
397
         Next (Model, N);
 
398
         Remove (Model, N2);
 
399
      end loop;
 
400
 
 
401
      Handler := Get_LI_Handler_From_File (Languages, File_Name);
 
402
 
 
403
      if Handler = null then
 
404
         return;
 
405
      end if;
 
406
 
 
407
      Push_State (Kernel, Busy);
 
408
 
 
409
      Lang := Get_Language_From_File (Languages, File_Name);
 
410
 
 
411
      if Lang /= null then
 
412
         Parse_File_Constructs
 
413
           (Handler, Languages, File_Name, Constructs);
 
414
 
 
415
         Constructs.Current := Constructs.First;
 
416
 
 
417
         while Constructs.Current /= null loop
 
418
            if Constructs.Current.Name /= null then
 
419
               Category := Filter_Category (Constructs.Current.Category);
 
420
 
 
421
               if Category /= Cat_Unknown
 
422
                 and then Category /= Cat_Parameter
 
423
                 and then Category /= Cat_Field
 
424
               then
 
425
                  declare
 
426
                     Name     : constant String :=
 
427
                                  Category_Name (Category,
 
428
                                                 Constructs.Current.
 
429
                                                   Category_Name);
 
430
                     Cursor   : Iter_Map.Cursor;
 
431
                     New_Iter : Gtk_Tree_Iter;
 
432
 
 
433
                  begin
 
434
                     Cursor := Iter_Map.Find (Categories, Name);
 
435
 
 
436
                     if Cursor = No_Element then
 
437
                        New_Iter :=
 
438
                           Append_Category_Node
 
439
                             (Model,
 
440
                              File_Name,
 
441
                              Category      => Category,
 
442
                              Category_Name =>
 
443
                                Constructs.Current.Category_Name,
 
444
                              Parent_Iter   => Node);
 
445
                        Insert (Categories, Name, New_Iter);
 
446
 
 
447
                     else
 
448
                        New_Iter := Element (Cursor);
 
449
                     end if;
 
450
 
 
451
                     N := Append_Entity_Node
 
452
                       (Model, File_Name, Constructs.Current.all, New_Iter);
 
453
                  end;
 
454
 
 
455
                  Node_Appended := True;
 
456
               end if;
 
457
            end if;
 
458
 
 
459
            Constructs.Current := Constructs.Current.Next;
 
460
         end loop;
 
461
 
 
462
         --  If no node was appended, add a "no entity" node
 
463
 
 
464
         if not Node_Appended then
 
465
            Append (Model, Iter, Node);
 
466
            Set (Model, Iter, Base_Name_Column,
 
467
                 "<span foreground=""#555555"">"
 
468
                 & (-"(no entity)")
 
469
                 & "</span>");
 
470
            Set (Model, Iter, Node_Type_Column,
 
471
                 Gint (Node_Types'Pos (Category_Node)));
 
472
         end if;
 
473
 
 
474
         Free (Constructs);
 
475
      else
 
476
         Trace (Me, "No known language for " & Full_Name (File_Name).all);
 
477
      end if;
 
478
 
 
479
      Pop_State (Kernel);
 
480
   end Append_File_Info;
 
481
 
 
482
   ---------------------
 
483
   -- Filter_Category --
 
484
   ---------------------
 
485
 
 
486
   function Filter_Category
 
487
     (Category : Language_Category) return Language_Category is
 
488
   begin
 
489
      --  No "with", "use", "#include"
 
490
      --  No constructs ("loop", "if", ...)
 
491
 
 
492
      if Category in Dependency_Category
 
493
        or else Category in Construct_Category
 
494
        or else Category = Cat_Representation_Clause
 
495
        or else Category = Cat_Local_Variable
 
496
      then
 
497
         return Cat_Unknown;
 
498
 
 
499
         --  All subprograms are grouped together
 
500
 
 
501
      elsif Category in Subprogram_Explorer_Category then
 
502
         return Cat_Procedure;
 
503
 
 
504
      elsif Category in Type_Category then
 
505
         return Cat_Type;
 
506
 
 
507
      end if;
 
508
 
 
509
      return Category;
 
510
   end Filter_Category;
 
511
 
 
512
   --------------
 
513
   -- Dnd_Data --
 
514
   --------------
 
515
 
 
516
   overriding function Dnd_Data
 
517
     (Child : access MDI_Explorer_Child_Record; Copy : Boolean)
 
518
      return Gtkada.MDI.MDI_Child
 
519
   is
 
520
      C : MDI_Child;
 
521
   begin
 
522
      if Child.Dnd_From_File = GNATCOLL.VFS.No_File then
 
523
         --  So that we can move the explorer itself
 
524
         return MDI_Child (Child);
 
525
 
 
526
      else
 
527
         if Copy then
 
528
            C := Find_MDI_Child_By_Name
 
529
              (Get_MDI (Child.Kernel), Full_Name (Child.Dnd_From_File).all);
 
530
         end if;
 
531
 
 
532
         if Copy and then C /= null then
 
533
            return Dnd_Data (C, Copy => True);
 
534
         else
 
535
            Open_File_Editor
 
536
              (Child.Kernel, Child.Dnd_From_File, Line => 0, Column => 0);
 
537
         end if;
 
538
 
 
539
         return Get_Focus_Child (Get_MDI (Child.Kernel));
 
540
      end if;
 
541
   end Dnd_Data;
 
542
 
 
543
   -------------------------
 
544
   -- Child_Drag_Finished --
 
545
   -------------------------
 
546
 
 
547
   overriding procedure Child_Drag_Finished
 
548
     (Child : access MDI_Explorer_Child_Record) is
 
549
   begin
 
550
      --  So that we can also move the explorer itself
 
551
      Child.Dnd_From_File := GNATCOLL.VFS.No_File;
 
552
   end Child_Drag_Finished;
 
553
 
 
554
   ---------------------
 
555
   -- On_Button_Press --
 
556
   ---------------------
 
557
 
 
558
   function On_Button_Press
 
559
     (Kernel    : Kernel_Handle;
 
560
      Child     : access MDI_Explorer_Child_Record'Class;
 
561
      Tree      : access Gtk_Tree_View_Record'Class;
 
562
      Model     : Gtk_Tree_Store;
 
563
      Event     : Gdk_Event;
 
564
      Add_Dummy : Boolean) return Boolean
 
565
   is
 
566
      Iter         : Gtk_Tree_Iter;
 
567
      Path         : Gtk_Tree_Path;
 
568
      Line, Column : Gint;
 
569
   begin
 
570
      if Get_Button (Event) = 1 then
 
571
         Iter := Find_Iter_For_Event (Tree, Model, Event);
 
572
 
 
573
         if Iter /= Null_Iter then
 
574
            Path := Get_Path (Model, Iter);
 
575
            Set_Cursor (Tree, Path, null, False);
 
576
            Path_Free (Path);
 
577
 
 
578
            case Node_Types'Val
 
579
              (Integer (Get_Int (Model, Iter, Node_Type_Column)))
 
580
            is
 
581
 
 
582
               when Directory_Node | Project_Node | Category_Node =>
 
583
                  Cancel_Child_Drag (Child);
 
584
 
 
585
                  if Get_Event_Type (Event) = Gdk_2button_Press then
 
586
                     declare
 
587
                        Path    : Gtk_Tree_Path;
 
588
                        Success : Boolean;
 
589
                        pragma Unreferenced (Success);
 
590
                     begin
 
591
                        Path := Get_Path (Model, Iter);
 
592
 
 
593
                        if Row_Expanded (Tree, Path) then
 
594
                           Success := Collapse_Row (Tree, Path);
 
595
                        else
 
596
                           if Add_Dummy then
 
597
                              Append_Dummy_Iter (Model, Iter);
 
598
                           end if;
 
599
 
 
600
                           Success := Expand_Row (Tree, Path, False);
 
601
                        end if;
 
602
 
 
603
                        Path_Free (Path);
 
604
                     end;
 
605
                  end if;
 
606
 
 
607
                  return False;
 
608
 
 
609
               when File_Node =>
 
610
                  if Get_Event_Type (Event) = Gdk_2button_Press
 
611
                    or else Get_Event_Type (Event) = Gdk_3button_Press
 
612
                  then
 
613
                     Cancel_Child_Drag (Child);
 
614
                     Open_File_Editor
 
615
                       (Kernel,
 
616
                        Create
 
617
                          (Full_Filename =>
 
618
                             Get_String (Model, Iter, Absolute_Name_Column)),
 
619
                        Line   => 0,
 
620
                        Column => 0);
 
621
                     return True;
 
622
 
 
623
                  elsif Get_Event_Type (Event) = Button_Press then
 
624
                     --  Drag-and-drop does not work on floating MDI children
 
625
 
 
626
                     if Get_State (Child) /= Floating then
 
627
                        Child.Kernel        := Kernel;
 
628
                        Child.Dnd_From_File := Create
 
629
                          (Full_Filename =>
 
630
                             Get_String (Model, Iter, Absolute_Name_Column));
 
631
 
 
632
                        Child_Drag_Begin (Child, Event);
 
633
                     end if;
 
634
                     return False;
 
635
 
 
636
                  else
 
637
                     Cancel_Child_Drag (Child);
 
638
                  end if;
 
639
 
 
640
               when Entity_Node =>
 
641
                  Cancel_Child_Drag (Child);
 
642
 
 
643
                  if Get_Event_Type (Event) = Button_Release then
 
644
                     Line := Get_Int (Model, Iter, Line_Column);
 
645
                     Column := Get_Int (Model, Iter, Column_Column);
 
646
 
 
647
                     Open_File_Editor
 
648
                       (Kernel,
 
649
                        Create
 
650
                          (Full_Filename =>
 
651
                             Get_String (Model, Iter, Absolute_Name_Column)),
 
652
                        Line   => Natural (Line),
 
653
                        Column => Visible_Column_Type (Column));
 
654
                  end if;
 
655
                  return False;
 
656
 
 
657
               when others =>
 
658
                  Cancel_Child_Drag (Child);
 
659
                  return False;
 
660
            end case;
 
661
 
 
662
         end if;
 
663
      end if;
 
664
 
 
665
      return False;
 
666
   end On_Button_Press;
 
667
 
 
668
   ------------------
 
669
   -- On_Key_Press --
 
670
   ------------------
 
671
 
 
672
   function On_Key_Press
 
673
     (Kernel : Kernel_Handle;
 
674
      Tree   : access Gtk_Tree_View_Record'Class;
 
675
      Event  : Gdk_Event) return Boolean
 
676
   is
 
677
      use type Gdk.Types.Gdk_Key_Type;
 
678
 
 
679
      Iter         : Gtk_Tree_Iter;
 
680
      Line, Column : Gint;
 
681
      Model        : Gtk_Tree_Model;
 
682
 
 
683
   begin
 
684
      Get_Selected (Get_Selection (Tree), Model, Iter);
 
685
 
 
686
      if Iter = Null_Iter then
 
687
         return False;
 
688
      end if;
 
689
 
 
690
      if Get_Key_Val (Event) = GDK_Return then
 
691
         case Node_Types'Val
 
692
           (Integer (Get_Int (Model, Iter, Node_Type_Column))) is
 
693
 
 
694
         when File_Node =>
 
695
            Open_File_Editor
 
696
              (Kernel,
 
697
               Create
 
698
                 (Full_Filename =>
 
699
                  Get_String (Model, Iter, Absolute_Name_Column)),
 
700
               Line   => 0,
 
701
               Column => 0);
 
702
 
 
703
         when Entity_Node =>
 
704
            Line := Get_Int (Model, Iter, Line_Column);
 
705
            Column := Get_Int (Model, Iter, Column_Column);
 
706
 
 
707
            Open_File_Editor
 
708
              (Kernel,
 
709
               Create
 
710
                 (Full_Filename =>
 
711
                  Get_String (Model, Iter, Absolute_Name_Column)),
 
712
               Line   => Natural (Line),
 
713
               Column => Visible_Column_Type (Column));
 
714
 
 
715
         when others =>
 
716
            null;
 
717
         end case;
 
718
      end if;
 
719
 
 
720
      return False;
 
721
   end On_Key_Press;
 
722
 
 
723
   -------------------
 
724
   -- Get_Node_Type --
 
725
   -------------------
 
726
 
 
727
   function Get_Node_Type
 
728
     (Model : Gtk_Tree_Store;
 
729
      Node  : Gtk_Tree_Iter) return Node_Types is
 
730
   begin
 
731
      return
 
732
        Node_Types'Val
 
733
          (Integer (Get_Int (Model, Node, Node_Type_Column)));
 
734
   end Get_Node_Type;
 
735
 
 
736
   -------------------
 
737
   -- Set_Node_Type --
 
738
   -------------------
 
739
 
 
740
   procedure Set_Node_Type
 
741
     (Model    : Gtk_Tree_Store;
 
742
      Node     : Gtk_Tree_Iter;
 
743
      N_Type   : Node_Types;
 
744
      Expanded : Boolean) is
 
745
   begin
 
746
      Set (Model, Node, Node_Type_Column, Gint (Node_Types'Pos (N_Type)));
 
747
 
 
748
      if N_Type not in Category_Node .. Entity_Node then
 
749
         if Expanded then
 
750
            Set (Model, Node, Icon_Column, C_Proxy (Open_Pixbufs (N_Type)));
 
751
         else
 
752
            Set (Model, Node, Icon_Column, C_Proxy (Close_Pixbufs (N_Type)));
 
753
         end if;
 
754
      end if;
 
755
   end Set_Node_Type;
 
756
 
 
757
   -----------------------
 
758
   -- Get_Category_Type --
 
759
   -----------------------
 
760
 
 
761
   function Get_Category_Type
 
762
     (Model : Gtk_Tree_Store;
 
763
      Node  : Gtk_Tree_Iter) return Language_Category is
 
764
   begin
 
765
      return
 
766
        Language_Category'Val
 
767
          (Integer (Get_Int (Model, Node, Category_Column)));
 
768
   end Get_Category_Type;
 
769
 
 
770
   -------------------
 
771
   -- Is_Up_To_Date --
 
772
   -------------------
 
773
 
 
774
   function Is_Up_To_Date
 
775
     (Model : Gtk_Tree_Store;
 
776
      Node  : Gtk_Tree_Iter) return Boolean is
 
777
   begin
 
778
      case Get_Node_Type (Model, Node) is
 
779
         when File_Node =>
 
780
            declare
 
781
               --  ??? Virtual_File should be stored directly in the tree
 
782
               File : constant Virtual_File := Create
 
783
                 (Full_Filename =>
 
784
                    Get_String (Model, Node, Absolute_Name_Column));
 
785
            begin
 
786
               return Duration (Get_Int (Model, Node, Timestamp_Column)) +
 
787
                 GNATCOLL.Utils.No_Time =
 
788
                   File_Time_Stamp (File);
 
789
            end;
 
790
 
 
791
         when others =>
 
792
            return Get_Boolean (Model, Node, Up_To_Date_Column);
 
793
      end case;
 
794
   end Is_Up_To_Date;
 
795
 
 
796
   --------------------
 
797
   -- Set_Up_To_Date --
 
798
   --------------------
 
799
 
 
800
   procedure Set_Up_To_Date
 
801
     (Model : Gtk_Tree_Store;
 
802
      Node  : Gtk_Tree_Iter;
 
803
      State : Boolean) is
 
804
   begin
 
805
      Set (Model, Node, Up_To_Date_Column, State);
 
806
   end Set_Up_To_Date;
 
807
 
 
808
   -------------------
 
809
   -- Get_Base_Name --
 
810
   -------------------
 
811
 
 
812
   function Get_Base_Name
 
813
     (Model : Gtk_Tree_Store;
 
814
      Node  : Gtk_Tree_Iter) return String is
 
815
   begin
 
816
      return Get_String (Model, Node, Base_Name_Column);
 
817
   end Get_Base_Name;
 
818
 
 
819
   -----------------------
 
820
   -- Get_Absolute_Name --
 
821
   -----------------------
 
822
 
 
823
   function Get_Absolute_Name
 
824
     (Model : Gtk_Tree_Store;
 
825
      Node  : Gtk_Tree_Iter) return String is
 
826
   begin
 
827
      return Get_String (Model, Node, Absolute_Name_Column);
 
828
   end Get_Absolute_Name;
 
829
 
 
830
   ------------------------
 
831
   -- Get_File_From_Node --
 
832
   ------------------------
 
833
 
 
834
   function Get_File_From_Node
 
835
     (Model : Gtk_Tree_Store;
 
836
      Node  : Gtk_Tree_Iter) return GNATCOLL.VFS.Virtual_File
 
837
   is
 
838
      Absolute : constant String := Get_Absolute_Name (Model, Node);
 
839
   begin
 
840
      if Absolute = "" then
 
841
         return GNATCOLL.VFS.No_File;
 
842
      else
 
843
         return Create (Full_Filename => Absolute);
 
844
      end if;
 
845
   end Get_File_From_Node;
 
846
 
 
847
   -----------------------------
 
848
   -- Get_Directory_From_Node --
 
849
   -----------------------------
 
850
 
 
851
   function Get_Directory_From_Node
 
852
     (Model : Gtk_Tree_Store;
 
853
      Node  : Gtk_Tree_Iter) return String
 
854
   is
 
855
      S : constant String := Get_Absolute_Name (Model, Node);
 
856
   begin
 
857
      if S = "" then
 
858
         return "";
 
859
      else
 
860
         if Get_Node_Type (Model, Node) = Directory_Node then
 
861
            return S;
 
862
         else
 
863
            return Dir_Name (S);
 
864
         end if;
 
865
      end if;
 
866
   end Get_Directory_From_Node;
 
867
 
 
868
   ---------------------------
 
869
   -- Get_Project_From_Node --
 
870
   ---------------------------
 
871
 
 
872
   function Get_Project_From_Node
 
873
     (Model     : Gtk_Tree_Store;
 
874
      Kernel    : access GPS.Kernel.Kernel_Handle_Record'Class;
 
875
      Node      : Gtk_Tree_Iter;
 
876
      Importing : Boolean) return Project_Type
 
877
   is
 
878
      Parent_Iter : Gtk_Tree_Iter;
 
879
      Node_Type   : Node_Types;
 
880
      Project     : Project_Type;
 
881
      N           : Name_Id;
 
882
   begin
 
883
      if Importing then
 
884
         Parent_Iter := Parent (Model, Node);
 
885
 
 
886
         if Parent_Iter = Null_Iter then
 
887
            return Get_Project (Kernel);
 
888
         end if;
 
889
 
 
890
      else
 
891
         Parent_Iter := Node;
 
892
      end if;
 
893
 
 
894
      while Parent_Iter /= Null_Iter loop
 
895
         Node_Type := Get_Node_Type (Model, Parent_Iter);
 
896
 
 
897
         exit when Node_Type = Project_Node
 
898
           or else Node_Type = Extends_Project_Node
 
899
           or else Node_Type = Modified_Project_Node;
 
900
 
 
901
         Parent_Iter := Parent (Model, Parent_Iter);
 
902
      end loop;
 
903
 
 
904
      if Parent_Iter /= Null_Iter then
 
905
         N := Name_Id (Get_Int (Model, Parent_Iter, Project_Column));
 
906
         Assert (Me, N /= No_Name,
 
907
                 "Get_Project_From_Node: no project found");
 
908
         Project := Get_Project_From_Name (Get_Registry (Kernel).all, N);
 
909
 
 
910
      else
 
911
         --  Should we fall back on Get_Project_From_File ?
 
912
         Project := No_Project;
 
913
      end if;
 
914
 
 
915
      return Project;
 
916
 
 
917
   exception
 
918
      when E : others =>
 
919
         Trace (Exception_Handle, E);
 
920
         return No_Project;
 
921
   end Get_Project_From_Node;
 
922
 
 
923
   ---------------------
 
924
   -- Context_Factory --
 
925
   ---------------------
 
926
 
 
927
   procedure Context_Factory
 
928
     (Context : in out Selection_Context;
 
929
      Kernel  : Kernel_Handle;
 
930
      Tree    : access Gtk_Tree_View_Record'Class;
 
931
      Model   : Gtk_Tree_Store;
 
932
      Event   : Gdk_Event;
 
933
      Menu    : Gtk_Menu)
 
934
   is
 
935
      pragma Unreferenced (Menu);
 
936
 
 
937
      function Entity_Base (Name : String) return String;
 
938
      --  Return the "basename" for the entity, ie convert "parent.name" to
 
939
      --  "name", in the case of Ada parent packages.
 
940
      --  ??? Should this be done by the parser itself
 
941
 
 
942
      -----------------
 
943
      -- Entity_Base --
 
944
      -----------------
 
945
 
 
946
      function Entity_Base (Name : String) return String is
 
947
      begin
 
948
         --  ??? Should use standard UTF8 subprogams
 
949
         for C in reverse Name'Range loop
 
950
            if Name (C) = '.' then
 
951
               return Name (C + 1 .. Name'Last);
 
952
            end if;
 
953
         end loop;
 
954
         return Name;
 
955
      end Entity_Base;
 
956
 
 
957
      Iter      : constant Gtk_Tree_Iter :=
 
958
                    Find_Iter_For_Event (Tree, Model, Event);
 
959
      Node_Type : Node_Types;
 
960
      L         : Integer := 0;
 
961
 
 
962
   begin
 
963
      if Iter /= Null_Iter then
 
964
         Node_Type := Get_Node_Type (Model, Iter);
 
965
      else
 
966
         return;
 
967
      end if;
 
968
 
 
969
      if Node_Type = Entity_Node then
 
970
         Set_Entity_Information
 
971
           (Context       => Context,
 
972
            Entity_Name   => Entity_Base
 
973
              (Get_String (Model, Iter, Entity_Base_Column)),
 
974
            Entity_Column => Visible_Column_Type
 
975
              (Get_Int (Model, Iter, Column_Column)));
 
976
         L := Integer (Get_Int (Model, Iter, Line_Column));
 
977
      end if;
 
978
 
 
979
      if Node_Type = Project_Node
 
980
        or else Node_Type = Extends_Project_Node
 
981
        or else Node_Type = Modified_Project_Node
 
982
      then
 
983
         Set_File_Information
 
984
           (Context           => Context,
 
985
            Project           =>
 
986
              Get_Project_From_Node (Model, Kernel, Iter, False),
 
987
            Importing_Project =>
 
988
              Get_Project_From_Node (Model, Kernel, Iter, True));
 
989
 
 
990
      else
 
991
         Set_File_Information
 
992
           (Context      => Context,
 
993
            Files        => (1 => Get_File_From_Node (Model, Iter)),
 
994
            Project      =>
 
995
              Get_Project_From_Node (Model, Kernel, Iter, False),
 
996
            Importing_Project =>
 
997
              Get_Project_From_Node (Model, Kernel, Iter, True),
 
998
            Line         => L);
 
999
      end if;
 
1000
   end Context_Factory;
 
1001
 
 
1002
end Project_Explorers_Common;