← Back to branch summary

~ubuntu-branches/ubuntu/trusty/gnat-gps/trusty

« back to all changes in this revision

Viewing changes to .pc/bug-653470.patch/prj_editor/src/project_explorers_common.adb

  • Committer: Package Import Robot
  • Author(s): Ludovic Brenta
  • Date: 2012-04-09 15:32:28 UTC
  • Revision ID: package-import@ubuntu.com-20120409153228-hug83kmnmawfsmf2
Tags: 5.0-8
http://bugs.debian.org/666958
* debian/patches/bug-653470.patch: remove.
* debian/rules (config.ads): set the Default_Charset variable.
  Compile all C source files with the same compiler as the Ada source
  files, i.e. gnatgcc instead of $(CC).
* debian/patches/bug-666958.patch: new.  Closes: #666958.

Show diffs side-by-side

added added

removed removed

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