The unified diff between revisions [6e4f311b..] and [905ef87f..] is displayed below. It can also be downloaded as a raw diff.
#
#
# add_dir "gnatlib/src/gmp"
#
# add_file "code_analysis/src/code_peer-message_categories_models.adb"
# content [bad026fcae5e86df9e91f8a7732e01aa615291c0]
#
# add_file "code_analysis/src/code_peer-message_categories_models.ads"
# content [1ee62eca94d49a50fc74454cdd9edc421354000d]
#
# add_file "code_analysis/src/code_peer-messages_filter_models.adb"
# content [80472e61c58a5d75db0196220b1a2b59343fa032]
#
# add_file "code_analysis/src/code_peer-messages_filter_models.ads"
# content [12c213d96a7e0854b9a782254749cf5619a1f171]
#
# add_file "common/src/separate_run_path_option.c"
# content [478f96410f2126ddd2c62e95c070886bcf9136d6]
#
# add_file "gnatlib/distrib/gnatcoll_gmp.gpr.in"
# content [85d093035c3f4340d66e36b4ed61d1c3159ae909]
#
# add_file "gnatlib/src/Makefile.gmp"
# content [21df1073107d6a53d13f41eaa888c6c255a5564b]
#
# add_file "gnatlib/src/gmp/gmp_support.c"
# content [5e6301a621f4e6033bb856a9d148c6879dbfb496]
#
# add_file "gnatlib/src/gmp/gnatcoll-gmp.ads"
# content [1772141f17ee6bb5c2305a89bb27fb0414cc7a64]
#
# add_file "gnatlib/src/gnatcoll_gmp.gpr.in"
# content [16b4422a3411eb02d32d78c84744aa6a10831411]
#
# add_file "kernel/src/gps-editors.adb"
# content [7ba2cebbaa0dc2fba1a0face9e753f824d71a952]
#
# add_file "kernel/src/gps-editors.ads"
# content [9c3a57a921b2e4b8180788fcea29ef94585750c4]
#
# add_file "src_editor/src/src_editor_module-editors.adb"
# content [f4d5fd827e35e56de280ff4954ddcd9d0b506d03]
#
# add_file "src_editor/src/src_editor_module-editors.ads"
# content [681450061a34cb9a426c87cdaf42bf27250fea2d]
#
# patch "INSTALL"
# from [a64ee29b0679758a7832084d2504c7feba3c5435]
# to [2aaf617db72c5ffc00831ae1337727f8132ad1ae]
#
# patch "code_analysis/src/code_analysis.adb"
# from [4c74db222b91bce2c7a42af3916213c013cedb9b]
# to [54c6d60d87a8d8f896863545ab3c9054c6ac8a7b]
#
# patch "code_analysis/src/code_analysis.ads"
# from [c0ee8e0e20dfe833a122c446835701eb7beab2ae]
# to [e6d8d5b1c8aecf91247ecb4c6b48fa0d006fae95]
#
# patch "code_analysis/src/code_coverage.adb"
# from [dea30900103cdafc90005e509f5f557c5e7560eb]
# to [885f890644357c0db0250a3e3608745bbd2ba154]
#
# patch "codefix/src/codefix-ada_tools.adb"
# from [54fdeeeed1517e1c247ef5eaf138d6dc5ab354da]
# to [e477198cefd77ebef03927503fd35c99e3dd7ffa]
#
# patch "codefix/src/codefix-formal_errors.adb"
# from [b94224c2d655f476ebc13d310c4018b4f7fd740b]
# to [7a52cc05444e427578c91ca9cd1eb1b53eac8007]
#
# patch "codefix/src/codefix-gps_io.adb"
# from [19daf5e5c06f293124743be508b0b203d58fdd4b]
# to [2298791a86af8fc83c4d28e4bdbe7d01590020ea]
#
# patch "codefix/src/codefix-gps_io.ads"
# from [8351687373a2e8d972c1ea58bf7b76154cdcc106]
# to [162bbe45bcfcaa3d44dbfbfdb2dfd5bf2a6f4312]
#
# patch "codefix/src/codefix-text_manager-ada_commands.adb"
# from [c6283cfa74b61301f2efed596f5a0faa4649f7b2]
# to [fd10b82e845776056bd796e257095d16a89fef3e]
#
# patch "codefix/src/codefix-text_manager.adb"
# from [cc7c4a2c6905d7efde56c8a4e43722da1b0d7468]
# to [c6cb1e79a80e1681c4968519c1a6ee8647d715e2]
#
# patch "common/src/gui_utils.adb"
# from [da1b7624b0f09aa2848462d64714f6443a2198f1]
# to [81587a9dcbfba2dfc37cc3f1e02150e58e475d9c]
#
# patch "common/src/language-ada.adb"
# from [3b6eb3ffba1cb77538867a7389a4e0db57ee4305]
# to [d0dcf6443d1223cfc6a9da8b6eda055ec493110b]
#
# patch "common/src/language.ads"
# from [ccb9298b5ab93ac6693298705f6f410a25c9bce9]
# to [6cd84988959cb73d5a6ff0e606545465e12001db]
#
# patch "common/tests/run.sh"
# from [ebac055031f39f24b4a9834457b8d666886ca8fd]
# to [373c8d9bb186439393064598b8f0a72dbe7ea9d0]
#
# patch "distrib/features"
# from [cff4edd0a6677ea8a66dc138d60a8902e9e24196]
# to [0e5aff6b8288e1fff1812ac7d6d84ccdd0ed9196]
#
# patch "distrib/known-problems"
# from [622b9b9b276e0a47cfa9430a6dc6bee9cd163599]
# to [7025147a7b81cc3e0a9e7defefbe0a7ace385d25]
#
# patch "docs/gps.texi"
# from [d89aaa2dfd4bc1dfa47a66e5547f15fdec04cfac]
# to [0f7122a778f20516b4727a5a27adf10b44c6bb71]
#
# patch "docs/tutorial.texi"
# from [580d3a931773f297e81bfd78f0b29dfbdd7b42a9]
# to [fd5b517938fc80609e6bfb7a479ee4ffe86c518b]
#
# patch "gnatlib/Makefile"
# from [598d5ec26f6b261e8c000eb281fe4df44c01fe59]
# to [a9562e9cfd04fe306c21db7bec52bffcee510902]
#
# patch "gnatlib/Makefile.conf.in"
# from [184925bff1cce1ffc44621adf6e036a7894edee9]
# to [9d1597df48224ef8dd1a7312a4d62aeb10d7e2a4]
#
# patch "gnatlib/aclocal.m4"
# from [2a85a459679f75754605566c1473ca8026b15555]
# to [05ea1685595c8ec24d8790657ee6ff1da2d7db88]
#
# patch "gnatlib/configure"
# from [f92507d8dc93c9be52358f13e1c383e242055bbc]
# to [f799927951201e3e06f03aea73550028b6a14052]
#
# patch "gnatlib/configure.in"
# from [7db1db42473e84c6c4d85748a30e7a97647e3d18]
# to [988a0d012e2e416989ccd6c9038ab6b7738281b6]
#
# patch "gnatlib/configure_minimal"
# from [21b43df5fa2c6795a04997203bb03614fbd02f08]
# to [b8e5b433e1f3fa150a8f6cc370c75740daf7d6bd]
#
# patch "gnatlib/gnatcoll_shared.gpr.in"
# from [d4b11ceddfd4bc2a6167cfb7bcf98cb3e8568a5a]
# to [56a84a38abf613e44c0c57db4269ed005d07c447]
#
# patch "gps/gps.gpr"
# from [6ac9a1cb29cd4bb3ef9188ad36e14e249192691e]
# to [7a3365e61f5b09e8cb95e3e7e8dcc414b8fa17d3]
#
# patch "gps/src/gps-main.adb"
# from [5f65cb101d24ad92c4d66c471e683a149fd64f19]
# to [a5162bfced147c0e4f3b57a65228c47785272a4e]
#
# patch "kernel/src/gps-kernel-preferences.adb"
# from [640920d5938c103671f30524223d3f492cda0179]
# to [9b2593c1979de77a07287b7ed86b94dc5a8cb96d]
#
# patch "kernel/src/gps-kernel-preferences.ads"
# from [28412fa8585563f779510b07c3c92d2cb8ed0723]
# to [5e3c7175ddaa19325a86459224942ff6de933a16]
#
# patch "kernel/src/gps-kernel.adb"
# from [201af151daea5f02f5a51fb2d138d243274e0f62]
# to [04c42c6903f429ba4283dfdef0252203f7660969]
#
# patch "kernel/src/gps-kernel.ads"
# from [a4d8d88d79ea6f9a60dd9b2358909b2ba1de09b5]
# to [8ff985547d431418a08226269f6602b4666ccedb]
#
# patch "kernel/src_info/ali_parser.adb"
# from [7099fb7294937b811d5c05acac93c0bf77ab3b7b]
# to [735d0e1303ac38d8e8dd26ce8a9624c54407cfd5]
#
# patch "kernel/src_info/projects-registry.adb"
# from [15f722ba9cc45bb8cb58029d77b6a6ee6ebfdbe2]
# to [81884c567471ec1123873a13ca300fcbbbfd2334]
#
# patch "navigation/src/navigation_module.adb"
# from [3aa4cad20ed56a59fa90ad8b43fd654fef63efbf]
# to [9e4dfc298f6fe8fb66e534075617a510e0f39a22]
#
# patch "prj_editor/src/project_explorers.adb"
# from [8aba2e0e8ec8c02de4fc0d8ae72ae2bc09ca0de1]
# to [84c60a7bdba726849533801642cc0a851f1a9fac]
#
# patch "prj_editor/src/project_explorers_files.adb"
# from [2dec7217b3b8481fa22d1597e8354bf39cfc7f71]
# to [7af0fc5b11cde0c2e707f3bbba9bf41a231775f5]
#
# patch "prj_editor/testsuite/run"
# from [6e6d591cd1970e44420476475f7203f7246e3452]
# to [1d808eb952f37c72e856431b7654073e750f5173]
#
# patch "refactoring/src/refactoring-parameters.adb"
# from [3fc20a741d3f163dca2b0c12c31163f9ec49a192]
# to [aab9d734092b3e56d60e587bd6ceef2db6454dd2]
#
# patch "refactoring/src/refactoring-performers.adb"
# from [158111c303446b4f1a04d53d4cc418f240061234]
# to [b124e6e9a1d93b4750a8515afa1c379f9bb60e9f]
#
# patch "refactoring/src/refactoring-rename.adb"
# from [3ae40b00a84c614a763a85c2ab3a844e1083bf03]
# to [150cb2656976a87a5e03e05c05a3deb9fa5adbd6]
#
# patch "refactoring/src/refactoring-subprograms.adb"
# from [5946dbeed1f8606a0d97edb5581fa5c8ae0f7b01]
# to [705e8e0d5d4c38c8f68fe7c9d9b903d91e053947]
#
# patch "share/plug-ins/spark.py"
# from [f67c9a78a330d8697b4304d3e5440124c532065f]
# to [30a18fe74fece8ba90a2337254fbe58287b35642]
#
# patch "share/shell_commands.xml"
# from [a94f2e3618b0849079b39e097725e1cc9f75264c]
# to [925f69f086b9d653755db84b4e9ad38358bff7c2]
#
# patch "src_editor/src/casing_exceptions.adb"
# from [700644d818dd0d61c0b9a4986e931aca5c0216e7]
# to [a1225e05599b90787f2735ecf27a087291c2aaed]
#
# patch "src_editor/src/src_editor_box.adb"
# from [7b440b0e6696d12c2af8350c49a5c86b8e115ad0]
# to [f1283eb752d38dee6a336be753c7301c313135aa]
#
# patch "src_editor/src/src_editor_buffer-line_information.adb"
# from [2bfe6548dd0fe5d53c85a3917625d59c37f8ce4b]
# to [3d241b42c611557c5c96accdf60c7061813c7b5f]
#
# patch "src_editor/src/src_editor_buffer-line_information.ads"
# from [b596666636b20e9cf1e7786b196ce3ce41852aa9]
# to [c963984cfdc8849bfa94b4f40b262d07c1d9a733]
#
# patch "src_editor/src/src_editor_buffer-text_handling.adb"
# from [5bb0c5503feba3f4d2bc13587d2c6e6931aecef6]
# to [75e841e60a732a55528d24ac29e656a6a1d6f412]
#
# patch "src_editor/src/src_editor_buffer.adb"
# from [ec7cdd7943a705123ea08d8ac18f1216fa28d546]
# to [e9b0a5bfccf3da0d6713b620059d85f5f77989e7]
#
# patch "src_editor/src/src_editor_buffer.ads"
# from [5f4d06de40e782f3f7b9514ea310a5e83c9ff9e1]
# to [4948f228bf59e3c7c58045c680691bfe71632823]
#
# patch "src_editor/src/src_editor_module-shell.adb"
# from [b7d821bd0fea8e67fc4cc12936f43bfe845a3096]
# to [f0572ff7aa100ef8bb057ec310d86fca2aa2ed22]
#
# patch "src_editor/src/src_editor_module.adb"
# from [1e2388f3e9a7aaebe16b2bd40213a37ee945432f]
# to [8418021a6c56b0d67fb777f09365531965c6eb06]
#
# patch "vcs/src/commands-vcs.adb"
# from [db919b008da37ca5ee3cfa87fc2056c51d0f1624]
# to [ac2320e264627e65a5216c863a89ca92c724be96]
#
# patch "vcs/src/log_utils.adb"
# from [4db1c30ded69641b2a0e9320dcda72626fc67fe2]
# to [14474edb3c6ca8ecb4b460b232f599780bc7ca03]
#
# patch "vcs/src/vcs-generic_vcs.adb"
# from [de08a82386cec88f8413645547df10e848d06eb9]
# to [729e68d198ea31915bf9cebcf0b6aa99cf25069d]
#
# patch "vcs/src/vcs-generic_vcs.ads"
# from [d41f4e21464a07e678a40d41ad7c1c7494193e7c]
# to [cf242ba35ef3e764c76a03cc24d159e82ef1267d]
#
# patch "vcs/src/vcs-unknown_vcs.adb"
# from [bd2299de74a0e241fe6b243d6bf7a4790e7a5970]
# to [93b76358ef499763514358d41956f3207f0658a1]
#
# patch "vcs/src/vcs-unknown_vcs.ads"
# from [91fb5150ecbb563a079a993b17d904c5161b3499]
# to [9e6168c1f1f586a2ae35a38da9436cbf775c5747]
#
# patch "vcs/src/vcs.adb"
# from [28d0511dad2186dfa17f1293c8a6e8c0b9b92de0]
# to [268bad919b8a1701d15b4d8472f330a32be27d6d]
#
# patch "vcs/src/vcs.ads"
# from [e55ecc66e4aeb821165472bae5b48e3af35a73aa]
# to [0ba144b3890c079b49dd262f066228909d1929ad]
#
# patch "vcs/src/vcs_activities.adb"
# from [0f1ef7cee23fcf407f7d1605d0881fef1a1c709f]
# to [ca02eefcc591e1f14caf8846150396c75aea1b00]
#
# patch "vcs/src/vcs_module.adb"
# from [7ebbbeec0656f2a5cfb4cdc0181baf95904cfcd0]
# to [318812cc015dd2a4537972af999fe9d309b78853]
#
# patch "vcs/src/vcs_status.adb"
# from [752d2b349b13646c7b953de2150bf9c77f5544fd]
# to [2670f64ebe941e5579a7cc7c65c56df2f7ac81eb]
#
# patch "vcs/src/vcs_view-explorer.adb"
# from [03a56dc326c47c9d9e93a8fb53c711ade05c4161]
# to [8741af48c27015f29fe3e1cc6bd83c97e49fe92d]
#
# patch "vcs/src/vcs_view-explorer.ads"
# from [0a3a1021cbe870778f615d6fb75c0ddfec98f446]
# to [267523dd6899bfcab8ce4e24c1833a1fbf753b9d]
#
# patch "vcs/src/vcs_view_api.adb"
# from [d9e13b17867337c8ed94cadec59d0b38cb66c6bf]
# to [3f97e5b1663f9b019c5d2ed4f097358d8205b4b6]
#
# patch "widgets/src/gtkada-color_combo.adb"
# from [28e21620cfc4e7bf04a1a5613c9644dac40bae70]
# to [51af8410b084808e28d49313584efa031136ee00]
#
# patch "widgets/src/gtkada-color_combo.ads"
# from [2573fb49fdb85a3f75546e04c8e569f9bd09a70a]
# to [a9b7726a865bb1ac4db8e5d5f9088b46c542b791]
#
# patch "widgets/src/gtkada-file_selector.adb"
# from [0e7ded67948abbc404bdf418d1b19ef878b570a5]
# to [31b59a1e180f3a792f3f0ed5b7ea11fcef504431]
#
============================================================
--- code_analysis/src/code_peer-message_categories_models.adb bad026fcae5e86df9e91f8a7732e01aa615291c0
+++ code_analysis/src/code_peer-message_categories_models.adb bad026fcae5e86df9e91f8a7732e01aa615291c0
@@ -0,0 +1,252 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2008, AdaCore --
+-- --
+-- GPS is Free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+with System.Address_To_Access_Conversions;
+
+with Gtk.Tree_Model.Utils;
+
+package body Code_Peer.Message_Categories_Models is
+
+ package Category_Conversions is
+ new System.Address_To_Access_Conversions (Code_Peer.Message_Category);
+
+ -----------------
+ -- Category_At --
+ -----------------
+
+ function Category_At
+ (Self : access Message_Categories_Model_Record'Class;
+ Iter : Gtk.Tree_Model.Gtk_Tree_Iter)
+ return Code_Peer.Message_Category_Access
+ is
+ pragma Unreferenced (Self);
+
+ begin
+ return
+ Code_Peer.Message_Category_Access
+ (Category_Conversions.To_Pointer
+ (Gtk.Tree_Model.Utils.Get_User_Data_1 (Iter)));
+ end Category_At;
+
+ -----------
+ -- Clear --
+ -----------
+
+ procedure Clear (Self : access Message_Categories_Model_Record) is
+ begin
+ Self.Categories.Clear;
+ end Clear;
+
+ ----------------------
+ -- Create_Tree_Iter --
+ ----------------------
+
+ function Create_Tree_Iter
+ (Self : access Message_Categories_Model_Record'Class;
+ Category : Code_Peer.Message_Category_Access)
+ return Gtk.Tree_Model.Gtk_Tree_Iter
+ is
+ pragma Unreferenced (Self);
+
+ begin
+ if Category /= null then
+ return
+ Gtk.Tree_Model.Utils.Init_Tree_Iter
+ (1,
+ Category_Conversions.To_Address
+ (Category_Conversions.Object_Pointer (Category)));
+
+ else
+ return Gtk.Tree_Model.Null_Iter;
+ end if;
+ end Create_Tree_Iter;
+
+ --------------
+ -- Get_Iter --
+ --------------
+
+ overriding function Get_Iter
+ (Self : access Message_Categories_Model_Record;
+ Path : Gtk.Tree_Model.Gtk_Tree_Path) return Gtk.Tree_Model.Gtk_Tree_Iter
+ is
+ Indices : constant Glib.Gint_Array := Gtk.Tree_Model.Get_Indices (Path);
+ Index : Natural;
+ Current : Message_Category_Ordered_Sets.Cursor := Self.Categories.First;
+
+ begin
+ if Indices'Length = 1 then
+ Index := Natural (Indices (Indices'First));
+
+ while Index /= 0 loop
+ Current := Message_Category_Ordered_Sets.Next (Current);
+ Index := Index - 1;
+ end loop;
+
+ if Message_Category_Ordered_Sets.Has_Element (Current) then
+ return
+ Self.Create_Tree_Iter
+ (Message_Category_Ordered_Sets.Element (Current));
+ end if;
+ end if;
+
+ return Gtk.Tree_Model.Null_Iter;
+ end Get_Iter;
+
+ --------------
+ -- Get_Path --
+ --------------
+
+ overriding function Get_Path
+ (Self : access Message_Categories_Model_Record;
+ Iter : Gtk.Tree_Model.Gtk_Tree_Iter) return Gtk.Tree_Model.Gtk_Tree_Path
+ is
+ Result : constant Gtk.Tree_Model.Gtk_Tree_Path :=
+ Gtk.Tree_Model.Gtk_New;
+ Index : Natural := 0;
+ Current : Message_Category_Ordered_Sets.Cursor :=
+ Self.Categories.Find (Self.Category_At (Iter));
+
+ begin
+ Current := Message_Category_Ordered_Sets.Previous (Current);
+
+ while Message_Category_Ordered_Sets.Has_Element (Current) loop
+ Index := Index + 1;
+ Current := Message_Category_Ordered_Sets.Previous (Current);
+ end loop;
+
+ Gtk.Tree_Model.Append_Index (Result, Glib.Gint (Index));
+
+ return Result;
+ end Get_Path;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize
+ (Self : access Message_Categories_Model_Record'Class;
+ Categories : Code_Peer.Message_Category_Sets.Set)
+ is
+
+ procedure Process (Position : Code_Peer.Message_Category_Sets.Cursor);
+
+ -------------
+ -- Process --
+ -------------
+
+ procedure Process (Position : Code_Peer.Message_Category_Sets.Cursor) is
+ begin
+ Self.Categories.Insert
+ (Code_Peer.Message_Category_Sets.Element (Position));
+ end Process;
+
+ begin
+ Gtkada.Abstract_List_Model.Initialize (Self);
+ Categories.Iterate (Process'Access);
+ end Initialize;
+
+ ----------------
+ -- N_Children --
+ ----------------
+
+ overriding function N_Children
+ (Self : access Message_Categories_Model_Record;
+ Iter : Gtk.Tree_Model.Gtk_Tree_Iter := Gtk.Tree_Model.Null_Iter)
+ return Glib.Gint is
+ begin
+ if Gtk.Tree_Model.Utils.Is_Null (Iter) then
+ return Glib.Gint (Self.Categories.Length);
+
+ else
+ return 0;
+ end if;
+ end N_Children;
+
+ ----------
+ -- Next --
+ ----------
+
+ overriding procedure Next
+ (Self : access Message_Categories_Model_Record;
+ Iter : in out Gtk.Tree_Model.Gtk_Tree_Iter)
+ is
+ Current : Message_Category_Ordered_Sets.Cursor;
+
+ begin
+ Current := Self.Categories.Find (Self.Category_At (Iter));
+ Current := Message_Category_Ordered_Sets.Next (Current);
+
+ if Message_Category_Ordered_Sets.Has_Element (Current) then
+ Iter :=
+ Self.Create_Tree_Iter
+ (Message_Category_Ordered_Sets.Element (Current));
+
+ else
+ Iter := Gtk.Tree_Model.Null_Iter;
+ end if;
+ end Next;
+
+ ---------------
+ -- Nth_Child --
+ ---------------
+
+ overriding function Nth_Child
+ (Self : access Message_Categories_Model_Record;
+ Parent : Gtk.Tree_Model.Gtk_Tree_Iter;
+ N : Glib.Gint) return Gtk.Tree_Model.Gtk_Tree_Iter
+ is
+ pragma Unreferenced (Parent);
+
+ Index : Natural := Natural (N);
+ Current : Message_Category_Ordered_Sets.Cursor := Self.Categories.First;
+
+ begin
+ while Index /= 0 loop
+ Index := Index - 1;
+ Current := Message_Category_Ordered_Sets.Next (Current);
+ end loop;
+
+ if Message_Category_Ordered_Sets.Has_Element (Current) then
+ return
+ Self.Create_Tree_Iter
+ (Message_Category_Ordered_Sets.Element (Current));
+
+ else
+ return Gtk.Tree_Model.Null_Iter;
+ end if;
+ end Nth_Child;
+
+ -----------------
+ -- Row_Changed --
+ -----------------
+
+ procedure Row_Changed
+ (Self : access Message_Categories_Model_Record'Class;
+ Category : Code_Peer.Message_Category_Access)
+ is
+ Iter : constant Gtk.Tree_Model.Gtk_Tree_Iter :=
+ Self.Create_Tree_Iter (Category);
+ Path : constant Gtk.Tree_Model.Gtk_Tree_Path := Self.Get_Path (Iter);
+
+ begin
+ Self.Row_Changed (Path, Iter);
+ Gtk.Tree_Model.Path_Free (Path);
+ end Row_Changed;
+
+end Code_Peer.Message_Categories_Models;
============================================================
--- code_analysis/src/code_peer-message_categories_models.ads 1ee62eca94d49a50fc74454cdd9edc421354000d
+++ code_analysis/src/code_peer-message_categories_models.ads 1ee62eca94d49a50fc74454cdd9edc421354000d
@@ -0,0 +1,86 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2008, AdaCore --
+-- --
+-- GPS is Free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+-- This file contains an abstract implementation of the Gtk+ tree model for
+-- the message categories. Derived model must override Get_N_Columns,
+-- Get_Column_Type and Get_Value subprograms.
+
+with Glib;
+with Gtk.Tree_Model;
+with Gtkada.Abstract_List_Model;
+
+package Code_Peer.Message_Categories_Models is
+
+ type Message_Categories_Model_Record is abstract
+ new Gtkada.Abstract_List_Model.Gtk_Abstract_List_Model_Record with
+ private;
+
+ procedure Initialize
+ (Self : access Message_Categories_Model_Record'Class;
+ Categories : Code_Peer.Message_Category_Sets.Set);
+
+ function Category_At
+ (Self : access Message_Categories_Model_Record'Class;
+ Iter : Gtk.Tree_Model.Gtk_Tree_Iter)
+ return Code_Peer.Message_Category_Access;
+
+ procedure Clear (Self : access Message_Categories_Model_Record);
+
+ procedure Row_Changed
+ (Self : access Message_Categories_Model_Record'Class;
+ Category : Code_Peer.Message_Category_Access);
+ -- Emit "row_changed" signal.
+
+ -- GtkTreeModel operations
+
+ overriding function Get_Iter
+ (Self : access Message_Categories_Model_Record;
+ Path : Gtk.Tree_Model.Gtk_Tree_Path) return Gtk.Tree_Model.Gtk_Tree_Iter;
+
+ overriding function Get_Path
+ (Self : access Message_Categories_Model_Record;
+ Iter : Gtk.Tree_Model.Gtk_Tree_Iter) return Gtk.Tree_Model.Gtk_Tree_Path;
+
+ overriding procedure Next
+ (Self : access Message_Categories_Model_Record;
+ Iter : in out Gtk.Tree_Model.Gtk_Tree_Iter);
+
+ overriding function N_Children
+ (Self : access Message_Categories_Model_Record;
+ Iter : Gtk.Tree_Model.Gtk_Tree_Iter := Gtk.Tree_Model.Null_Iter)
+ return Glib.Gint;
+
+ overriding function Nth_Child
+ (Self : access Message_Categories_Model_Record;
+ Parent : Gtk.Tree_Model.Gtk_Tree_Iter;
+ N : Glib.Gint) return Gtk.Tree_Model.Gtk_Tree_Iter;
+
+private
+
+ type Message_Categories_Model_Record is abstract
+ new Gtkada.Abstract_List_Model.Gtk_Abstract_List_Model_Record with record
+ Categories : Message_Category_Ordered_Sets.Set;
+ end record;
+
+ function Create_Tree_Iter
+ (Self : access Message_Categories_Model_Record'Class;
+ Category : Code_Peer.Message_Category_Access)
+ return Gtk.Tree_Model.Gtk_Tree_Iter;
+
+end Code_Peer.Message_Categories_Models;
============================================================
--- code_analysis/src/code_peer-messages_filter_models.adb 80472e61c58a5d75db0196220b1a2b59343fa032
+++ code_analysis/src/code_peer-messages_filter_models.adb 80472e61c58a5d75db0196220b1a2b59343fa032
@@ -0,0 +1,160 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2008, AdaCore --
+-- --
+-- GPS is Free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+package body Code_Peer.Messages_Filter_Models is
+
+ -----------
+ -- Clear --
+ -----------
+
+ overriding procedure Clear (Self : access Messages_Filter_Model_Record) is
+ begin
+ Code_Peer.Message_Categories_Models.Message_Categories_Model_Record
+ (Self.all).Clear;
+
+ Self.Categories.Clear;
+ end Clear;
+
+ ---------------------
+ -- Get_Column_Type --
+ ---------------------
+
+ overriding function Get_Column_Type
+ (Self : access Messages_Filter_Model_Record;
+ Index : Glib.Gint) return Glib.GType
+ is
+ pragma Unreferenced (Self);
+
+ begin
+ case Index is
+ when Active_Column =>
+ return Glib.GType_Boolean;
+
+ when Name_Column =>
+ return Glib.GType_String;
+
+ when others =>
+ return Glib.GType_Invalid;
+ end case;
+ end Get_Column_Type;
+
+ -------------------
+ -- Get_N_Columns --
+ -------------------
+
+ overriding function Get_N_Columns
+ (Self : access Messages_Filter_Model_Record) return Glib.Gint
+ is
+ pragma Unreferenced (Self);
+
+ begin
+ return Column_Count;
+ end Get_N_Columns;
+
+ ---------------
+ -- Get_Value --
+ ---------------
+
+ overriding procedure Get_Value
+ (Self : access Messages_Filter_Model_Record;
+ Iter : Gtk.Tree_Model.Gtk_Tree_Iter;
+ Column : Glib.Gint;
+ Value : out Glib.Values.GValue)
+ is
+ begin
+ case Column is
+ when Active_Column =>
+ Glib.Values.Init (Value, Glib.GType_Boolean);
+ Glib.Values.Set_Boolean
+ (Value, Self.Categories.Contains (Self.Category_At (Iter)));
+
+ when Name_Column =>
+ Glib.Values.Init (Value, Glib.GType_String);
+ Glib.Values.Set_String (Value, Self.Category_At (Iter).Name.all);
+
+ when others =>
+ Glib.Values.Init (Value, Glib.GType_Invalid);
+ end case;
+ end Get_Value;
+
+ ----------------------------
+ -- Get_Visible_Categories --
+ ----------------------------
+
+ function Get_Visible_Categories
+ (Self : access Messages_Filter_Model_Record'Class)
+ return Code_Peer.Message_Category_Sets.Set is
+ begin
+ return Self.Categories;
+ end Get_Visible_Categories;
+
+ -------------
+ -- Gtk_New --
+ -------------
+
+ procedure Gtk_New
+ (Model : in out Messages_Filter_Model;
+ Categories : Code_Peer.Message_Category_Sets.Set)
+ is
+ begin
+ Model := new Messages_Filter_Model_Record;
+
+ Initialize (Model, Categories);
+ end Gtk_New;
+
+ ----------
+ -- Hide --
+ ----------
+
+ procedure Hide
+ (Self : access Messages_Filter_Model_Record'Class;
+ Category : Code_Peer.Message_Category_Access)
+ is
+ begin
+ Self.Categories.Exclude (Category);
+ Self.Row_Changed (Category);
+ end Hide;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize
+ (Self : access Messages_Filter_Model_Record'Class;
+ Categories : Code_Peer.Message_Category_Sets.Set) is
+ begin
+ Code_Peer.Message_Categories_Models.Initialize (Self, Categories);
+
+ Self.Categories := Categories;
+ end Initialize;
+
+ ----------
+ -- Show --
+ ----------
+
+ procedure Show
+ (Self : access Messages_Filter_Model_Record'Class;
+ Category : Code_Peer.Message_Category_Access)
+ is
+ begin
+ Self.Categories.Include (Category);
+ Self.Row_Changed (Category);
+ end Show;
+
+end Code_Peer.Messages_Filter_Models;
============================================================
--- code_analysis/src/code_peer-messages_filter_models.ads 12c213d96a7e0854b9a782254749cf5619a1f171
+++ code_analysis/src/code_peer-messages_filter_models.ads 12c213d96a7e0854b9a782254749cf5619a1f171
@@ -0,0 +1,80 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2008, AdaCore --
+-- --
+-- GPS is Free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+with Glib.Values;
+with Gtk.Tree_Model;
+
+with Code_Peer.Message_Categories_Models;
+
+package Code_Peer.Messages_Filter_Models is
+
+ Active_Column : constant := 0;
+ Name_Column : constant := 1;
+ Column_Count : constant := 2;
+
+ type Messages_Filter_Model_Record is
+ new Code_Peer.Message_Categories_Models.Message_Categories_Model_Record
+ with private;
+
+ type Messages_Filter_Model is access all Messages_Filter_Model_Record'Class;
+
+ procedure Gtk_New
+ (Model : in out Messages_Filter_Model;
+ Categories : Code_Peer.Message_Category_Sets.Set);
+
+ procedure Initialize
+ (Self : access Messages_Filter_Model_Record'Class;
+ Categories : Code_Peer.Message_Category_Sets.Set);
+
+ procedure Show
+ (Self : access Messages_Filter_Model_Record'Class;
+ Category : Code_Peer.Message_Category_Access);
+
+ procedure Hide
+ (Self : access Messages_Filter_Model_Record'Class;
+ Category : Code_Peer.Message_Category_Access);
+
+ function Get_Visible_Categories
+ (Self : access Messages_Filter_Model_Record'Class)
+ return Code_Peer.Message_Category_Sets.Set;
+
+ overriding procedure Clear (Self : access Messages_Filter_Model_Record);
+
+private
+
+ type Messages_Filter_Model_Record is
+ new Code_Peer.Message_Categories_Models.Message_Categories_Model_Record
+ with record
+ Categories : Code_Peer.Message_Category_Sets.Set;
+ end record;
+
+ overriding function Get_N_Columns
+ (Self : access Messages_Filter_Model_Record) return Glib.Gint;
+
+ overriding function Get_Column_Type
+ (Self : access Messages_Filter_Model_Record;
+ Index : Glib.Gint) return Glib.GType;
+
+ overriding procedure Get_Value
+ (Self : access Messages_Filter_Model_Record;
+ Iter : Gtk.Tree_Model.Gtk_Tree_Iter;
+ Column : Glib.Gint;
+ Value : out Glib.Values.GValue);
+
+end Code_Peer.Messages_Filter_Models;
============================================================
--- common/src/separate_run_path_option.c 478f96410f2126ddd2c62e95c070886bcf9136d6
+++ common/src/separate_run_path_option.c 478f96410f2126ddd2c62e95c070886bcf9136d6
@@ -0,0 +1,23 @@
+/*********************************************************************
+ * G P S *
+ * *
+ * Copyright (C) 2009, AdaCore *
+ * *
+ * GPS is free software; you can redistribute it and/or modify it *
+ * under the terms of the GNU General Public License as published by *
+ * the Free Software Foundation; either version 2 of the License, or *
+ * (at your option) any later version. *
+ * *
+ * This program is distributed in the hope that it will be useful, *
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of *
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
+ * General Public License for more details. You should have received *
+ * a copy of the GNU General Public License along with this program; *
+ * if not, write to the Free Software Foundation, Inc., 59 Temple *
+ * Place - Suite 330, Boston, MA 02111-1307, USA. *
+ *********************************************************************/
+
+
+/* Dummy version of __gnat_separate_run_path_options, needed by mlib.adb */
+
+const char __gnat_separate_run_path_options = 0;
============================================================
--- gnatlib/distrib/gnatcoll_gmp.gpr.in 85d093035c3f4340d66e36b4ed61d1c3159ae909
+++ gnatlib/distrib/gnatcoll_gmp.gpr.in 85d093035c3f4340d66e36b4ed61d1c3159ae909
@@ -0,0 +1,17 @@
+with "gnatcoll";
+project GnatColl_Gmp is
+ for Library_Name use "gnatcoll_gmp";
+ for Source_Dirs use ("../../include/gnatcoll");
+ for Externally_Built use "true";
+
+ for Source_List_File use "gnatcoll/" & Project'Library_Name & ".lgpr";
+ for Library_Kind use GnatColl.GnatColl_Kind;
+ for Library_Dir use "../gnatcoll/" & Project'Library_Kind;
+ for Library_Version use
+ "lib" & Project'Library_Name & ".so." & Gnatcoll.Version;
+
+ package Linker is
+ for Linker_Options use (@GMP_LIBS_GPR@);
+ end Linker;
+end GnatColl_Gmp;
+
============================================================
--- gnatlib/src/Makefile.gmp 21df1073107d6a53d13f41eaa888c6c255a5564b
+++ gnatlib/src/Makefile.gmp 21df1073107d6a53d13f41eaa888c6c255a5564b
@@ -0,0 +1,32 @@
+MODULE=gmp
+PROJECT=gnatcoll_${MODULE}
+LIBNAME=lib${TARNAME}_${MODULE}
+
+include ../Makefile.conf
+
+ifeq (${WITH_GMP},yes)
+SRCDIRS=./gmp/
+endif
+
+all: dirs buildcfiles buildall
+clean: cleanall
+install: libinstall
+
+ifeq (${LIBRARY_TYPE},static)
+FPIC=
+else
+FPIC=-fPIC
+endif
+
+.PHONY: buildcfiles
+buildcfiles:
+
+ifeq (${WITH_GMP},yes)
+C_OBJ=obj/gmp/${LIBRARY_TYPE}/gmp_support.o
+buildcfiles: ${C_OBJ}
+${C_OBJ}: gmp/gmp_support.c
+ ${CC} -c ${FPIC} ${GMP_CFLAGS} $< -o $@
+clean:
+ ${RM} ${C_OBJ}
+endif
+
============================================================
--- gnatlib/src/gmp/gmp_support.c 5e6301a621f4e6033bb856a9d148c6879dbfb496
+++ gnatlib/src/gmp/gmp_support.c 5e6301a621f4e6033bb856a9d148c6879dbfb496
@@ -0,0 +1,25 @@
+/*-------------------------------------------------------------------
+ G N A T C O L L --
+ --
+ Copyright (C) 2009, AdaCore --
+ --
+ GPS is free software; you can redistribute it and/or modify it --
+ under the terms of the GNU General Public License as published by --
+ the Free Software Foundation; either version 2 of the License, or --
+ (at your option) any later version. --
+ --
+ This program is distributed in the hope that it will be useful, --
+ but WITHOUT ANY WARRANTY; without even the implied warranty of --
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+ General Public License for more details. You should have received --
+ a copy of the GNU General Public License along with this library; --
+ if not, write to the Free Software Foundation, Inc., 59 Temple --
+ Place - Suite 330, Boston, MA 02111-1307, USA. --
+---------------------------------------------------------------------*/
+
+#include <gmp.h>
+
+void gnatcoll_gmp_test() {
+ mpz_t integ;
+ mpz_init (integ);
+}
============================================================
--- gnatlib/src/gmp/gnatcoll-gmp.ads 1772141f17ee6bb5c2305a89bb27fb0414cc7a64
+++ gnatlib/src/gmp/gnatcoll-gmp.ads 1772141f17ee6bb5c2305a89bb27fb0414cc7a64
@@ -0,0 +1,22 @@
+-----------------------------------------------------------------------
+-- G N A T C O L L --
+-- --
+-- Copyright (C) 2009, AdaCore --
+-- --
+-- GPS is free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this library; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+package GNATCOLL.GMP is
+
+end GNATCOLL.GMP;
============================================================
--- gnatlib/src/gnatcoll_gmp.gpr.in 16b4422a3411eb02d32d78c84744aa6a10831411
+++ gnatlib/src/gnatcoll_gmp.gpr.in 16b4422a3411eb02d32d78c84744aa6a10831411
@@ -0,0 +1,26 @@
+with "../gnatcoll_shared";
+with "gnatcoll";
+
+project GnatColl_Gmp is
+ for Library_Kind use GnatColl_Shared.Library_Type;
+ for Object_Dir use "obj/gmp/" & Project'Library_Kind;
+ for Library_Dir use "lib/gmp/" & Project'Library_Kind;
+ for Library_Name use GnatColl_Shared.Name & "_gmp";
+ for Library_Version use
+ "lib" & Project'Library_Name & ".so." & GnatColl_Shared.Version;
+
+ -- When linking a shared library (see Linker_Options below in addition)
+ for Library_Options use (@GMP_LIBS_GPR@);
+
+ for Languages use ("Ada", "C");
+ for Source_Dirs use ("gmp");
+
+ package Compiler renames Gnatcoll_Shared.Compiler;
+ package Linker is
+ -- When linking an executable
+ for Linker_Options use (@GMP_LIBS_GPR@);
+ end Linker;
+
+ package Ide renames GnatColl_Shared.Ide;
+
+end GnatColl_Gmp;
============================================================
--- kernel/src/gps-editors.adb 7ba2cebbaa0dc2fba1a0face9e753f824d71a952
+++ kernel/src/gps-editors.adb 7ba2cebbaa0dc2fba1a0face9e753f824d71a952
@@ -0,0 +1,221 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2008-2009, AdaCore --
+-- --
+-- GPS is free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+package body GPS.Editors is
+
+ -- Dummy bodies for implementation of Nil values.
+
+ procedure Add_Special_Line
+ (This : Editor_Buffer'Class;
+ Start_Line : Integer;
+ Text : String;
+ Category : String := "";
+ Name : String := "")
+ is
+ Mark : constant Editor_Mark'Class :=
+ This.Add_Special_Line (Start_Line, Text, Category, Name);
+ pragma Unreferenced (Mark);
+
+ begin
+ null;
+ end Add_Special_Line;
+
+ overriding function Beginning_Of_Line
+ (This : Dummy_Editor_Location) return Editor_Location'Class
+ is
+ pragma Unreferenced (This);
+ begin
+ return Nil_Editor_Location;
+ end Beginning_Of_Line;
+
+ overriding function End_Of_Line
+ (This : Dummy_Editor_Location) return Editor_Location'Class
+ is
+ pragma Unreferenced (This);
+ begin
+ return Nil_Editor_Location;
+ end End_Of_Line;
+
+ overriding function Block_Start
+ (This : Dummy_Editor_Location) return Editor_Location'Class
+ is
+ pragma Unreferenced (This);
+ begin
+ return Nil_Editor_Location;
+ end Block_Start;
+
+ overriding function Block_End
+ (This : Dummy_Editor_Location) return Editor_Location'Class
+ is
+ pragma Unreferenced (This);
+ begin
+ return Nil_Editor_Location;
+ end Block_End;
+
+ overriding function Block_Type
+ (This : Dummy_Editor_Location) return Language_Category
+ is
+ pragma Unreferenced (This);
+ begin
+ return Cat_Unknown;
+ end Block_Type;
+
+ overriding function Line (This : Dummy_Editor_Location) return Integer is
+ pragma Unreferenced (This);
+ begin
+ return 0;
+ end Line;
+
+ overriding function Column (This : Dummy_Editor_Location) return Integer is
+ pragma Unreferenced (This);
+ begin
+ return 0;
+ end Column;
+
+ overriding function Create_Mark
+ (This : Dummy_Editor_Location; Name : String := "")
+ return Editor_Mark'Class
+ is
+ pragma Unreferenced (This, Name);
+ begin
+ return Nil_Editor_Mark;
+ end Create_Mark;
+
+ overriding function Forward_Char
+ (This : Dummy_Editor_Location;
+ Count : Integer) return Editor_Location'Class
+ is
+ pragma Unreferenced (This, Count);
+ begin
+ return Nil_Editor_Location;
+ end Forward_Char;
+
+ overriding function Location
+ (This : Dummy_Editor_Mark) return Editor_Location'Class
+ is
+ pragma Unreferenced (This);
+ begin
+ return Nil_Editor_Location;
+ end Location;
+
+ overriding function New_Location
+ (This : Dummy_Editor_Buffer;
+ Line : Integer;
+ Column : Integer) return Editor_Location'Class
+ is
+ pragma Unreferenced (This, Line, Column);
+ begin
+ return Nil_Editor_Location;
+ end New_Location;
+
+ overriding function New_View
+ (This : Dummy_Editor_Buffer) return Editor_View'Class
+ is
+ pragma Unreferenced (This);
+ begin
+ return Nil_Editor_View;
+ end New_View;
+
+ overriding function Open
+ (This : Dummy_Editor_Buffer) return Editor_View'Class
+ is
+ pragma Unreferenced (This);
+ begin
+ return Nil_Editor_View;
+ end Open;
+
+ overriding function Add_Special_Line
+ (This : Dummy_Editor_Buffer;
+ Start_Line : Integer;
+ Text : String;
+ Category : String := "";
+ Name : String := "") return Editor_Mark'Class
+ is
+ pragma Unreferenced (This, Start_Line, Text, Category, Name);
+ begin
+ return Nil_Editor_Mark;
+ end Add_Special_Line;
+
+ overriding function Current_View
+ (This : Dummy_Editor_Buffer) return Editor_View'Class
+ is
+ pragma Unreferenced (This);
+ begin
+ return Nil_Editor_View;
+ end Current_View;
+
+ overriding function Lines_Count
+ (This : Dummy_Editor_Buffer) return Integer
+ is
+ pragma Unreferenced (This);
+ begin
+ return 0;
+ end Lines_Count;
+
+ overriding function Get_Chars
+ (This : Dummy_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location) return String
+ is
+ pragma Unreferenced (This, From, To);
+ begin
+ return "";
+ end Get_Chars;
+
+ overriding function Beginning_Of_Buffer
+ (This : Dummy_Editor_Buffer) return Editor_Location'Class
+ is
+ pragma Unreferenced (This);
+ begin
+ return Nil_Editor_Location;
+ end Beginning_Of_Buffer;
+
+ overriding function End_Of_Buffer
+ (This : Dummy_Editor_Buffer) return Editor_Location'Class
+ is
+ pragma Unreferenced (This);
+ begin
+ return Nil_Editor_Location;
+ end End_Of_Buffer;
+
+ overriding function Get_Mark
+ (This : Dummy_Editor_Buffer;
+ Name : String) return Editor_Mark'Class
+ is
+ pragma Unreferenced (This, Name);
+ begin
+ return Nil_Editor_Mark;
+ end Get_Mark;
+
+ overriding function Is_Present (This : Dummy_Editor_Mark) return Boolean is
+ pragma Unreferenced (This);
+
+ begin
+ return False;
+ end Is_Present;
+
+ overriding function Cursor
+ (This : Dummy_Editor_View) return Editor_Location'Class
+ is
+ pragma Unreferenced (This);
+ begin
+ return Nil_Editor_Location;
+ end Cursor;
+
+end GPS.Editors;
============================================================
--- kernel/src/gps-editors.ads 9c3a57a921b2e4b8180788fcea29ef94585750c4
+++ kernel/src/gps-editors.ads 9c3a57a921b2e4b8180788fcea29ef94585750c4
@@ -0,0 +1,446 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2008-2009, AdaCore --
+-- --
+-- GPS is free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+with GNATCOLL.VFS; use GNATCOLL.VFS;
+with Ada.Finalization; use Ada.Finalization;
+with Language; use Language;
+
+package GPS.Editors is
+
+ -- Declarations of types
+
+ -- The following types & subprograms are used as an abstraction to the
+ -- editor facilities by the GPS code. This avoid relying directly on Gtk
+ -- internals, and open the door to possible alternate implementation, such
+ -- as Eclipse for GNATbench.
+
+ type Editor_Buffer_Factory is abstract new Controlled with null record;
+
+ type Editor_Location is abstract new Controlled with null record;
+ Nil_Editor_Location : constant Editor_Location'Class;
+
+ type Editor_Mark is abstract new Controlled with null record;
+ Nil_Editor_Mark : constant Editor_Mark'Class;
+
+ type Editor_Buffer is abstract new Controlled with null record;
+ Nil_Editor_Buffer : constant Editor_Buffer'Class;
+
+ type Editor_View is abstract new Controlled with null record;
+ Nil_Editor_View : constant Editor_View'Class;
+
+ ---------------------------
+ -- Editor_Buffer_Factory --
+ ---------------------------
+
+ function Get
+ (This : Editor_Buffer_Factory;
+ File : Virtual_File := No_File;
+ Force : Boolean := False;
+ Open : Boolean := True) return Editor_Buffer'Class is abstract;
+ -- If file is not specified, the current editor is returned, ie the last
+ -- one that had the keyboard focus.
+ --
+ -- If the file is not currently open, the behavior depends on the open
+ -- parameter: if true, a new editor is created for that file, otherwise
+ -- None is returned.
+ --
+ -- When a new file is open, it has received the focus. But if the editor
+ -- already existed, it is not raised explicitly, and you need to do it
+ -- yourself.
+ --
+ -- If force is set to true, a reload is forced in case the file is already
+ -- open.
+
+ --------------------
+ -- Editor_Overlay --
+ --------------------
+
+ ---------------------
+ -- Editor_Location --
+ ---------------------
+
+ function Beginning_Of_Line
+ (This : Editor_Location) return Editor_Location'Class is abstract;
+ -- Return a location located at the beginning of the line on which This is.
+
+ function End_Of_Line
+ (This : Editor_Location) return Editor_Location'Class is abstract;
+ -- Return a location located at the end of the line on which self is.
+
+ function Block_Start
+ (This : Editor_Location) return Editor_Location'Class is abstract;
+ -- Return the location of the beginning of the current block
+
+ function Block_End
+ (This : Editor_Location) return Editor_Location'Class is abstract;
+ -- Return the location of the end of the current block
+
+ function Block_Type
+ (This : Editor_Location) return Language_Category is abstract;
+ -- Return the type of the block surrounding the location. This type
+ -- indicates whether the block is a subprogram, an if statement,...
+
+ function Line (This : Editor_Location) return Integer is abstract;
+ -- Return the line of the location
+
+ function Column (This : Editor_Location) return Integer is abstract;
+ -- Return the column of the location
+
+ function Create_Mark
+ (This : Editor_Location; Name : String := "")
+ return Editor_Mark'Class is abstract;
+ -- Create a mark at that location in the buffer. The mark will stay
+ -- permanently at that location, and follows if the buffer is modified. If
+ -- the name is specified, this creates a named mark, which can be retrieved
+ -- through a call to GPS.EditorBuffer.get_mark. If a mark with the same
+ -- name already exists, it is moved to the new location, and then returned
+
+ function Forward_Char
+ (This : Editor_Location;
+ Count : Integer) return Editor_Location'Class is abstract;
+ -- Return a new location located count characters after self. If count is
+ -- negative, the location is moved backward instead
+ -- ??? Is this in byte offset or character offset?
+
+ -----------------
+ -- Editor_Mark --
+ -----------------
+
+ function Location
+ (This : Editor_Mark) return Editor_Location'Class is abstract;
+ -- Returns the current location of the mark. This location will vary
+ -- depending on the changes that take place in the buffer
+
+ function Is_Present (This : Editor_Mark) return Boolean is abstract;
+ -- Returns True if mark's location is still present in the buffer
+
+ procedure Delete (This : Editor_Mark) is abstract;
+ -- Deletes the physical mark from the buffer
+
+ -------------------
+ -- Editor_Buffer --
+ -------------------
+
+ function New_Location
+ (This : Editor_Buffer;
+ Line : Integer;
+ Column : Integer) return Editor_Location'Class is abstract;
+ -- Return a new location.
+
+ function New_View
+ (This : Editor_Buffer) return Editor_View'Class is abstract;
+ -- Creates a new view for the given buffer, and insert it in the MDI
+
+ function Open (This : Editor_Buffer) return Editor_View'Class is abstract;
+ -- Opens a view for the given buffer. If the view is already exists, it
+ -- will get the focus, otherwise a new view will be opened.
+
+ function Add_Special_Line
+ (This : Editor_Buffer;
+ Start_Line : Integer;
+ Text : String;
+ Category : String := "";
+ Name : String := "") return Editor_Mark'Class is abstract;
+ -- Adds one non-editable line to the buffer, starting at line start_line
+ -- and contains string text. If category is specified, use it for
+ -- highlighting. Create a mark at beginning of block and return it. If name
+ -- is specified, retuned mark will have this name
+
+ procedure Add_Special_Line
+ (This : Editor_Buffer'Class;
+ Start_Line : Integer;
+ Text : String;
+ Category : String := "";
+ Name : String := "");
+ -- Same as above, but doesn't return mark
+
+ procedure Remove_Special_Lines
+ (This : Editor_Buffer;
+ Mark : Editor_Mark'Class;
+ Lines : Integer) is abstract;
+ -- Removes specified number of special lines at the specified mark. It
+ -- doesn't delete the mark
+
+ function Current_View
+ (This : Editor_Buffer) return Editor_View'Class is abstract;
+ -- Returns the last view used for this buffer, ie the last view that had
+ -- the focus and through which the user might have edited the buffer's
+ -- contents
+
+ function Lines_Count (This : Editor_Buffer) return Integer is abstract;
+ -- Returns the total number of lines in the buffer
+
+ procedure Select_Text
+ (This : Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location) is abstract;
+ -- Selects an area in the buffer. The boundaries are included in the
+ -- selection. The order of the boundaries is irrelevant, but the cursor
+ -- will be left on to. By default, From is set to the beginning of the
+ -- buffer, and to to the end.
+
+ function Get_Chars
+ (This : Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location)
+ return String is abstract;
+ -- Returns the contents of the buffer between the two locations given in
+ -- parameter. Modifying the returned value has no effect on the buffer
+
+ procedure Insert
+ (This : Editor_Buffer;
+ From : Editor_Location'Class;
+ Text : String) is abstract;
+ -- Inserts some text in the buffer
+
+ procedure Delete
+ (This : Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location) is abstract;
+ -- Delete the given range of text from the buffer
+
+ procedure Indent
+ (This : Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location) is abstract;
+ -- Recompute the indentation of the given range of text. This feature is
+ -- language-dependent. By default, from points to the beginning of the
+ -- buffer and to to the end of the buffer.
+
+ function Beginning_Of_Buffer
+ (This : Editor_Buffer) return Editor_Location'Class is abstract;
+ -- Returns a location pointing to the first character in the buffer
+
+ function End_Of_Buffer
+ (This : Editor_Buffer) return Editor_Location'Class is abstract;
+ -- Returns a location pointing to the last character in the buffer
+
+ procedure Save
+ (This : Editor_Buffer;
+ Interactive : Boolean := True;
+ File : Virtual_File := No_File) is abstract;
+ -- Saves the buffer to the given file. If interactive is true, a dialog is
+ -- open to ask for confirmation from the user first, which gives him a
+ -- chance to cancel the saving. "interactive" is ignored if file is
+ -- specified. When no file is specified, then the buffer will be saved
+ -- in the same file as it's currently edited.
+
+ function Get_Mark
+ (This : Editor_Buffer;
+ Name : String) return Editor_Mark'Class is abstract;
+ -- Check whether there is a mark with that name in the buffer, and return
+ -- it. A Nil_Editor_Mark is returned if there is no such mark
+
+ procedure Start_Undo_Group (This : Editor_Buffer) is abstract;
+ -- Starts grouping commands on the editor. All future editions will be
+ -- considered as belonging to the same group. finish_undo_group should be
+ -- called once for every call to start_undo_group.
+
+ procedure Finish_Undo_Group (This : Editor_Buffer) is abstract;
+ -- ancels the grouping of commands on the editor. See
+ -- GPS.EditorBuffer.start_undo_group
+
+ procedure Undo (This : Editor_Buffer) is abstract;
+ -- Undo the last command on the editor
+
+ procedure Set_Read_Only
+ (This : Editor_Buffer; Read_Only : Boolean) is abstract;
+ -- Indicates whether the user should be able to edit the buffer
+ -- interactively (through any view).
+
+ -----------------
+ -- Editor_View --
+ -----------------
+
+ procedure Set_Read_Only
+ (This : Editor_View; Read_Only : Boolean) is abstract;
+ -- Indicates whether the user should be able to edit interactively through
+ -- this view. Setting a view Writable/Read Only will also modify the status
+ -- of the other views of the same buffer.xx
+
+ procedure Center
+ (This : Editor_View;
+ Location : Editor_Location'Class := Nil_Editor_Location) is abstract;
+ -- Scrolls the view so that the location is centered. By default, the
+ -- editor is centered around the location of the cursor.
+
+ function Cursor
+ (This : Editor_View) return Editor_Location'Class is abstract;
+ -- Return the current location of the cursor in this view
+
+private
+
+ -------------------------
+ -- Nil_Editor_Location --
+ -------------------------
+
+ type Dummy_Editor_Location is new Editor_Location with null record;
+
+ overriding function Beginning_Of_Line
+ (This : Dummy_Editor_Location) return Editor_Location'Class;
+
+ overriding function End_Of_Line
+ (This : Dummy_Editor_Location) return Editor_Location'Class;
+
+ overriding function Block_Start
+ (This : Dummy_Editor_Location) return Editor_Location'Class;
+
+ overriding function Block_End
+ (This : Dummy_Editor_Location) return Editor_Location'Class;
+
+ overriding function Block_Type
+ (This : Dummy_Editor_Location) return Language_Category;
+
+ overriding function Line (This : Dummy_Editor_Location) return Integer;
+
+ overriding function Column (This : Dummy_Editor_Location) return Integer;
+
+ overriding function Create_Mark
+ (This : Dummy_Editor_Location; Name : String := "")
+ return Editor_Mark'Class;
+
+ overriding function Forward_Char
+ (This : Dummy_Editor_Location;
+ Count : Integer) return Editor_Location'Class;
+
+ Nil_Editor_Location : constant Editor_Location'Class :=
+ Dummy_Editor_Location'(Controlled with others => <>);
+
+ ---------------------
+ -- Nil_Editor_Mark --
+ ---------------------
+
+ type Dummy_Editor_Mark is new Editor_Mark with null record;
+
+ overriding function Location
+ (This : Dummy_Editor_Mark) return Editor_Location'Class;
+
+ overriding function Is_Present (This : Dummy_Editor_Mark) return Boolean;
+
+ overriding procedure Delete (This : Dummy_Editor_Mark) is null;
+
+ Nil_Editor_Mark : constant Editor_Mark'Class :=
+ Dummy_Editor_Mark'(Controlled with others => <>);
+
+ -----------------------
+ -- Nil_Editor_Buffer --
+ -----------------------
+
+ type Dummy_Editor_Buffer is new Editor_Buffer with null record;
+
+ overriding function New_Location
+ (This : Dummy_Editor_Buffer;
+ Line : Integer;
+ Column : Integer) return Editor_Location'Class;
+
+ overriding function New_View
+ (This : Dummy_Editor_Buffer) return Editor_View'Class;
+
+ overriding function Open
+ (This : Dummy_Editor_Buffer) return Editor_View'Class;
+
+ overriding function Add_Special_Line
+ (This : Dummy_Editor_Buffer;
+ Start_Line : Integer;
+ Text : String;
+ Category : String := "";
+ Name : String := "") return Editor_Mark'Class;
+
+ overriding procedure Remove_Special_Lines
+ (This : Dummy_Editor_Buffer;
+ Mark : Editor_Mark'Class;
+ Lines : Integer) is null;
+
+ overriding function Current_View
+ (This : Dummy_Editor_Buffer) return Editor_View'Class;
+
+ overriding function Lines_Count (This : Dummy_Editor_Buffer) return Integer;
+
+ overriding procedure Select_Text
+ (This : Dummy_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location) is null;
+
+ overriding function Get_Chars
+ (This : Dummy_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location) return String;
+
+ overriding procedure Insert
+ (This : Dummy_Editor_Buffer;
+ From : Editor_Location'Class;
+ Text : String) is null;
+
+ overriding procedure Delete
+ (This : Dummy_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location) is null;
+
+ overriding procedure Indent
+ (This : Dummy_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location) is null;
+
+ overriding function Beginning_Of_Buffer
+ (This : Dummy_Editor_Buffer) return Editor_Location'Class;
+
+ overriding function End_Of_Buffer
+ (This : Dummy_Editor_Buffer) return Editor_Location'Class;
+
+ overriding procedure Save
+ (This : Dummy_Editor_Buffer;
+ Interactive : Boolean := True;
+ File : Virtual_File := No_File) is null;
+
+ overriding function Get_Mark
+ (This : Dummy_Editor_Buffer;
+ Name : String) return Editor_Mark'Class;
+
+ overriding procedure Start_Undo_Group (This : Dummy_Editor_Buffer) is null;
+
+ overriding procedure Finish_Undo_Group (This : Dummy_Editor_Buffer) is null;
+
+ overriding procedure Undo (This : Dummy_Editor_Buffer) is null;
+
+ overriding procedure Set_Read_Only
+ (This : Dummy_Editor_Buffer; Read_Only : Boolean) is null;
+
+ Nil_Editor_Buffer : constant Editor_Buffer'Class :=
+ Dummy_Editor_Buffer'(Controlled with others => <>);
+
+ ---------------------
+ -- Nil_Editor_View --
+ ---------------------
+
+ type Dummy_Editor_View is new Editor_View with null record;
+
+ overriding procedure Set_Read_Only
+ (This : Dummy_Editor_View; Read_Only : Boolean) is null;
+
+ overriding procedure Center
+ (This : Dummy_Editor_View;
+ Location : Editor_Location'Class := Nil_Editor_Location) is null;
+
+ overriding function Cursor
+ (This : Dummy_Editor_View) return Editor_Location'Class;
+
+ Nil_Editor_View : constant Editor_View'Class :=
+ Dummy_Editor_View'(Controlled with others => <>);
+
+end GPS.Editors;
============================================================
--- src_editor/src/src_editor_module-editors.adb f4d5fd827e35e56de280ff4954ddcd9d0b506d03
+++ src_editor/src/src_editor_module-editors.adb f4d5fd827e35e56de280ff4954ddcd9d0b506d03
@@ -0,0 +1,1306 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2008-2009, AdaCore --
+-- --
+-- GPS is free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+with Ada.Unchecked_Deallocation;
+
+with Gtk.Text_Iter; use Gtk.Text_Iter;
+with Gtk.Text_Mark; use Gtk.Text_Mark;
+
+with GPS.Intl; use GPS.Intl;
+with GPS.Kernel.MDI; use GPS.Kernel.MDI;
+
+with Src_Editor_Module.Line_Highlighting;
+use Src_Editor_Module.Line_Highlighting;
+with Src_Editor_Buffer.Line_Information;
+use Src_Editor_Buffer.Line_Information;
+with Src_Editor_Box; use Src_Editor_Box;
+with Src_Editor_View; use Src_Editor_View;
+
+with Commands; use Commands;
+with Language; use Language;
+with Traces; use Traces;
+
+package body Src_Editor_Module.Editors is
+ Me : constant Debug_Handle := Create ("Editor.Buffer");
+
+ Editor_Exception : exception;
+
+ type Src_Editor_Buffer is new GPS.Editors.Editor_Buffer with record
+ Kernel : Kernel_Handle;
+ Buffer : Source_Buffer;
+ end record;
+
+ type Src_Editor_Location is new GPS.Editors.Editor_Location with record
+ Buffer : Src_Editor_Buffer;
+ Line : Editable_Line_Type;
+ Column : Visible_Column_Type;
+ end record;
+
+ type Mark_Reference is record
+ Mark : Gtk_Text_Mark;
+ Refs : Integer := 1;
+ end record;
+
+ type Mark_Reference_Access is access all Mark_Reference;
+
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Mark_Reference, Mark_Reference_Access);
+
+ type Src_Editor_Mark is new GPS.Editors.Editor_Mark with record
+ Buffer : Src_Editor_Buffer;
+ Mark : Mark_Reference_Access;
+ end record;
+
+ type Src_Editor_View is new GPS.Editors.Editor_View with record
+ Buffer : Src_Editor_Buffer;
+ Box : Source_Editor_Box;
+ end record;
+
+ function Create_Editor_Location
+ (Buffer : Src_Editor_Buffer'Class;
+ Location : Gtk_Text_Iter) return Src_Editor_Location'Class;
+ -- Return an instance of Editor_Location
+
+ procedure Get_Location
+ (Iter : out Gtk_Text_Iter;
+ Location : Src_Editor_Location'Class;
+ Default : Gtk_Text_Iter;
+ Success : out Boolean);
+ -- Return the iter stored in Location.
+ -- If no location could be obtain from the arguments, Iter is Set to
+ -- Default and Success to False.
+
+ procedure Get_Locations
+ (Iter1 : out Gtk_Text_Iter;
+ Iter2 : out Gtk_Text_Iter;
+ Buffer : Source_Buffer;
+ Loc1 : Src_Editor_Location'Class;
+ Loc2 : Src_Editor_Location'Class;
+ Compensate_Last_Iter : Boolean := True);
+ -- Set the two iteratiors from the given locations.
+ -- Buffer is reset to null in case of errors, or if it was null when
+ -- Get_Locations was called.
+ -- If Compensate_Last_Iter is True, then the highest iterator is moved one
+ -- additional character. This is used for gtk+ commands that take two
+ -- iterators, since they stop to operate just before the last iterator.
+
+ function Create_Editor_Mark
+ (Buffer : Src_Editor_Buffer'Class;
+ Mark : Gtk_Text_Mark) return Src_Editor_Mark'Class;
+ -- Returns an instance of Editor_Mark encapsulating Mark. Mark must not be
+ -- null.
+
+ -------------------------
+ -- Src_Editor_Location --
+ -------------------------
+
+ overriding function Beginning_Of_Line
+ (This : Src_Editor_Location) return Editor_Location'Class;
+
+ overriding function End_Of_Line
+ (This : Src_Editor_Location) return Editor_Location'Class;
+
+ overriding function Block_Start
+ (This : Src_Editor_Location) return Editor_Location'Class;
+
+ overriding function Block_End
+ (This : Src_Editor_Location) return Editor_Location'Class;
+
+ overriding function Block_Type
+ (This : Src_Editor_Location) return Language_Category;
+
+ overriding function Line (This : Src_Editor_Location) return Integer;
+
+ overriding function Column (This : Src_Editor_Location) return Integer;
+
+ overriding function Create_Mark
+ (This : Src_Editor_Location; Name : String := "")
+ return Editor_Mark'Class;
+
+ overriding function Forward_Char
+ (This : Src_Editor_Location;
+ Count : Integer) return Editor_Location'Class;
+
+ ---------------------
+ -- Src_Editor_Mark --
+ ---------------------
+
+ overriding function Is_Present (This : Src_Editor_Mark) return Boolean;
+
+ overriding procedure Delete (This : Src_Editor_Mark);
+
+ overriding procedure Adjust (This : in out Src_Editor_Mark);
+
+ overriding procedure Finalize (This : in out Src_Editor_Mark);
+
+ overriding function Location
+ (This : Src_Editor_Mark) return Editor_Location'Class;
+
+ -----------------------
+ -- Src_Editor_Buffer --
+ -----------------------
+
+ overriding function New_Location
+ (This : Src_Editor_Buffer;
+ Line : Integer;
+ Column : Integer) return Editor_Location'Class;
+
+ overriding function New_View
+ (This : Src_Editor_Buffer) return Editor_View'Class;
+
+ overriding function Open
+ (This : Src_Editor_Buffer) return Editor_View'Class;
+
+ overriding function Add_Special_Line
+ (This : Src_Editor_Buffer;
+ Start_Line : Integer;
+ Text : String;
+ Category : String := "";
+ Name : String := "") return Editor_Mark'Class;
+
+ overriding procedure Remove_Special_Lines
+ (This : Src_Editor_Buffer;
+ Mark : Editor_Mark'Class;
+ Lines : Integer);
+
+ overriding function Current_View
+ (This : Src_Editor_Buffer) return Editor_View'Class;
+
+ overriding function Lines_Count (This : Src_Editor_Buffer) return Integer;
+
+ overriding procedure Select_Text
+ (This : Src_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location);
+
+ overriding function Get_Chars
+ (This : Src_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location) return String;
+
+ overriding procedure Insert
+ (This : Src_Editor_Buffer;
+ From : Editor_Location'Class;
+ Text : String);
+
+ overriding procedure Delete
+ (This : Src_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location);
+
+ overriding procedure Indent
+ (This : Src_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location);
+
+ overriding function Beginning_Of_Buffer
+ (This : Src_Editor_Buffer) return Editor_Location'Class;
+
+ overriding function End_Of_Buffer
+ (This : Src_Editor_Buffer) return Editor_Location'Class;
+
+ overriding procedure Save
+ (This : Src_Editor_Buffer;
+ Interactive : Boolean := True;
+ File : Virtual_File := No_File);
+
+ overriding function Get_Mark
+ (This : Src_Editor_Buffer;
+ Name : String) return Editor_Mark'Class;
+
+ overriding procedure Start_Undo_Group (This : Src_Editor_Buffer);
+
+ overriding procedure Finish_Undo_Group (This : Src_Editor_Buffer);
+
+ overriding procedure Undo (This : Src_Editor_Buffer);
+
+ overriding procedure Set_Read_Only
+ (This : Src_Editor_Buffer; Read_Only : Boolean);
+
+ ---------------------
+ -- Src_Editor_View --
+ ---------------------
+
+ overriding procedure Set_Read_Only
+ (This : Src_Editor_View; Read_Only : Boolean);
+
+ overriding procedure Center
+ (This : Src_Editor_View;
+ Location : Editor_Location'Class := Nil_Editor_Location);
+
+ overriding function Cursor
+ (This : Src_Editor_View) return Editor_Location'Class;
+
+ ----------------------------
+ -- Create_Editor_Location --
+ ----------------------------
+
+ function Create_Editor_Location
+ (Buffer : Src_Editor_Buffer'Class;
+ Location : Gtk_Text_Iter) return Src_Editor_Location'Class
+ is
+ Editor_Loc : Src_Editor_Location;
+ begin
+ Get_Iter_Position
+ (Buffer.Buffer, Location, Editor_Loc.Line, Editor_Loc.Column);
+
+ Editor_Loc.Buffer := Src_Editor_Buffer (Buffer);
+
+ return Editor_Loc;
+ end Create_Editor_Location;
+
+ ------------------
+ -- Get_Location --
+ ------------------
+
+ procedure Get_Location
+ (Iter : out Gtk_Text_Iter;
+ Location : Src_Editor_Location'Class;
+ Default : Gtk_Text_Iter;
+ Success : out Boolean)
+ is
+ begin
+ Success := True;
+
+ if Location.Buffer.Buffer = null
+ or else not Is_Valid_Position
+ (Location.Buffer.Buffer,
+ Location.Line,
+ Location.Column)
+ then
+ Copy (Source => Default, Dest => Iter);
+ Success := False;
+
+ else
+ Get_Iter_At_Screen_Position
+ (Location.Buffer.Buffer, Iter,
+ Line => Location.Line,
+ Column => Location.Column);
+ end if;
+ end Get_Location;
+
+ -------------------
+ -- Get_Locations --
+ -------------------
+
+ procedure Get_Locations
+ (Iter1 : out Gtk_Text_Iter;
+ Iter2 : out Gtk_Text_Iter;
+ Buffer : Source_Buffer;
+ Loc1 : Src_Editor_Location'Class;
+ Loc2 : Src_Editor_Location'Class;
+ Compensate_Last_Iter : Boolean := True)
+ is
+ Success : Boolean;
+
+ procedure Forward_Iter (Iter : in out Gtk_Text_Iter);
+ -- Forward Iter one char
+
+ ------------------
+ -- Forward_Iter --
+ ------------------
+
+ procedure Forward_Iter (Iter : in out Gtk_Text_Iter) is
+ Line, End_Line : Editable_Line_Type;
+ Col, End_Col : Character_Offset_Type;
+ begin
+ Get_Iter_Position (Buffer, Iter, Line, Col);
+ Forward_Position (Buffer, Line, Col, 1, End_Line, End_Col);
+ Get_Iter_At_Screen_Position (Buffer, Iter, End_Line, End_Col);
+ end Forward_Iter;
+
+ begin
+ if Buffer /= null then
+ Get_Start_Iter (Buffer, Iter1);
+ Get_Location (Iter1, Loc1, Iter1, Success);
+
+ Get_End_Iter (Buffer, Iter2);
+ Get_Location (Iter2, Loc2, Iter2, Success);
+
+ if Get_Buffer (Iter1) /= Get_Buffer (Iter2)
+ or else Get_Buffer (Iter1) /= Gtk_Text_Buffer (Buffer)
+ then
+ raise Editor_Exception
+ with -"Locations are not in the correct buffer";
+ elsif Compensate_Last_Iter then
+ -- All operations that take two iterators stop just before the
+ -- second one. This is harder to use in scripts, though, so we
+ -- compensate for that here.
+ if Compare (Iter1, Iter2) <= 0 then
+ -- ??? temporarily commented out, since it breaks ctrl-k in
+ -- Emacs mode (F707-004)
+ -- if not (Is_End (Iter2) or else Ends_Line (Iter2)) then
+ if not Is_End (Iter2) then
+ Forward_Iter (Iter2);
+ end if;
+
+ else
+ -- ??? temporarily commented out, since it breaks ctrl-k in
+ -- Emacs mode (F707-004)
+ -- if not (Is_End (Iter1) or else Ends_Line (Iter1)) then
+ if not Is_End (Iter1) then
+ Forward_Iter (Iter1);
+ end if;
+ end if;
+ end if;
+ end if;
+ end Get_Locations;
+
+ ------------------------
+ -- Create_Editor_Mark --
+ ------------------------
+
+ function Create_Editor_Mark
+ (Buffer : Src_Editor_Buffer'Class;
+ Mark : Gtk_Text_Mark) return Src_Editor_Mark'Class
+ is
+ New_Ref : constant Mark_Reference_Access :=
+ new Mark_Reference'(Mark => Mark, Refs => 1);
+ begin
+ pragma Assert (Mark /= null);
+
+ Mark.Ref;
+
+ return Src_Editor_Mark'
+ (Editor_Mark with
+ Buffer => Src_Editor_Buffer (Buffer),
+ Mark => New_Ref);
+ end Create_Editor_Mark;
+
+ ---------
+ -- Get --
+ ---------
+
+ overriding function Get
+ (This : Src_Editor_Buffer_Factory;
+ File : Virtual_File := No_File;
+ Force : Boolean := False;
+ Open : Boolean := True) return Editor_Buffer'Class
+ is
+ Child : MDI_Child;
+ Box : Source_Editor_Box;
+ begin
+ if File /= GNATCOLL.VFS.No_File then
+ Child := Find_Editor (This.Kernel, File);
+ else
+ Child := Find_Current_Editor (This.Kernel);
+ end if;
+
+ if Child = null then
+ if Open then
+ Box := Open_File
+ (This.Kernel, File, Line => 0, Column => 0, Column_End => 0);
+ else
+ return Nil_Editor_Buffer;
+ end if;
+ else
+ Box := Get_Source_Box_From_MDI (Child);
+
+ if File /= GNATCOLL.VFS.No_File and Force then
+ Check_Timestamp_And_Reload (Box, False, True);
+ end if;
+ end if;
+
+ return Src_Editor_Buffer'
+ (Editor_Buffer with Kernel => This.Kernel, Buffer => Get_Buffer (Box));
+ end Get;
+
+ -----------------------
+ -- Beginning_Of_Line --
+ -----------------------
+
+ overriding function Beginning_Of_Line
+ (This : Src_Editor_Location) return Editor_Location'Class
+ is
+ Success : Boolean;
+ Iter : Gtk_Text_Iter;
+ begin
+ Get_Location (Iter, This, Iter, Success);
+
+ if Success then
+ Set_Line_Offset (Iter, 0);
+
+ return Create_Editor_Location (This.Buffer, Iter);
+ else
+ raise Editor_Exception with -"Invalid location";
+ end if;
+ end Beginning_Of_Line;
+
+ -----------------
+ -- End_Of_Line --
+ -----------------
+
+ overriding function End_Of_Line
+ (This : Src_Editor_Location) return Editor_Location'Class
+ is
+ Success : Boolean;
+ Iter : Gtk_Text_Iter;
+ begin
+ Get_Location (Iter, This, Iter, Success);
+
+ if Success then
+ if not Ends_Line (Iter) then
+ Forward_To_Line_End (Iter, Success);
+ end if;
+
+ return Create_Editor_Location (This.Buffer, Iter);
+ else
+ raise Editor_Exception with -"Invalid location";
+ end if;
+ end End_Of_Line;
+
+ -----------------
+ -- Block_Start --
+ -----------------
+
+ overriding function Block_Start
+ (This : Src_Editor_Location) return Editor_Location'Class
+ is
+ Success : Boolean;
+ Line : Buffer_Line_Type;
+ Block : Block_Record;
+ Iter : Gtk_Text_Iter;
+ begin
+ Get_Location (Iter, This, Iter, Success);
+
+ if Success then
+ Line := Buffer_Line_Type (Get_Line (Iter) + 1);
+ Block := Get_Block (Source_Buffer (Get_Buffer (Iter)), Line);
+
+ return Src_Editor_Location'
+ (Editor_Location with
+ Buffer => This.Buffer,
+ Line => Block.First_Line,
+ Column => 1);
+ else
+ return Nil_Editor_Location;
+ end if;
+ end Block_Start;
+
+ ---------------
+ -- Block_End --
+ ---------------
+
+ overriding function Block_End
+ (This : Src_Editor_Location) return Editor_Location'Class
+ is
+ Success : Boolean;
+ Line : Buffer_Line_Type;
+ Block : Block_Record;
+ Iter, Iter2 : Gtk_Text_Iter;
+ begin
+ Get_Location (Iter, This, Iter, Success);
+
+ if Success then
+ Line := Buffer_Line_Type (Get_Line (Iter) + 1);
+ Block := Get_Block (Source_Buffer (Get_Buffer (Iter)), Line);
+
+ Get_Iter_At_Line_Offset
+ (Source_Buffer (Get_Buffer (Iter)), Iter2,
+ Line_Number => Gint (Block.Last_Line),
+ Char_Offset => 1);
+ Forward_Lines
+ (Iter2,
+ Count => -1,
+ Result => Success);
+
+ if not Success then
+ return Nil_Editor_Location;
+ end if;
+
+ Forward_To_Line_End (Iter2, Success);
+
+ if not Success then
+ return Nil_Editor_Location;
+ end if;
+
+ return Create_Editor_Location (This.Buffer, Iter2);
+ else
+ return Nil_Editor_Location;
+ end if;
+ end Block_End;
+
+ ---------------
+ -- Bloc_Type --
+ ---------------
+
+ overriding function Block_Type
+ (This : Src_Editor_Location) return Language_Category
+ is
+ Success : Boolean;
+ Line : Buffer_Line_Type;
+ Block : Block_Record;
+ Iter : Gtk_Text_Iter;
+ begin
+ Get_Location (Iter, This, Iter, Success);
+
+ if Success then
+ Line := Buffer_Line_Type (Get_Line (Iter) + 1);
+ Block := Get_Block (Source_Buffer (Get_Buffer (Iter)), Line);
+
+ return Block.Block_Type;
+ else
+ return Cat_Unknown;
+ end if;
+ end Block_Type;
+
+ ----------
+ -- Line --
+ ----------
+
+ overriding function Line (This : Src_Editor_Location) return Integer is
+ begin
+ return Integer (This.Line);
+ end Line;
+
+ ------------
+ -- Column --
+ ------------
+
+ overriding function Column (This : Src_Editor_Location) return Integer is
+ begin
+ return Integer (This.Column);
+ end Column;
+
+ -----------------
+ -- Create_Mark --
+ -----------------
+
+ overriding function Create_Mark
+ (This : Src_Editor_Location; Name : String := "")
+ return Editor_Mark'Class
+ is
+ Success : Boolean;
+ Iter : Gtk_Text_Iter;
+ Mark : Gtk_Text_Mark;
+ begin
+ Get_Location (Iter, This, Iter, Success);
+
+ if Success then
+ if Name /= "" then
+ Mark := Get_Mark (Get_Buffer (Iter), Name);
+ end if;
+
+ if Mark = null then
+ Mark := Create_Mark
+ (Get_Buffer (Iter),
+ Mark_Name => Name,
+ Where => Iter);
+ else
+ Move_Mark (Get_Buffer (Iter), Mark, Where => Iter);
+ end if;
+
+ return Create_Editor_Mark (This.Buffer, Mark);
+ else
+ raise Editor_Exception with -"Invalid location";
+ end if;
+ end Create_Mark;
+
+ ------------------
+ -- Forward_Char --
+ ------------------
+
+ overriding function Forward_Char
+ (This : Src_Editor_Location;
+ Count : Integer) return Editor_Location'Class
+ is
+ Success : Boolean;
+ Iter : Gtk_Text_Iter;
+ begin
+ Get_Location (Iter, This, Iter, Success);
+
+ if Success then
+ declare
+ Chars : constant Gint := Gint (Count);
+ begin
+ if Chars >= 0 then
+ Forward_Chars (Iter, Chars, Success);
+ else
+ Backward_Chars (Iter, -Chars, Success);
+ end if;
+ end;
+
+ return Create_Editor_Location (This.Buffer, Iter);
+ else
+ raise Editor_Exception with -"Invalid location";
+ end if;
+ end Forward_Char;
+
+ ------------
+ -- Adjust --
+ ------------
+
+ overriding procedure Adjust (This : in out Src_Editor_Mark) is
+ begin
+ This.Mark.Refs := This.Mark.Refs + 1;
+ end Adjust;
+
+ --------------
+ -- Finalize --
+ --------------
+
+ overriding procedure Finalize (This : in out Src_Editor_Mark) is
+ begin
+ This.Mark.Refs := This.Mark.Refs - 1;
+
+ if This.Mark.Refs = 0 then
+ if This.Mark.Mark /= null
+ and then not Get_Deleted (This.Mark.Mark)
+ and then Get_Name (This.Mark.Mark) = ""
+ then
+ -- Do not delete named marks, since we can still access them
+ -- through get_mark() anyway
+ Trace (Me, "Deleting unnamed mark");
+ Delete_Mark (This.Buffer.Buffer, This.Mark.Mark);
+ end if;
+
+ This.Mark.Mark.Unref;
+ Free (This.Mark);
+ end if;
+ end Finalize;
+
+ --------------
+ -- Location --
+ --------------
+
+ overriding function Location
+ (This : Src_Editor_Mark) return Editor_Location'Class
+ is
+ Iter : Gtk_Text_Iter;
+ begin
+ if This.Mark /= null then
+ Get_Iter_At_Mark (This.Buffer.Buffer, Iter, This.Mark.Mark);
+
+ return Create_Editor_Location (This.Buffer, Iter);
+ else
+ return Nil_Editor_Location;
+ end if;
+ end Location;
+
+ ------------------
+ -- New_Location --
+ ------------------
+
+ overriding function New_Location
+ (This : Src_Editor_Buffer;
+ Line : Integer;
+ Column : Integer) return Editor_Location'Class
+ is
+ Result : Src_Editor_Location;
+ begin
+ Result.Buffer := This;
+ Result.Line := Editable_Line_Type'Max (1, Editable_Line_Type (Line));
+ Result.Column := Visible_Column_Type'Max
+ (1, Visible_Column_Type (Column));
+
+ return Result;
+ end New_Location;
+
+ --------------
+ -- New_View --
+ --------------
+
+ overriding function New_View
+ (This : Src_Editor_Buffer) return Editor_View'Class
+ is
+ Result : Src_Editor_View;
+ begin
+ if This.Buffer /= null then
+ declare
+ Views : constant Views_Array := Get_Views (This.Buffer);
+ begin
+ Result.Box := New_View (This.Kernel, Views (Views'First));
+ Result.Buffer := This;
+
+ return Result;
+ end;
+ end if;
+
+ return Nil_Editor_View;
+ end New_View;
+
+ ----------
+ -- Open --
+ ----------
+
+ overriding function Open
+ (This : Src_Editor_Buffer) return Editor_View'Class
+ is
+ Current_View : constant Editor_View'Class := This.Current_View;
+ begin
+ if Current_View = Nil_Editor_View then
+ return This.New_View;
+ else
+ return This.Current_View;
+ end if;
+ end Open;
+
+ ----------------------
+ -- Add_Special_Line --
+ ----------------------
+
+ overriding function Add_Special_Line
+ (This : Src_Editor_Buffer;
+ Start_Line : Integer;
+ Text : String;
+ Category : String := "";
+ Name : String := "") return Editor_Mark'Class
+ is
+ Mark : Gtk_Text_Mark;
+ begin
+ if This.Buffer /= null then
+ declare
+ Highlight_Category : Natural := 0;
+ Style : Style_Access;
+ begin
+ if Category /= "" then
+ Style := Get_Or_Create_Style (This.Kernel, Category, False);
+
+ if Style = null then
+ raise Editor_Exception
+ with -"No such style: " & Category;
+ else
+ Highlight_Category := Lookup_Category (Style);
+ end if;
+ end if;
+
+ Mark := Add_Blank_Lines
+ (This.Buffer,
+ Editable_Line_Type (Start_Line),
+ Highlight_Category,
+ Text,
+ 1,
+ Name);
+
+ return Create_Editor_Mark (This, Mark);
+ end;
+ else
+ return Nil_Editor_Mark;
+ end if;
+ end Add_Special_Line;
+
+ --------------------------
+ -- Remove_Special_Lines --
+ --------------------------
+
+ overriding procedure Remove_Special_Lines
+ (This : Src_Editor_Buffer;
+ Mark : Editor_Mark'Class;
+ Lines : Integer)
+ is
+ begin
+ if This.Buffer /= null and then Mark /= Nil_Editor_Mark then
+ declare
+ Src_Mark : Src_Editor_Mark renames Src_Editor_Mark (Mark);
+ begin
+ if Src_Mark.Mark /= null then
+ Remove_Blank_Lines (This.Buffer, Src_Mark.Mark.Mark, Lines);
+ end if;
+ end;
+ end if;
+ end Remove_Special_Lines;
+
+ ------------------
+ -- Current_View --
+ ------------------
+
+ overriding function Current_View
+ (This : Src_Editor_Buffer) return Editor_View'Class
+ is
+ Child : MDI_Child;
+ begin
+ if This.Buffer /= null then
+ declare
+ File : GNATCOLL.VFS.Virtual_File := Get_Filename (This.Buffer);
+ begin
+ if File = GNATCOLL.VFS.No_File then
+ File := Get_File_Identifier (This.Buffer);
+ end if;
+
+ Child := Find_Editor (This.Kernel, File);
+ end;
+
+ if Child = null then
+ Trace (Me, -"Editor not found");
+
+ return Nil_Editor_View;
+ else
+ return Src_Editor_View'
+ (Editor_View with
+ Box => Source_Editor_Box (Get_Widget (Child)),
+ Buffer => This);
+ end if;
+ else
+ return Nil_Editor_View;
+ end if;
+ end Current_View;
+
+ -----------------
+ -- Lines_Count --
+ -----------------
+
+ overriding function Lines_Count (This : Src_Editor_Buffer) return Integer is
+ Iter : Gtk_Text_Iter;
+ begin
+ if This.Buffer /= null then
+ Get_End_Iter (This.Buffer, Iter);
+
+ declare
+ Line : Editable_Line_Type;
+ Column : Visible_Column_Type;
+ begin
+ Get_Iter_Position (This.Buffer, Iter, Line, Column);
+
+ return Integer (Line);
+ end;
+ else
+ return 0;
+ end if;
+ end Lines_Count;
+
+ -----------------
+ -- Select_Text --
+ -----------------
+
+ overriding procedure Select_Text
+ (This : Src_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location)
+ is
+ Src_From : Src_Editor_Location;
+ Src_To : Src_Editor_Location;
+ Iter, Iter2 : Gtk_Text_Iter;
+ begin
+ if This.Buffer /= null then
+ if From = Nil_Editor_Location then
+ Src_From := Src_Editor_Location (Beginning_Of_Buffer (This));
+ else
+ Src_From := Src_Editor_Location (From);
+ end if;
+
+ if To = Nil_Editor_Location then
+ Src_To := Src_Editor_Location (End_Of_Buffer (This));
+ else
+ Src_To := Src_Editor_Location (To);
+ end if;
+
+ Get_Locations (Iter, Iter2, This.Buffer, Src_From, Src_To, False);
+ Select_Region
+ (This.Buffer,
+ Cursor_Iter => Iter2,
+ Bound_Iter => Iter);
+ end if;
+ end Select_Text;
+
+ ---------------
+ -- Get_Chars --
+ ---------------
+
+ overriding function Get_Chars
+ (This : Src_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location) return String
+ is
+ Src_From : Src_Editor_Location;
+ Src_To : Src_Editor_Location;
+ Iter, Iter2 : Gtk_Text_Iter;
+ begin
+ if This.Buffer /= null then
+ if From = Nil_Editor_Location then
+ Src_From := Src_Editor_Location (Beginning_Of_Buffer (This));
+ else
+ Src_From := Src_Editor_Location (From);
+ end if;
+
+ if To = Nil_Editor_Location then
+ Src_To := Src_Editor_Location (End_Of_Buffer (This));
+ else
+ Src_To := Src_Editor_Location (To);
+ end if;
+
+ Get_Locations (Iter, Iter2, This.Buffer, Src_From, Src_To);
+
+ declare
+ Begin_Line : Editable_Line_Type;
+ Begin_Col : Character_Offset_Type;
+ End_Line : Editable_Line_Type;
+ End_Col : Character_Offset_Type;
+ begin
+ Get_Iter_Position (This.Buffer, Iter, Begin_Line, Begin_Col);
+ Get_Iter_Position (This.Buffer, Iter2, End_Line, End_Col);
+
+ return Get_Text
+ (This.Buffer, Begin_Line, Begin_Col, End_Line, End_Col);
+ end;
+ else
+ return "";
+ end if;
+ end Get_Chars;
+
+ ------------
+ -- Insert --
+ ------------
+
+ overriding procedure Insert
+ (This : Src_Editor_Buffer;
+ From : Editor_Location'Class;
+ Text : String)
+ is
+ Src_From : Src_Editor_Location renames Src_Editor_Location (From);
+ Iter : Gtk_Text_Iter;
+ Success : Boolean;
+ begin
+ Get_Location (Iter, Src_From, Iter, Success);
+
+ if Success then
+ if Get_Buffer (Iter) = Gtk_Text_Buffer (This.Buffer) then
+ if Get_Writable (This.Buffer) then
+ Insert (This.Buffer, Iter, Text);
+ End_Action (This.Buffer);
+ else
+ raise Editor_Exception with -"Buffer is not writable";
+ end if;
+ else
+ raise Editor_Exception with -"Location is not in the same buffer";
+ end if;
+ end if;
+ end Insert;
+
+ ------------
+ -- Delete --
+ ------------
+
+ overriding procedure Delete
+ (This : Src_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location)
+ is
+ Iter, Iter2 : Gtk_Text_Iter;
+ Src_From : Src_Editor_Location;
+ Src_To : Src_Editor_Location;
+ begin
+ if This.Buffer /= null then
+ if From = Nil_Editor_Location then
+ Src_From := Src_Editor_Location (Beginning_Of_Buffer (This));
+ else
+ Src_From := Src_Editor_Location (From);
+ end if;
+
+ if To = Nil_Editor_Location then
+ Src_To := Src_Editor_Location (End_Of_Buffer (This));
+ else
+ Src_To := Src_Editor_Location (To);
+ end if;
+
+ Get_Locations (Iter, Iter2, This.Buffer, Src_From, Src_To);
+
+ if Get_Writable (This.Buffer) then
+ Delete (This.Buffer, Iter, Iter2);
+ End_Action (This.Buffer);
+ else
+ raise Editor_Exception with -"Buffer is not writable";
+ end if;
+ end if;
+ end Delete;
+
+ ------------
+ -- Indent --
+ ------------
+
+ overriding procedure Indent
+ (This : Src_Editor_Buffer;
+ From : Editor_Location'Class := Nil_Editor_Location;
+ To : Editor_Location'Class := Nil_Editor_Location)
+ is
+ Iter, Iter2 : Gtk_Text_Iter;
+ Src_From : Src_Editor_Location;
+ Src_To : Src_Editor_Location;
+ begin
+ if This.Buffer /= null then
+ if From = Nil_Editor_Location then
+ Src_From := Src_Editor_Location (Beginning_Of_Buffer (This));
+ else
+ Src_From := Src_Editor_Location (From);
+ end if;
+
+ if To = Nil_Editor_Location then
+ Src_To := Src_Editor_Location (End_Of_Buffer (This));
+ else
+ Src_To := Src_Editor_Location (To);
+ end if;
+
+ Get_Locations (Iter, Iter2, This.Buffer, Src_From, Src_To);
+
+ if not Do_Indentation (This.Buffer, Iter, Iter2) then
+ raise Editor_Exception with -"Error while indenting";
+ end if;
+ end if;
+
+ End_Action (This.Buffer);
+ end Indent;
+
+ -------------------------
+ -- Beginning_Of_Buffer --
+ -------------------------
+
+ overriding function Beginning_Of_Buffer
+ (This : Src_Editor_Buffer) return Editor_Location'Class
+ is
+ Iter : Gtk_Text_Iter;
+ Line : Editable_Line_Type;
+ Column : Visible_Column_Type;
+ begin
+ if This.Buffer /= null then
+ Get_Start_Iter (This.Buffer, Iter);
+ Get_Iter_Position
+ (This.Buffer, Iter, Line, Column);
+
+ return Src_Editor_Location'
+ (Editor_Location with
+ Buffer => This,
+ Line => Line,
+ Column => Column);
+ else
+ return Nil_Editor_Location;
+ end if;
+ end Beginning_Of_Buffer;
+
+ -------------------
+ -- End_Of_Buffer --
+ -------------------
+
+ overriding function End_Of_Buffer
+ (This : Src_Editor_Buffer) return Editor_Location'Class
+ is
+ Iter : Gtk_Text_Iter;
+ Line : Editable_Line_Type;
+ Column : Visible_Column_Type;
+ begin
+ if This.Buffer /= null then
+ Get_End_Iter (This.Buffer, Iter);
+ Get_Iter_Position
+ (This.Buffer, Iter, Line, Column);
+
+ return Src_Editor_Location'
+ (Editor_Location with
+ Buffer => This,
+ Line => Line,
+ Column => Column);
+ else
+ return Nil_Editor_Location;
+ end if;
+ end End_Of_Buffer;
+
+ ----------
+ -- Save --
+ ----------
+
+ overriding procedure Save
+ (This : Src_Editor_Buffer;
+ Interactive : Boolean := True;
+ File : Virtual_File := No_File)
+ is
+ Success : Boolean;
+ pragma Unreferenced (Success);
+ begin
+ if This.Buffer /= null then
+ if File = No_File then
+ Success := Save_MDI_Children
+ (This.Kernel,
+ Children =>
+ (1 => Find_Editor
+ (This.Kernel, Get_Filename (This.Buffer))),
+ Force => not Interactive);
+ else
+ Save_To_File
+ (This.Buffer,
+ Filename => File,
+ Success => Success);
+ end if;
+ end if;
+ end Save;
+
+ --------------
+ -- Get_Mark --
+ --------------
+
+ overriding function Get_Mark
+ (This : Src_Editor_Buffer;
+ Name : String) return Editor_Mark'Class
+ is
+ Mark : Gtk_Text_Mark;
+ begin
+ if This.Buffer /= null then
+ Mark := Get_Mark (This.Buffer, Name);
+
+ if Mark /= null then
+ return Create_Editor_Mark (This, Mark);
+ end if;
+ end if;
+
+ return Nil_Editor_Mark;
+ end Get_Mark;
+
+ ----------------------
+ -- Start_Undo_Group --
+ ----------------------
+
+ overriding procedure Start_Undo_Group (This : Src_Editor_Buffer) is
+ begin
+ End_Action (This.Buffer);
+ Start_Group (Get_Command_Queue (This.Buffer));
+ end Start_Undo_Group;
+
+ -----------------------
+ -- Finish_Undo_Group --
+ -----------------------
+
+ overriding procedure Finish_Undo_Group (This : Src_Editor_Buffer) is
+ begin
+ End_Action (This.Buffer);
+ End_Group (Get_Command_Queue (This.Buffer));
+ end Finish_Undo_Group;
+
+ ----------
+ -- Undo --
+ ----------
+
+ overriding procedure Undo (This : Src_Editor_Buffer) is
+ begin
+ if Get_Writable (This.Buffer) then
+ Undo (This.Buffer);
+ else
+ raise Editor_Exception with -"Buffer is not writable";
+ end if;
+ end Undo;
+
+ -------------------
+ -- Set_Read_Only --
+ -------------------
+
+ overriding procedure Set_Read_Only
+ (This : Src_Editor_Buffer; Read_Only : Boolean)
+ is
+ begin
+ if This.Buffer /= null then
+ Set_Writable
+ (This.Buffer, not Read_Only, Explicit => True);
+ end if;
+ end Set_Read_Only;
+
+ ----------------
+ -- Is_Present --
+ ----------------
+
+ overriding function Is_Present (This : Src_Editor_Mark) return Boolean is
+ begin
+ if This.Mark /= null then
+ return not This.Mark.Mark.Get_Deleted;
+
+ else
+ return False;
+ end if;
+ end Is_Present;
+
+ ------------
+ -- Delete --
+ ------------
+
+ overriding procedure Delete (This : Src_Editor_Mark) is
+ begin
+ if This.Mark /= null then
+ Gtk.Text_Buffer.Delete_Mark
+ (Gtk.Text_Buffer.Gtk_Text_Buffer (This.Buffer.Buffer),
+ This.Mark.Mark);
+ end if;
+ end Delete;
+
+ -------------------
+ -- Set_Read_Only --
+ -------------------
+
+ overriding procedure Set_Read_Only
+ (This : Src_Editor_View; Read_Only : Boolean)
+ is
+ begin
+ if This.Box /= null then
+ Set_Writable (This.Box, not Read_Only, Explicit => True);
+ end if;
+ end Set_Read_Only;
+
+ ------------
+ -- Center --
+ ------------
+
+ overriding procedure Center
+ (This : Src_Editor_View;
+ Location : Editor_Location'Class := Nil_Editor_Location)
+ is
+ Iter : Gtk_Text_Iter;
+ Success : Boolean;
+ Actual_Loc : Src_Editor_Location;
+ begin
+ if This.Box /= null then
+ if Location = Nil_Editor_Location then
+ Actual_Loc := Src_Editor_Location (This.Cursor);
+ else
+ Actual_Loc := Src_Editor_Location (Location);
+ end if;
+
+ Get_Cursor_Position (Get_View (This.Box), Iter);
+ Get_Location (Iter, Actual_Loc, Iter, Success);
+
+ if Success then
+ declare
+ M : constant Gtk_Text_Mark :=
+ Create_Mark (Get_Buffer (This.Box), "", Iter);
+ begin
+ Scroll_To_Mark
+ (Get_View (This.Box),
+ Mark => M,
+ Within_Margin => 0.2,
+ Use_Align => False,
+ Xalign => 0.5,
+ Yalign => 0.5);
+ Delete_Mark (Get_Buffer (This.Box), M);
+ end;
+ else
+ raise Editor_Exception with -"Invalid location";
+ end if;
+ end if;
+ end Center;
+
+ ------------
+ -- Cursor --
+ ------------
+
+ overriding function Cursor
+ (This : Src_Editor_View) return Editor_Location'Class
+ is
+ Iter : Gtk_Text_Iter;
+ begin
+ if This.Box /= null then
+ Get_Cursor_Position (Get_View (This.Box), Iter);
+ return Create_Editor_Location (This.Buffer, Iter);
+ else
+ return Nil_Editor_Location;
+ end if;
+ end Cursor;
+
+end Src_Editor_Module.Editors;
============================================================
--- src_editor/src/src_editor_module-editors.ads 681450061a34cb9a426c87cdaf42bf27250fea2d
+++ src_editor/src/src_editor_module-editors.ads 681450061a34cb9a426c87cdaf42bf27250fea2d
@@ -0,0 +1,35 @@
+-----------------------------------------------------------------------
+-- G P S --
+-- --
+-- Copyright (C) 2008, AdaCore --
+-- --
+-- GPS is free software; you can redistribute it and/or modify it --
+-- under the terms of the GNU General Public License as published by --
+-- the Free Software Foundation; either version 2 of the License, or --
+-- (at your option) any later version. --
+-- --
+-- This program is distributed in the hope that it will be useful, --
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
+-- General Public License for more details. You should have received --
+-- a copy of the GNU General Public License along with this program; --
+-- if not, write to the Free Software Foundation, Inc., 59 Temple --
+-- Place - Suite 330, Boston, MA 02111-1307, USA. --
+-----------------------------------------------------------------------
+
+with GPS.Editors; use GPS.Editors;
+
+package Src_Editor_Module.Editors is
+
+ type Src_Editor_Buffer_Factory is new GPS.Editors.Editor_Buffer_Factory
+ with record
+ Kernel : Kernel_Handle;
+ end record;
+
+ overriding function Get
+ (This : Src_Editor_Buffer_Factory;
+ File : Virtual_File := No_File;
+ Force : Boolean := False;
+ Open : Boolean := True) return Editor_Buffer'Class;
+
+end Src_Editor_Module.Editors;
============================================================
--- INSTALL a64ee29b0679758a7832084d2504c7feba3c5435
+++ INSTALL 2aaf617db72c5ffc00831ae1337727f8132ad1ae
@@ -7,7 +7,7 @@ or GNAT GPL 2008).
You need to use a recent version of the GNAT compiler (e.g. GNAT 6.1.2
or GNAT GPL 2008).
-You then need to install the Gtk+ 2.x suite (e.g 2.12.11).
+You then need to install the Gtk+ 2.x suite (e.g 2.14.6).
To download and build Gtk+, follow the instructions given at www.gtk.org.
On most linux systems, gtk+ is installed by default and you do not need to
reinstall it yourself.
============================================================
--- code_analysis/src/code_analysis.adb 4c74db222b91bce2c7a42af3916213c013cedb9b
+++ code_analysis/src/code_analysis.adb 54c6d60d87a8d8f896863545ab3c9054c6ac8a7b
@@ -21,6 +21,24 @@ package body Code_Analysis is
package body Code_Analysis is
+ -------------------------
+ -- Clear_Code_Analysis --
+ -------------------------
+
+ procedure Clear_Code_Analysis (Projects : Code_Analysis_Tree) is
+ use Project_Maps;
+ Cur : Cursor := Projects.First;
+ Project_Node : Project_Access;
+
+ begin
+ loop
+ exit when Cur = No_Element;
+ Project_Node := Element (Cur);
+ Project_Maps.Delete (Projects.all, Cur);
+ Free_Project (Project_Node);
+ end loop;
+ end Clear_Code_Analysis;
+
----------------------
-- Sort_Subprograms --
----------------------
@@ -243,6 +261,11 @@ package body Code_Analysis is
if Analysis_Id.Coverage_Data /= null then
Unchecked_Free (Analysis_Id.Coverage_Data);
end if;
+
+ if Analysis_Id.Code_Peer_Data /= null then
+ Analysis_Id.Code_Peer_Data.Finalize;
+ Unchecked_Free (Analysis_Id.Code_Peer_Data);
+ end if;
end Free_Analysis;
---------------
@@ -333,18 +356,10 @@ package body Code_Analysis is
------------------------
procedure Free_Code_Analysis (Projects : in out Code_Analysis_Tree) is
- use Project_Maps;
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Project_Maps.Map, Code_Analysis_Tree);
- Cur : Cursor := Projects.First;
- Project_Node : Project_Access;
begin
- loop
- exit when Cur = No_Element;
- Project_Node := Element (Cur);
- Project_Maps.Delete (Projects.all, Cur);
- Free_Project (Project_Node);
- end loop;
+ Clear_Code_Analysis (Projects);
Unchecked_Free (Projects);
end Free_Code_Analysis;
============================================================
--- code_analysis/src/code_analysis.ads c0ee8e0e20dfe833a122c446835701eb7beab2ae
+++ code_analysis/src/code_analysis.ads e6d8d5b1c8aecf91247ecb4c6b48fa0d006fae95
@@ -127,11 +127,18 @@ package Code_Analysis is
type Coverage_Access is access all Coverage'Class;
+ type Code_Peer_Data_Root is abstract tagged null record;
+ type Code_Peer_Data_Access is access all Code_Peer_Data_Root'Class;
+
+ procedure Finalize (Self : access Code_Peer_Data_Root) is null;
+
type Analysis is record
- Coverage_Data : Coverage_Access;
+ Coverage_Data : Coverage_Access;
-- Future other specific analysis records might be added here, such as
-- Metrics_Data : Metrics_Record_Access;
-- SSAT_Data : SSAT_Record_Access;
+ Code_Peer_Data : Code_Peer_Data_Access;
+ -- Additional information for the CodePeer plugin.
end record;
-- Store the various code analysis information
-- ??? In the future, we want a more flexible data structure where each
@@ -278,9 +285,15 @@ package Code_Analysis is
procedure Free_Code_Analysis (Projects : in out Code_Analysis_Tree);
-- Free a whole code analysis structure
- procedure Unchecked_Free is new
- Ada.Unchecked_Deallocation (Coverage'Class, Coverage_Access);
+ procedure Clear_Code_Analysis (Projects : Code_Analysis_Tree);
+ -- Clear all information in the code analysis structure
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Coverage'Class, Coverage_Access);
+
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Code_Peer_Data_Root'Class, Code_Peer_Data_Access);
+
-------------
-- Free-er --
-------------
============================================================
--- code_analysis/src/code_coverage.adb dea30900103cdafc90005e509f5f557c5e7560eb
+++ code_analysis/src/code_coverage.adb 885f890644357c0db0250a3e3608745bbd2ba154
@@ -111,8 +111,6 @@ package body Code_Coverage is
Subp_Node : Subprogram_Access;
Subp_Name : String_Access;
Subp_Cov : access Subprogram_Coverage := null;
- File_Cov : constant access Node_Coverage := Node_Coverage
- (File_Node.Analysis_Data.Coverage_Data.all)'Access;
Line_Count : Natural := 0;
begin
loop
@@ -162,14 +160,6 @@ package body Code_Coverage is
exit when Node = Null_Construct_Tree_Iterator;
end loop;
-
- if Line_Count > File_Cov.Children then
- -- If we were processing an Ada body file with nested subprograms,
- -- take for file line count the sum of the line counts of each
- -- subprogram, in order to keep the proportions of the correct
- -- coverage percentage
- File_Cov.Children := Line_Count;
- end if;
end Add_Subprogram_Info;
------------------------------
============================================================
--- codefix/src/codefix-ada_tools.adb 54fdeeeed1517e1c247ef5eaf138d6dc5ab354da
+++ codefix/src/codefix-ada_tools.adb e477198cefd77ebef03927503fd35c99e3dd7ffa
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2002-2007, AdaCore --
+-- Copyright (C) 2002-2008, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -340,10 +340,7 @@ package body Codefix.Ada_Tools is
(Get_Construct (Last_Info).Sloc_End.Column) + 1, Line));
end;
else
- Set_Location
- (Current_Cursor,
- Get_Construct (Current_Info).Sloc_Start.Line - 1,
- 1);
+ Set_Location (Current_Cursor, 0, 1);
end if;
return Current_Cursor;
============================================================
--- codefix/src/codefix-formal_errors.adb b94224c2d655f476ebc13d310c4018b4f7fd740b
+++ codefix/src/codefix-formal_errors.adb 7a52cc05444e427578c91ca9cd1eb1b53eac8007
@@ -915,7 +915,7 @@ package body Codefix.Formal_Errors is
"(pragma\s+[\w\d_]+\s*(\([^\)]*\))?\s*;)", Regular_Expression);
Set_File (Begin_Cursor, Get_File (Cursor));
- Set_Location (Begin_Cursor, 1, 1);
+ Set_Location (Begin_Cursor, 0, 0);
Initialize
(New_Command, Current_Text, Pragma_Cursor, Begin_Cursor, True);
@@ -1086,12 +1086,12 @@ package body Codefix.Formal_Errors is
(Current_Text,
Body_Cursor,
Enclosing,
- (Cat_Procedure, Cat_Function, Cat_Entry));
+ (Cat_Procedure, Cat_Function, Cat_Entry, Cat_Accept_Statement));
Spec_Info := Get_Iterator_At
(Current_Text,
Spec_Cursor,
After,
- (Cat_Procedure, Cat_Function, Cat_Entry));
+ (Cat_Procedure, Cat_Function, Cat_Entry, Cat_Accept_Statement));
Initialize
(Command1,
============================================================
--- codefix/src/codefix-gps_io.adb 19daf5e5c06f293124743be508b0b203d58fdd4b
+++ codefix/src/codefix-gps_io.adb 2298791a86af8fc83c4d28e4bdbe7d01590020ea
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2002-2008, AdaCore --
+-- Copyright (C) 2002-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -17,26 +17,13 @@
-- Place - Suite 330, Boston, MA 02111-1307, USA. --
-----------------------------------------------------------------------
-with GNATCOLL.Utils; use GNATCOLL.Utils;
-with GPS.Kernel.Console; use GPS.Kernel.Console;
-with GPS.Kernel.Scripts; use GPS.Kernel.Scripts;
-with String_Utils; use String_Utils;
with Traces; use Traces;
-with GNATCOLL.VFS; use GNATCOLL.VFS;
+with GNATCOLL.VFS; use GNATCOLL.VFS;
package body Codefix.GPS_Io is
Me : constant Debug_Handle := Create ("Codefix.GPS_IO");
- ------------
- -- Get_Id --
- ------------
-
- function Get_Id (This : GPS_Mark) return String is
- begin
- return This.Id.all;
- end Get_Id;
-
------------------
-- Get_New_Mark --
------------------
@@ -45,18 +32,14 @@ package body Codefix.GPS_Io is
(Current_Text : Console_Interface;
Cursor : File_Cursor'Class) return Mark_Abstr'Class
is
+ Editor : constant Editor_Buffer'Class :=
+ Current_Text.Kernel.Get_Buffer_Factory.Get (Cursor.Get_File);
+
Result : GPS_Mark;
- Args : GNAT.Strings.String_List :=
- (1 => new String'(Full_Name (Get_File (Cursor)).all),
- 2 => new String'(Image (Get_Line (Cursor))),
- 3 => new String'(Image (Natural (Get_Column (Cursor)))),
- 4 => new String'("0"));
-
begin
- Result.Id := new String'
- (Execute_GPS_Shell_Command
- (Current_Text.Kernel, "Editor.create_mark", Args));
- Free (Args);
+ Result.Mark := new Editor_Mark'Class'
+ (Editor.New_Location
+ (Get_Line (Cursor), Natural (Get_Column (Cursor))).Create_Mark);
return Result;
end Get_New_Mark;
@@ -69,29 +52,23 @@ package body Codefix.GPS_Io is
Mark : Mark_Abstr'Class) return File_Cursor'Class
is
New_Cursor : File_Cursor;
- Args : GNAT.Strings.String_List (1 .. 1);
+ Loc : constant Editor_Location'Class :=
+ GPS_Mark'Class (Mark).Mark.Location;
begin
Set_File (New_Cursor, Get_File_Name (Current_Text));
- Args (1) := new String'(GPS_Mark (Mark).Id.all);
- declare
- Column : constant String := Execute_GPS_Shell_Command
- (Current_Text.Kernel, "Editor.get_column", Args);
- Line : constant String := Execute_GPS_Shell_Command
- (Current_Text.Kernel, "Editor.get_line", Args);
begin
Set_Location
(New_Cursor,
- Natural'Value (Line),
- Column_Index'Value (Column));
+ Loc.Line,
+ Column_Index (Loc.Column));
exception
when Constraint_Error =>
Trace (Me, "unexpected result from get_column/line: " &
- Column & ":" & Line);
+ Loc.Column'Img & ":" & Loc.Line'Img);
end;
- Free (Args);
return New_Cursor;
end Get_Current_Cursor;
@@ -101,7 +78,7 @@ package body Codefix.GPS_Io is
overriding procedure Free (This : in out GPS_Mark) is
begin
- Free (This.Id);
+ Free (This.Mark);
Free (Mark_Abstr (This));
end Free;
@@ -112,14 +89,6 @@ package body Codefix.GPS_Io is
overriding procedure Free (This : in out Console_Interface) is
begin
Free (Text_Interface (This));
-
- if This.Lines /= null then
- Free (This.Lines.all);
- end if;
-
- Free (This.Lines);
- Free (This.Lines_Number);
- Free (This.File_Modified);
end Free;
----------
@@ -127,13 +96,10 @@ package body Codefix.GPS_Io is
----------
overriding procedure Undo (This : in out Console_Interface) is
- Args : GNAT.Strings.String_List :=
- (1 => new String'(Full_Name (Get_File_Name (This)).all));
- Ignore : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "Editor.undo", Args);
- pragma Unreferenced (Ignore);
+ Editor : constant Editor_Buffer'Class :=
+ This.Kernel.Get_Buffer_Factory.Get (This.Get_File_Name);
begin
- Free (Args);
+ Editor.Undo;
end Undo;
---------
@@ -145,7 +111,7 @@ package body Codefix.GPS_Io is
Cursor : Text_Cursor'Class;
Len : Natural) return String
is
- Line : constant String := Get_Recorded_Line (This, Get_Line (Cursor));
+ Line : constant String := Get_Line (This, Cursor, 1);
Char_Ind : constant Char_Index :=
To_Char_Index (Get_Column (Cursor), Line);
begin
@@ -161,7 +127,7 @@ package body Codefix.GPS_Io is
(This : Console_Interface;
Cursor : Text_Cursor'Class) return Character
is
- Line : constant String := Get_Recorded_Line (This, Get_Line (Cursor));
+ Line : constant String := Get_Line (This, Cursor, 1);
Char_Ind : constant Char_Index :=
To_Char_Index (Get_Column (Cursor), Line);
begin
@@ -177,8 +143,16 @@ package body Codefix.GPS_Io is
Cursor : Text_Cursor'Class;
Start_Col : Column_Index := 0) return String
is
- Line : constant String := Get_Recorded_Line (This, Get_Line (Cursor));
+ Editor : constant Editor_Buffer'Class :=
+ This.Kernel.Get_Buffer_Factory.Get (This.Get_File_Name);
+ Loc_Start : constant Editor_Location'CLass :=
+ Editor.New_Location (Cursor.Get_Line, 1);
+ Loc_End : constant Editor_Location'CLass := Loc_Start.End_Of_Line;
+
+ Line : constant String := Editor.Get_Chars (Loc_Start, Loc_End);
Char_Ind : Char_Index;
+
+ Last_Ind : Integer := Line'Last;
begin
if Start_Col = 0 then
Char_Ind := To_Char_Index (Get_Column (Cursor), Line);
@@ -186,33 +160,12 @@ package body Codefix.GPS_Io is
Char_Ind := To_Char_Index (Start_Col, Line);
end if;
- return Line (Natural (Char_Ind) .. Line'Last);
- end Get_Line;
-
- -----------------------
- -- Get_Recorded_Line --
- -----------------------
-
- function Get_Recorded_Line
- (This : Console_Interface;
- Number : Natural) return String
- is
- Node : String_List.List_Node;
- begin
- Update (This);
-
- Node := First (This.Lines.all);
-
- for J in 1 .. Number - 1 loop
- if Node = String_List.Null_Node then
- return "";
- end if;
-
- Node := Next (Node);
+ while Last_Ind >= Line'First and then Line (Last_Ind) = ASCII.LF loop
+ Last_Ind := Last_Ind - 1;
end loop;
- return Data (Node).all;
- end Get_Recorded_Line;
+ return Line (Natural (Char_Ind) .. Last_Ind);
+ end Get_Line;
-------------
-- Replace --
@@ -222,49 +175,40 @@ package body Codefix.GPS_Io is
(This : in out Console_Interface;
Cursor : Text_Cursor'Class;
Len : Natural;
- New_Value : String) is
+ New_Value : String)
+ is
+ Editor : constant Editor_Buffer'Class :=
+ This.Kernel.Get_Buffer_Factory.Get (Get_File_Name (This));
+
+ Actual_Start_Line : Integer;
+ Actual_Start_Column : Integer;
begin
- This.File_Modified.all := True;
Text_Has_Changed (This);
if Get_Line (Cursor) /= 0 then
- declare
- Args : GNAT.Strings.String_List :=
- (1 => new String'(Full_Name (Get_File_Name (This)).all),
- 2 => new String'(Image (Get_Line (Cursor))),
- 3 => new String'(Image (Natural (Get_Column (Cursor)))),
- 4 => new String'(New_Value),
- 5 => new String'("0"), -- before
- 6 => new String'(Image (Len))); -- after
- S : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "Editor.replace_text", Args);
- begin
- if S /= "" then
- Insert (This.Kernel, S, True, Error);
- end if;
-
- Free (Args);
- end;
-
+ Actual_Start_Line := Integer (Cursor.Get_Line);
+ Actual_Start_Column := Integer (Cursor.Get_Column);
else
- declare
- Args : GNAT.Strings.String_List :=
- (1 => new String'(Full_Name (Get_File_Name (This)).all),
- 2 => new String'("1"), -- line
- 3 => new String'("1"), -- column
- 4 => new String'(New_Value),
- 5 => new String'("0"), -- before
- 6 => new String'("0")); -- after
- S : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "Editor.replace_text", Args);
- begin
- if S /= "" then
- Insert (This.Kernel, S, True, Error);
- end if;
+ Actual_Start_Line := 1;
+ Actual_Start_Column := 1;
+ end if;
- Free (Args);
- end;
- end if;
+ declare
+ Loc_Start : constant Editor_Location'Class :=
+ Editor.New_Location
+ (Actual_Start_Line, Actual_Start_Column);
+ begin
+ if Len /= 0 then
+ declare
+ Loc_End : constant Editor_Location'Class :=
+ Loc_Start.Forward_Char (Len - 1);
+ begin
+ Editor.Delete (Loc_Start, Loc_End);
+ end;
+ end if;
+
+ Editor.Insert (Loc_Start, New_Value);
+ end;
end Replace;
-------------
@@ -277,68 +221,18 @@ package body Codefix.GPS_Io is
End_Cursor : Text_Cursor'Class;
New_Value : String)
is
- ArgsFile : GNAT.Strings.String_List :=
- (1 => new String'(Full_Name (Get_File_Name (This)).all));
-
- ArgsEditorBuffer : GNAT.Strings.String_List :=
- (1 => new String'("%1"),
- 2 => new String'("False"),
- 3 => new String'("True"));
-
- ArgsEditorLocation_Start : GNAT.Strings.String_List :=
- (1 => new String'("%1"),
- 2 => new String'(Integer'Image (Start_Cursor.Get_Line)),
- 3 => new String'(Column_Index'Image (Start_Cursor.Get_Column)));
-
- ArgsEditorLocation_End : GNAT.Strings.String_List :=
- (1 => new String'("%2"),
- 2 => new String'(Integer'Image (End_Cursor.Get_Line)),
- 3 => new String'(Column_Index'Image (End_Cursor.Get_Column)));
-
- ArgsDelete : GNAT.Strings.String_List :=
- (1 => new String'("%3"),
- 2 => new String'("%2"),
- 3 => new String'("%1"));
-
- ArgsInsert : GNAT.Strings.String_List :=
- (1 => new String'("%4"),
- 2 => new String'("%3"),
- 3 => new String'(New_Value));
-
- ResultFile : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "File", ArgsFile);
- pragma Unreferenced (ResultFile);
-
- ResultEditorBuffer : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "EditorBuffer.get", ArgsEditorBuffer);
- pragma Unreferenced (ResultEditorBuffer);
-
- ResultEditorLocation_Start : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "EditorLocation", ArgsEditorLocation_Start);
- pragma Unreferenced (ResultEditorLocation_Start);
-
- ResultEditorLocation_End : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "EditorLocation", ArgsEditorLocation_End);
- pragma Unreferenced (ResultEditorLocation_End);
-
- ResultDelete : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "EditorBuffer.delete", ArgsDelete);
- pragma Unreferenced (ResultDelete);
-
- ResultInsert : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "EditorBuffer.insert", ArgsInsert);
- pragma Unreferenced (ResultInsert);
-
+ Editor : constant Editor_Buffer'Class :=
+ This.Kernel.Get_Buffer_Factory.Get (Get_File_Name (This));
+ Loc_Start : constant Editor_Location'Class :=
+ Editor.New_Location
+ (Start_Cursor.Get_Line, Integer (Start_Cursor.Get_Column));
+ Loc_End : constant Editor_Location'Class :=
+ Editor.New_Location
+ (End_Cursor.Get_Line, Integer (End_Cursor.Get_Column));
begin
- This.File_Modified.all := True;
+ Editor.Delete (Loc_Start, Loc_End);
+ Editor.Insert (Loc_Start, New_Value);
Text_Has_Changed (This);
-
- Free (ArgsFile);
- Free (ArgsEditorBuffer);
- Free (ArgsEditorLocation_Start);
- Free (ArgsEditorLocation_End);
- Free (ArgsDelete);
- Free (ArgsInsert);
end Replace;
--------------
@@ -351,10 +245,8 @@ package body Codefix.GPS_Io is
New_Line : String;
Indent : Boolean := False)
is
- Line_Str : GNAT.Strings.String_Access;
Insert_Position : Text_Cursor := Text_Cursor (Cursor);
begin
- This.File_Modified.all := True;
Text_Has_Changed (This);
Set_Location (Insert_Position, Get_Line (Insert_Position), 1);
@@ -362,13 +254,15 @@ package body Codefix.GPS_Io is
if Get_Line (Cursor) = 0 then
Replace (This, Insert_Position, 0, New_Line & EOL_Str);
else
- Line_Str := new String'(Get_Line (This, Insert_Position));
- Set_Location
- (Insert_Position,
- Get_Line (Insert_Position),
- To_Column_Index (Char_Index (Line_Str'Last), Line_Str.all) + 1);
- Replace (This, Insert_Position, 0, EOL_Str & New_Line);
- Free (Line_Str);
+ declare
+ Line_Str : constant String := Get_Line (This, Insert_Position);
+ begin
+ Set_Location
+ (Insert_Position,
+ Get_Line (Insert_Position),
+ To_Column_Index (Char_Index (Line_Str'Last), Line_Str) + 1);
+ Replace (This, Insert_Position, 0, EOL_Str & New_Line);
+ end;
end if;
if Indent then
@@ -391,22 +285,14 @@ package body Codefix.GPS_Io is
(This : in out Console_Interface;
Cursor : Text_Cursor'Class)
is
- Args : GNAT.Strings.String_List :=
- (1 => new String'(Full_Name (Get_File_Name (This)).all),
- 2 => new String'(Image (Get_Line (Cursor))),
- 3 => new String'(Image (Natural (Get_Column (Cursor)))),
- 4 => new String'("")); -- replacement text
- S : constant String :=
- Execute_GPS_Shell_Command (This.Kernel, "Editor.replace_text", Args);
+ Editor : constant Editor_Buffer'Class :=
+ This.Kernel.Get_Buffer_Factory.Get (Get_File_Name (This));
+ Loc_Start : constant Editor_Location'Class :=
+ Editor.New_Location (Cursor.Get_Line, 0);
+ Loc_End : constant Editor_Location'Class := Loc_Start.End_Of_Line;
begin
- This.File_Modified.all := True;
+ Editor.Delete (Loc_Start, Loc_End);
Text_Has_Changed (This);
-
- if S /= "" then
- Insert (This.Kernel, S, True, Error);
- end if;
-
- Free (Args);
end Delete_Line;
-----------------
@@ -417,48 +303,13 @@ package body Codefix.GPS_Io is
(This : in out Console_Interface;
Cursor : Text_Cursor'Class)
is
- ArgsFile : GNAT.Strings.String_List :=
- (1 => new String'(Full_Name (Get_File_Name (This)).all));
-
- ArgsEditorBuffer : GNAT.Strings.String_List :=
- (1 => new String'("%1"),
- 2 => new String'("False"),
- 3 => new String'("True"));
-
- ArgsEditorLocation : GNAT.Strings.String_List :=
- (1 => new String'("%1"),
- 2 => new String'(Integer'Image (Cursor.Get_Line)),
- 3 => new String'(Column_Index'Image (0)));
-
- ArgsIndent : GNAT.Strings.String_List :=
- (1 => new String'("%2"),
- 2 => new String'("%1"),
- 3 => new String'("%1"));
-
- ResultFile : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "File", ArgsFile);
- pragma Unreferenced (ResultFile);
-
- ResultEditorBuffer : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "EditorBuffer.get", ArgsEditorBuffer);
- pragma Unreferenced (ResultEditorBuffer);
-
- ResultEditorLocation : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "EditorLocation", ArgsEditorLocation);
- pragma Unreferenced (ResultEditorLocation);
-
- ResultIndent : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "EditorBuffer.indent", ArgsIndent);
- pragma Unreferenced (ResultIndent);
-
+ Editor : constant Editor_Buffer'Class :=
+ This.Kernel.Get_Buffer_Factory.Get (Get_File_Name (This));
+ Loc : constant Editor_Location'Class :=
+ Editor.New_Location (Cursor.Get_Line, 0);
begin
- This.File_Modified.all := True;
+ Editor.Indent (Loc, Loc);
Text_Has_Changed (This);
-
- Free (ArgsFile);
- Free (ArgsEditorBuffer);
- Free (ArgsEditorLocation);
- Free (ArgsIndent);
end Indent_Line;
----------------
@@ -480,12 +331,11 @@ package body Codefix.GPS_Io is
overriding function Read_File (This : Console_Interface)
return GNAT.Strings.String_Access
is
- Args : GNAT.Strings.String_List :=
- (1 => new String'(Full_Name (Get_File_Name (This)).all));
- S : constant GNAT.Strings.String_Access := new String'
- (Execute_GPS_Shell_Command (This.Kernel, "Editor.get_buffer", Args));
+ Editor : constant Editor_Buffer'Class :=
+ This.Kernel.Get_Buffer_Factory.Get (Get_File_Name (This));
+ S : constant GNAT.Strings.String_Access :=
+ new String'(Editor.Get_Chars);
begin
- Free (Args);
return S;
end Read_File;
@@ -494,73 +344,12 @@ package body Codefix.GPS_Io is
--------------
overriding function Line_Max (This : Console_Interface) return Natural is
+ Editor : constant Editor_Buffer'Class :=
+ This.Kernel.Get_Buffer_Factory.Get (Get_File_Name (This));
begin
- Update (This);
-
- return This.Lines_Number.all;
+ return Editor.Lines_Count;
end Line_Max;
- ------------
- -- Update --
- ------------
-
- procedure Update (This : Console_Interface) is
- File : GNAT.Strings.String_Access;
- Current_Index : Natural := 0;
- Old_Index : Natural := 0;
- Last_Line : GNAT.Strings.String_Access;
-
- begin
- if not This.File_Modified.all then
- return;
- end if;
-
- Free (This.Lines.all);
-
- File := Read_File (This);
-
- Current_Index := File'First;
- Old_Index := Current_Index;
-
- while Current_Index <= File'Last loop
- Skip_To_Char (File.all, Current_Index, ASCII.LF);
-
- if Current_Index > File'Last then
- Current_Index := File'Last;
- end if;
-
- if File (Current_Index) = ASCII.LF then
- Last_Line := new String (1 .. Current_Index - Old_Index);
- Last_Line.all := File (Old_Index .. Current_Index - 1);
- else
- Last_Line := new String (1 .. Current_Index - Old_Index + 1);
- Last_Line.all := File (Old_Index .. Current_Index);
- end if;
-
- Append (This.Lines.all, Last_Line);
- Current_Index := Current_Index + 1;
- Old_Index := Current_Index;
- end loop;
-
- declare
- Args : GNAT.Strings.String_List :=
- (1 => new String'(Full_Name (Get_File_Name (This)).all));
- Result : constant String := Execute_GPS_Shell_Command
- (This.Kernel, "Editor.get_last_line", Args);
-
- begin
- This.Lines_Number.all := Natural'Value (Result);
- Free (Args);
-
- exception
- when Constraint_Error =>
- Trace (Me, "unexpected result from get_last_line: " & Result);
- end;
-
- This.File_Modified.all := False;
- Free (File);
- end Update;
-
----------------
-- Set_Kernel --
----------------
@@ -577,7 +366,7 @@ package body Codefix.GPS_Io is
overriding procedure Constrain_Update (This : in out Console_Interface) is
begin
- This.File_Modified.all := True;
+ null;
end Constrain_Update;
end Codefix.GPS_Io;
============================================================
--- codefix/src/codefix-gps_io.ads 8351687373a2e8d972c1ea58bf7b76154cdcc106
+++ codefix/src/codefix-gps_io.ads 162bbe45bcfcaa3d44dbfbfdb2dfd5bf2a6f4312
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2003-2008, AdaCore --
+-- Copyright (C) 2003-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -20,9 +20,10 @@ with GNAT.Strings;
with GPS.Kernel; use GPS.Kernel;
with GNAT.Strings;
-with Generic_List;
with Ada.Unchecked_Deallocation;
+with GPS.Editors; use GPS.Editors;
+
with Codefix.Text_Manager; use Codefix.Text_Manager;
with Codefix.Errors_Manager; use Codefix.Errors_Manager;
with Codefix.Formal_Errors; use Codefix.Formal_Errors;
@@ -34,9 +35,6 @@ package Codefix.GPS_Io is
type GPS_Mark is new Mark_Abstr with private;
- function Get_Id (This : GPS_Mark) return String;
- -- Returns the identificator of a mark.
-
overriding
function Get_New_Mark
(Current_Text : Console_Interface;
@@ -147,38 +145,17 @@ private
private
- package String_List is new Generic_List (GNAT.Strings.String_Access);
- use String_List;
- -- ??? Should use standard string list
-
- type Ptr_Boolean is access all Boolean;
- type Ptr_String_List is access all String_List.List;
- type Ptr_Natural is access all Natural;
-
- procedure Free is new Ada.Unchecked_Deallocation (Boolean, Ptr_Boolean);
- procedure Free is new Ada.Unchecked_Deallocation
- (String_List.List, Ptr_String_List);
- procedure Free is new Ada.Unchecked_Deallocation (Natural, Ptr_Natural);
-
type Console_Interface is new Text_Interface with record
- Lines : Ptr_String_List := new String_List.List;
- Lines_Number : Ptr_Natural := new Natural'(0);
- File_Modified : Ptr_Boolean := new Boolean'(True);
Kernel : Kernel_Handle;
end record;
- procedure Update (This : Console_Interface);
- -- Update the values of lines contained into the console_interface if
- -- changes appened.
+ type Editor_Mark_Access is access all Editor_Mark'Class;
- function Get_Recorded_Line
- (This : Console_Interface;
- Number : Natural) return String;
- -- Return a line that has been previously recorded into the
- -- Console_Interface.
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Editor_Mark'Class, Editor_Mark_Access);
type GPS_Mark is new Mark_Abstr with record
- Id : GNAT.Strings.String_Access;
+ Mark : Editor_Mark_Access;
end record;
end Codefix.GPS_Io;
============================================================
--- codefix/src/codefix-text_manager-ada_commands.adb c6283cfa74b61301f2efed596f5a0faa4649f7b2
+++ codefix/src/codefix-text_manager-ada_commands.adb fd10b82e845776056bd796e257095d16a89fef3e
@@ -867,7 +867,9 @@ package body Codefix.Text_Manager.Ada_Co
begin
if Paren_Depth = 0 then
if Entity = Keyword_Text then
- if Equal (Name, "is", False) then
+ if Equal (Name, "is", False)
+ or else Equal (Name, "do", False)
+ then
End_Of_Profile;
Is_Spec := False;
return True;
============================================================
--- codefix/src/codefix-text_manager.adb cc7c4a2c6905d7efde56c8a4e43722da1b0d7468
+++ codefix/src/codefix-text_manager.adb c6cb1e79a80e1681c4968519c1a6ee8647d715e2
@@ -867,27 +867,30 @@ package body Codefix.Text_Manager is
Line : constant String :=
Get_Line (Text_Interface'Class (This), C, 1);
Next_Cursor : Text_Cursor;
+ Char_Start, Char_End : Char_Index;
begin
- if C.Line = Stop.Line then
- declare
- Char_Start, Char_End : Char_Index := 1;
- begin
- Char_End := To_Char_Index (Stop.Col, Line);
+ if C.Line = Start.Line then
+ Char_Start := To_Char_Index (Start.Col, Line);
+ else
+ Char_Start := Char_Index (Line'First);
+ end if;
- if C.Line = Start.Line then
- Char_Start := To_Char_Index (Start.Col, Line);
- end if;
+ if C.Line = Stop.Line then
+ Char_End := To_Char_Index (Stop.Col, Line);
+ else
+ Char_End := Char_Index (Line'Last);
+ end if;
- return Before & Line
- (Integer (Char_Start) .. Integer (Char_End));
- end;
+ if C.Line = Stop.Line then
+ return Before & Line (Integer (Char_Start) .. Integer (Char_End));
else
Next_Cursor := C;
Next_Cursor.Line := Next_Cursor.Line + 1;
Next_Cursor.Col := 1;
return Before
- & Line & Recursive_Get (Next_Cursor, (1 => ASCII.LF));
+ & Line (Integer (Char_Start) .. Integer (Char_End))
+ & Recursive_Get (Next_Cursor, (1 => ASCII.LF));
end if;
end Recursive_Get;
@@ -2083,25 +2086,16 @@ package body Codefix.Text_Manager is
end if;
if This.Insert_New_Line then
- declare
- Line : constant String := Modified_Text.Get_Line (New_Pos, 1);
- Pos_Char_Index : Char_Index;
- begin
- Pos_Char_Index := To_Char_Index (Get_Column (New_Pos), Line);
-
- Modified_Text.Replace
- (New_Pos,
- Line (Natural (Pos_Char_Index) .. Line'Last)'Length, "");
-
- Modified_Text.Add_Line
- (New_Pos, Line (Natural (Pos_Char_Index) .. Line'Last), True);
- end;
+ Modified_Text.Add_Line
+ (New_Pos,
+ New_Str.all,
+ True);
+ else
+ Modified_Text.Replace
+ (New_Pos,
+ 0,
+ New_Str.all);
end if;
-
- Modified_Text.Replace
- (New_Pos,
- 0,
- New_Str.all);
elsif This.Position = After then
Modified_Text.Add_Line
(New_Pos, New_Str.all, True);
============================================================
--- common/src/gui_utils.adb da1b7624b0f09aa2848462d64714f6443a2198f1
+++ common/src/gui_utils.adb 81587a9dcbfba2dfc37cc3f1e02150e58e475d9c
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2000-2008, AdaCore --
+-- Copyright (C) 2000-2009, AdaCore --
-- --
-- GVD is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -17,11 +17,14 @@
-- Place - Suite 330, Boston, MA 02111-1307, USA. --
-----------------------------------------------------------------------
+with Ada.Calendar; use Ada.Calendar;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation;
+
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNATCOLL.Utils; use GNATCOLL.Utils;
+with GNATCOLL.VFS; use GNATCOLL.VFS;
with Glib.Object; use Glib.Object;
with Glib.Properties; use Glib.Properties;
@@ -89,14 +92,11 @@ with Config; use Confi
with Pango.Layout; use Pango.Layout;
with Config; use Config;
-with Filesystems; use Filesystems;
with String_List_Utils; use String_List_Utils;
with String_Utils; use String_Utils;
with System; use System;
with Traces; use Traces;
-with Ada.Calendar; use Ada.Calendar;
-
package body GUI_Utils is
Me : constant Debug_Handle := Create ("GUI_Utils");
@@ -948,8 +948,9 @@ package body GUI_Utils is
Label : String;
Path : String) is
begin
- Initialize (Gtk_Menu_Item (Menu_Item),
- Krunch (Filesystems.Filename_To_UTF8 (Label), 60));
+ Initialize
+ (Gtk_Menu_Item (Menu_Item),
+ Krunch (Display_Full_Name (Create (Label)), 60));
Menu_Item.Full_Path := Path;
end Initialize;
============================================================
--- common/src/language-ada.adb 3b6eb3ffba1cb77538867a7389a4e0db57ee4305
+++ common/src/language-ada.adb d0dcf6443d1223cfc6a9da8b6eda055ec493110b
@@ -1200,6 +1200,26 @@ package body Language.Ada is
Push (Token, Offset);
+ -- On the simple mode, if the returned identifier starts with something
+ -- different thank Tok_Identifier, then we return only the last item
+ -- as something is likely to be wrong. This is specifically useful in
+ -- the display menu of the debugger - we may move this out to some
+ -- specific filter at some point.
+
+ if Simple_Expression and then not Is_Empty (Result.Tokens) then
+ if Data (First (Result.Tokens)).Tok_Type /= Tok_Identifier then
+ declare
+ Garbage : Token_List.List := Result.Tokens;
+ begin
+ Result.Tokens := Null_List;
+
+ Append (Result.Tokens, Data (Last (Garbage)));
+
+ Free (Garbage);
+ end;
+ end if;
+ end if;
+
return Result;
end Parse_Expression_Backward;
============================================================
--- common/src/language.ads ccb9298b5ab93ac6693298705f6f410a25c9bce9
+++ common/src/language.ads 6cd84988959cb73d5a6ff0e606545465e12001db
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2000-2008, AdaCore --
+-- Copyright (C) 2000-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -821,7 +821,7 @@ package Language is
-- This function looks backwards from the offset given in parameter and
-- parses the relevant completion expression.
-- Start_Offset is the offset (in byte) of where we have to look.
- -- The buffer given in parameter much as a liftime superior or equal to
+ -- The buffer given in parameter must have a lifetime superior or equal to
-- the resulting parser expression, as it gets referenced by this
-- expression.
-- An example, if we have the following Ada code:
@@ -831,11 +831,11 @@ package Language is
-- Tok_Identifier + Tok_Dot + Tok_Identifier + Tok_Open_Parenthesis
-- + Tok_Identifier + Tok_Close_Parenthesis + Tok_Dot + Tok_Identifdier
-- Note that Start_Offset must point on the d, or the last identifier
- -- returned will only contain a part of the name
+ -- returned will only contain a part of the name.
--
- -- This parser may be able to retreive complex expression, e.g. A + B,
+ -- This parser may be able to retrieve complex expression, e.g. A + B,
-- or A => B in ada. If the flat Simple_Expression is true, then it will
- -- avoid returning this kind of complex result involving more that on
+ -- avoid returning this kind of complex result involving more that one
-- top-level object.
--
-- The default implementation for any language is to return the current
============================================================
--- common/tests/run.sh ebac055031f39f24b4a9834457b8d666886ca8fd
+++ common/tests/run.sh 373c8d9bb186439393064598b8f0a72dbe7ea9d0
@@ -11,10 +11,10 @@ fi
exit 0
fi
-run_and_exit "gprbuild -q -ws -P../common test_htables.adb test_arrays.adb test_strings.adb test_trie.adb"
-$valgrind ../obj/test_htables
-$valgrind ../obj/test_arrays
-$valgrind ../obj/test_strings
-$valgrind ../obj/test_trie
+run_and_exit "gprbuild -q -ws -P../common test_htables.adb test_arrays.adb test_strings.adb test_trie.adb $EXTRA_GPRBUILD_OPT"
+$valgrind ../obj/$OBJ_SUBDIR/test_htables
+$valgrind ../obj/$OBJ_SUBDIR/test_arrays
+$valgrind ../obj/$OBJ_SUBDIR/test_strings
+$valgrind ../obj/$OBJ_SUBDIR/test_trie
echo_with_status 1 ""
============================================================
--- distrib/features cff4edd0a6677ea8a66dc138d60a8902e9e24196
+++ distrib/features 0e5aff6b8288e1fff1812ac7d6d84ccdd0ed9196
@@ -1,5 +1,5 @@
====================================================
-GPS 4.4 NEW FEATURES LIST Current as of Dec 10, 2008
+GPS 4.4 NEW FEATURES LIST Current as of Dec 23, 2008
====================================================
Copyright (c) 2007-2008, AdaCore
@@ -78,6 +78,12 @@ NF-44-G903-012 Call stack window cleared
running or has terminated to avoid confusion arising from an outdated
callstack.
+NF-44-G903-006 Report all style errors at once (2008-12-11)
+
+ When running the style checkers (on files and logs) GPS will
+ now report errors from all files and will not stop checking
+ on the first file violating some styles.
+
NF-44-E817-003 Message on the VCS Explorer when no VCS defined (2008-10-27)
When no VCS is defined on the root project and all projects it
@@ -90,6 +96,13 @@ NF-44-DB04-011 New auto VCS mode (2008-1
people are not using the same VCS locally. For example developers
tracking a Subversion repository using Git (git-svn module).
+NF-44-DA05-006 Support for VCS without log (2008-12-23)
+
+ It is now possible to create a VCS that do not require a log
+ (logs are handled by external commands like ClearCase GUI for
+ example). In this case GPS won't ask for a log file while
+ doing the commit/add/remove VCS actions.
+
NF-44-DA05-003 VCS menus are now filtered (2008-11-03)
The main VCS menu is filtered to contain only the VCS actions
============================================================
--- distrib/known-problems 622b9b9b276e0a47cfa9430a6dc6bee9cd163599
+++ distrib/known-problems 7025147a7b81cc3e0a9e7defefbe0a7ace385d25
@@ -1,19 +1,14 @@ Known Problems fixed in GPS 4.4.0
Known Problems fixed in GPS 4.4.0
+- HC10-015: Wrong text replacement with auto-casing
+ Problem: When auto-casing is enabled in the preferences, the wrong
+ text replacement can occur if there are single quotes in the text
+ being considered.
+ Workaround: Edit the wrong replacement manually.
+
- HC09-008: Bad handling of --display
Problem: The command line switch --display is not handled correctly by GPS
Workaround: Set the environment variable DISPLAY instead. If you need to
spawn applications from GPS to another display, you can write
a small python plug-in that does:
import os; os.environ["DISPLAY"]="..."
-
-- HB04-009: Debugger console has no keyboard focus on title click
- Problem: If you click in the title bar or the tab of the debugger
- console, the cursor is not activated in the console, and
- you need to click inside it before typing
- Workaround: Click in the middle of the console to give it focus
-
-- D502-003: Procedure name too long and overlap with VCS status
- Problem: On the editor's status bar if a procedure name is
- too long it will overlap with the VCS status.
- Workaround: Use the VCS Explorer which displays the proper status
============================================================
--- docs/gps.texi d89aaa2dfd4bc1dfa47a66e5547f15fdec04cfac
+++ docs/gps.texi 0f7122a778f20516b4727a5a27adf10b44c6bb71
@@ -29,8 +29,8 @@
@end flushright
@sp 2
@subtitle Version @value{GPSVersion}
-@subtitle Document revision level $Revision: 133042 $
-@subtitle Date: $Date: 2008-12-04 19:21:53 +0100 (Thu, 04 Dec 2008) $
+@subtitle Document revision level $Revision: 135295 $
+@subtitle Date: $Date: 2009-01-08 12:20:31 +0100 (Thu, 08 Jan 2009) $
@author AdaCore
@page
@@ -57,7 +57,7 @@ @top Using the GNAT Programming Studio
Version @value{GPSVersion}
-Date: $Date: 2008-12-04 19:21:53 +0100 (Thu, 04 Dec 2008) $
+Date: $Date: 2009-01-08 12:20:31 +0100 (Thu, 08 Jan 2009) $
Copyright @copyright{} 2001-2008, AdaCore
This document may be copied, in whole or in part, in any form or by any
@@ -191,6 +191,7 @@ @top Using the GNAT Programming Studio
* Documentation Generation::
* Metrics::
* Code Coverage::
+* SPARK Plug-In::
Working in a Cross Environment
* Customizing your Projects::
@@ -480,6 +481,9 @@ @section The Menu Bar
@item Tools
@xref{The Tools Menu}.
+@item SPARK
+@xref{The SPARK Menu}.
+
@item Window
@xref{Multiple Document Interface}.
@@ -7260,11 +7264,13 @@ @chapter Version Control System
@table @b
@item Auto
+@cindex VCS, auto
GPS can be setup to auto-detect the actual VCS to use for each
project. This is done by selecting @code{Auto} in the @code{VCS} tab
of the Project properties editor. @xref{The Project Properties Editor}.
@item ClearCase
+@cindex VCS, ClearCase
The standard ClearCase interface, which is built-in and uses a generic GPS
terminology for VCS operations.
@@ -7273,6 +7279,7 @@ @chapter Version Control System
ClearCase integration; Dynamic Views are not supported.
@item ClearCase Native
+@cindex VCS, ClearCase Native
Which is fully customizable and uses by default the terminology
specific to ClearCase.
@@ -7281,12 +7288,14 @@ @chapter Version Control System
ClearCase integration; Dynamic Views are not supported.
@item CVS
+@cindex VCS, CVS
The Concurrent Version System.
GPS needs a corresponding @command{patch} command that usually comes with it.
@item Git
+@cindex VCS, Git
Distributed fast source code management. Support for Git on GPS is
partial. Basic commands are supported but the full power of Git (like
@@ -7295,6 +7304,7 @@ @chapter Version Control System
GPS needs a corresponding @command{diff} command that usually comes with it.
@item Subversion
+@cindex VCS, Subversion
The Subversion version control system. Note that on Windows this
version is intended to be used with Cygwin/Subversion and fully supports the
@@ -7304,6 +7314,7 @@ @chapter Version Control System
that usually comes with it.
@item Subversion Windows
+@cindex VCS, Subversion Windows
The Windows native Subversion version control system. The external
Subversion commands are expected to be built for the Win32
@@ -8019,6 +8030,7 @@ @chapter Tools
* Documentation Generation::
* Metrics::
* Code Coverage::
+* SPARK Plug-In::
@end menu
@node The Tools Menu
@@ -8644,6 +8656,142 @@ @section Code Coverage
coverage information as they are related to the working project.
@c --------------------------------------------------------------------
+@node SPARK Plug-In
+@section SPARK Plug-In
+@cindex SPARK
+@noindent
+@c --------------------------------------------------------------------
+
+GPS includes a plug-in that provides support for the SPARK language and
+toolset.
+
+It is intended for use with Release 7.6.2 or later of the
+SPARK Toolset. The customization depends on the presence of the
+"brief output" Examiner switch, which is not available
+in earlier releases.
+
+This plug-in will be enabled only if you have spark tools available in
+your PATH variable (e.g. SPARK Examiner, POGs).
+
+Before you start using the SPARK commands you should first set your project
+properties following the guidelines below.
+Note that this section discusses only those settings
+specific to SPARK. For details of the Project menu in general,
+@xref{The Project Menu}.
+
+@itemize
+@item Select @code{Edit Project Properties} from the Project menu.
+
+@item Click the Languages tab and ensure that the following items are ticked:
+Ada, Index, Listing, Metafile, Siv, Vcg.
+
+@item Click the Source Dirs tab and enable @code{Include Subdirectories}
+to ensure that VCG and SIV files are recognised properly.
+
+@item Click the Switches tab and select the Examiner tab.
+This allows you to control the following settings:
+
+ @itemize @bullet
+ @item the location of the index, warning and target configuration files if
+ required
+ @item the directory to which the Examiner should write its output
+ @item whether to ignore the default switch file (useful when you want to
+ specify switches that conflict with spark.sw)
+ @item the language to be analysed: SPARK83, SPARK95 (default) or RavenSPARK
+ @item the flow analysis mode: information flow (default) or data flow only
+ @item whether or not to generate VCs
+ @item syntax check only mode
+ @item the level of error explanation required
+ @item the replacement rules for composite constants (see the Generation of VCs
+ for SPARK Programs manual)
+ @item the annotation character to be used (default is #)
+ @item plain output (for regression analysis)
+ @item HTML output
+ @item the listing file extension to be used
+ @item the report file name to be used
+ @end itemize
+
+These options control the switches that will be passed to the SPARK Examiner.
+The actual switch settings are displayed in a text field at the bottom of the
+window and can be edited here directly if desired. For more information on
+the meaning of these settings please refer to the SPARK Examiner User Manual.
+
+@item The tabs for SPARKSimp, Simplifier, SPARKFormat, POGS and SPARKmake allow
+the settings for these tools to be controlled in a similar way to that
+described fo r the Examiner above. Please refer to the specific user manual
+for each tool to find more information about these settings.
+
+@item When you have finished making changes click @code{OK} to return to the
+main GPS interface.
+
+@end itemize
+
+@anchor{The SPARK Menu}
+The commands available under the SPARK menu are:
+
+@itemize
+@item Examine File
+Runs the SPARK Examiner to analyse the file that is currently selected in the
+editing window. The results of the analysis will be displayed in the SPARK
+Output window. If the Examiner reports any errors or warnings these will be
+listed in the Locations window. Clicking on an error or warning in the
+Locations window will cause the editor window to jump to the source code line
+associated with that error or warning. Note that this command can also be
+invoked by right-clicking anywhere in a SPARK source file in the editing
+window and selecting @code{SPARK->Examine File} or via the @key{F8} key.
+
+@item Examine Metafile
+Note that this command is only available if a metafile is currently selected in
+the editing window. It will invoke the Examiner on the metafile - equivalent to
+supplying the metafile on the command line. Note that this command can also be
+invoked by right-clicking anywhere in a metafile in the editing window and
+selecting @code{SPARK->Examine Metafile}.
+
+@item Help
+Displays usage information for the SPARK Examiner in an output window named
+@code{SPARK Help}.
+
+@item SPARKFormat File
+This command is enabled if a SPARK source file is selected in the editor window.
+It will reformat the file in-place with SPARKFormat, using any switches set
+under Project Properties. Note that this command can also be invoked by
+right-clicking anywhere in a SPARK source file in the editing window and
+selecting @code{SPARK->SPARKFormat File} or via the @key{F12} key.
+
+@item Simplify File
+This command is enabled if a .VCG file is open in the editing window. It will
+invoke the SPARK Simplifier on the VCG file, using any switches set under
+Project Properties. Output is sent to the Simplifier Output window.
+
+@item Simplify All
+Search under the project directory for all VCG files that require
+simplification and invoke the SPARK Simplifier on them. This is done using the
+SPARKSimp tool, with any switches supplied under the SPARKSimp tab in Project
+Properties. Output is displayed in the SPARKSimp Output window.
+
+@item POGS
+Invokes POGS (Proof ObliGation Summariser). This will scan for proof files and
+report the current proof status of your project. The summary output file is
+displayed in the editing window. Right-clicking on a VC in the summary file
+invokes a pop-up menu. From this menu you can select @code{SPARK->Show VC} or
+@code{SPARK->Show Simplified VC} to jump directly to the VCG or SIV file
+concerned. Note that by default POGS will be invoked at the top-level of the
+current project. POGS can also be invoked via the @key{F11} key.
+
+@item SPARKmake
+This command is enabled if a SPARK source file is selected in the editing
+window. It invokes the SPARKmake tool, using the current file as the 'root'.
+This scans the current directory tree (unless specified otherwise under
+Project Properties) and attempts to produce an index file and metafile for the
+analysis of the current package and all packages (including bodies) that it
+depends on. Project Properties can be used to modify the switches - see the
+SPARKMake User Manual for more details. Note that this command can also be
+invoked by right-clicking anywhere in a SPARK source file in the editing
+window and selecting @code{SPARK->SPARKmake}.
+
+@end itemize
+
+@c --------------------------------------------------------------------
@node Working in a Cross Environment
@chapter Working in a Cross Environment
@cindex cross environment
@@ -10071,6 +10219,11 @@ @section The Preferences Dialog
command. If the network connection with the repository is slow
disabling this command can speed-up the VCS actions.
+@item ClearCase module
+@cindex ClearCase module
+Whether the built-in ClearCase (see @ref{Version Control System})
+module is activated or disabled.
+
@end table
@item @b{Visual diff}
@@ -16574,6 +16727,13 @@ @subsubsection The VCS node
information. For example for Subversion this is @file{.svn}. This
information is used when the project is setup to select automatically
the external VCS. @xref{Version Control System}.
+
+@item require_log
+The attribute @code{require_log} specifies if the VCS require a log
+for the commit/add/delete actions. It can take the values @code{TRUE}
+or @code{FALSE}. If it is set to @code{TRUE} GPS will ensure that
+a log is created for each file. If it is set to @code{FALSE} GPS will
+not ask for log, it is expected to be handled by the external VCS.
@end table
Note that to support group commit with shared log on GPS both
============================================================
--- docs/tutorial.texi 580d3a931773f297e81bfd78f0b29dfbdd7b42a9
+++ docs/tutorial.texi fd5b517938fc80609e6bfb7a479ee4ffe86c518b
@@ -10,8 +10,8 @@
@title GNAT Programming Studio Tutorial
@subtitle Version @value{GPSVersion}
-@subtitle Document revision level $Revision: 131514 $
-@subtitle Date: $Date: 2008-10-27 12:52:06 +0100 (Mon, 27 Oct 2008) $
+@subtitle Document revision level $Revision: 134974 $
+@subtitle Date: $Date: 2008-12-18 10:06:55 +0100 (Thu, 18 Dec 2008) $
@author AdaCore
@page
@@ -37,7 +37,7 @@ @top GNAT Programming Studio Tutorial
Version @value{GPSVersion}
-Date: $Date: 2008-10-27 12:52:06 +0100 (Mon, 27 Oct 2008) $
+Date: $Date: 2008-12-18 10:06:55 +0100 (Thu, 18 Dec 2008) $
Copyright @copyright{} 2002-2007, AdaCore.
This document may be copied, in whole or in part, in any form or by any
@@ -141,10 +141,10 @@ @chapter Editing sources
about the selected item.
Change the background color of the @code{Keywords} by clicking on the last
-down arrow, at the right of the @code{Keywords} line.
+button, at the right of the @code{Keywords} line.
Choose a color, e.g a light green. When you're done with the color
-selection, simply click again on the arrow.
+selection, click on @code{OK} in the color selection dialog.
Click on the @code{Apply} button and look at the effects in the source
editor. If you like the new display, click on @code{OK} to confirm the
============================================================
--- gnatlib/Makefile 598d5ec26f6b261e8c000eb281fe4df44c01fe59
+++ gnatlib/Makefile a9562e9cfd04fe306c21db7bec52bffcee510902
@@ -30,8 +30,11 @@ ifeq (${WITH_POSTGRES},yes)
endif
ifeq (${WITH_POSTGRES},yes)
${MAKE} -C src -f Makefile.postgres
- $(MAKE) -C src -f Makefile.tools
+ ${MAKE} -C src -f Makefile.tools
endif
+ifeq (${WITH_GMP},yes)
+ ${MAKE} -C src -f Makefile.gmp
+endif
examples:
${MAKE} -C examples
@@ -68,6 +71,9 @@ endif
${MAKE} -C src -f Makefile.postgres install
${MAKE} -C src -f Makefile.tools install
endif
+ifeq (${WITH_GMP},yes)
+ ${MAKE} -C src -f Makefile.gmp install
+endif
${CP} distrib/gnatcoll_gps.xml ${datadir}/gps/plug-ins
${CP} distrib/*.gpr ${libdir}/gnat
@@ -87,6 +93,8 @@ endif
endif
${MAKE} LIBRARY_TYPE=relocatable -C src -f Makefile.postgres $@
${MAKE} LIBRARY_TYPE=static -C src -f Makefile.postgres $@
+ ${MAKE} LIBRARY_TYPE=relocatable -C src -f Makefile.gmp $@
+ ${MAKE} LIBRARY_TYPE=static -C src -f Makefile.gmp $@
${MAKE} LIBRARY_TYPE=relocatable -C src -f Makefile.tools $@
${MAKE} LIBRARY_TYPE=static -C src -f Makefile.tools $@
${MAKE} -C testsuite $@
============================================================
--- gnatlib/Makefile.conf.in 184925bff1cce1ffc44621adf6e036a7894edee9
+++ gnatlib/Makefile.conf.in 9d1597df48224ef8dd1a7312a4d62aeb10d7e2a4
@@ -10,6 +10,9 @@ WITH_TEMPLATES=no # Hard coded for now
WITH_SYSLOG=@WITH_SYSLOG@
WITH_POSTGRES=@WITH_POSTGRES@
WITH_TEMPLATES=no # Hard coded for now
+WITH_GMP=@WITH_GMP@
+GMP_CFLAGS=@GMP_CFLAGS@
+GMP_LIBS=@GMP_LIBS@
POSTGRES_PATH=@PATH_LIBPQ@
BUILDS_SHARED=@GNAT_BUILDS_SHARED@
============================================================
--- gnatlib/aclocal.m4 2a85a459679f75754605566c1473ca8026b15555
+++ gnatlib/aclocal.m4 05ea1685595c8ec24d8790657ee6ff1da2d7db88
@@ -104,7 +104,7 @@ AC_DEFUN(AM_PATH_SYSLOG,
# --with-postgresql=path
# The following variables are exported by configure:
# @WITH_POSTGRES@: whether postgres was detected
-# @LIBPQ@: path to libpq, or "" if not found
+# @PATH_LIBPQ@: path to libpq, or "" if not found
#############################################################
AC_DEFUN(AM_PATH_POSTGRES,
@@ -139,6 +139,53 @@ AC_HELP_STRING(
])
#############################################################
+# Checking for gmp
+# This checks whether the gnu multiprecision library is available.
+# The result can be forced by using the
+# --with-gmp=path
+# The following variables are exported on exit:
+# @GMP_CFLAGS@: Compiler flags
+# @GMP_LIBS@: Extra command line switches for the linker
+# @WITH_GMP@: "yes" or "no" depending on whether gmp is available
+#############################################################
+
+AC_DEFUN(AM_PATH_GMP,
+[
+ AC_ARG_WITH(gmp,
+ [AC_HELP_STRING(
+ [--with-gmp=<path>],
+ [Specify the full path of the gmp installation])
+AC_HELP_STRING(
+ [--without-gmp],
+ [Disable support for gmp])],
+ GMP_PATH_WITH=$withval,
+ GMP_PATH_WITH=yes)
+
+ GMP_CFLAGS=""
+ GMP_LIBS=""
+ if test x"$GMP_PATH_WITH" = xno ; then
+ AC_MSG_CHECKING(for gmp)
+ AC_MSG_RESULT(no, use --with-gmp if needed)
+ WITH_GMP=no
+
+ else
+ if test x"$GMP_PATH_WITH" = xyes ; then
+ AC_CHECK_LIB(gmp,__gmpz_init,WITH_GMP=yes,WITH_GMP=no)
+ AC_CHECK_HEADER(gmp.h)
+ GMP_LIBS="-lgmp"
+ else
+ GMP_LIBS="-L$GMP_PATH_WITH -lgmp"
+ GMP_CFLAGS="-I$GMP_PATH_WITH"
+ WITH_GMP=yes
+ fi
+ fi
+
+ AC_SUBST(WITH_GMP)
+ AC_SUBST(GMP_CFLAGS)
+ AC_SUBST(GMP_LIBS)
+])
+
+#############################################################
# Checking for python
# This checks whether python is available on the system, and if yes
# what the paths are. The result can be forced by using the
@@ -276,7 +323,7 @@ AC_HELP_STRING(
;;
esac
- if [ -f ${PYTHON_DIR}/libpython${PYTHON_VERSION}.a ]; then
+ if test -f ${PYTHON_DIR}/libpython${PYTHON_VERSION}.a ; then
PYTHON_LIBS="${PYTHON_DIR}/libpython${PYTHON_VERSION}.a ${PYTHON_LIBS}"
else
PYTHON_LIBS="-L${PYTHON_DIR} -lpython${PYTHON_VERSION} ${PYTHON_LIBS}"
============================================================
--- gnatlib/configure f92507d8dc93c9be52358f13e1c383e242055bbc
+++ gnatlib/configure f799927951201e3e06f03aea73550028b6a14052
@@ -309,7 +309,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os LN_S CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP GNAT_BUILDS_SHARED DEFAULT_LIBRARY_TYPE PKG_CONFIG HAVE_GTKADA GTK_GCC_FLAGS WITH_GTK PYTHON PYTHON_BASE PYTHON_VERSION PYTHON_DIR PYTHON_LIBS PYTHON_CFLAGS WITH_PYTHON WITH_POSTGRES PATH_LIBPQ PYGTK_PREFIX PYGTK_INCLUDE WITH_PYGTK PYTHON_LIBS_GPR PYTHON_CFLAGS_GPR PYGTK_INCLUDE_GPR GTK_GCC_FLAGS_GPR WITH_SYSLOG MAKEINFO TEXI2DVI LIBOBJS LTLIBOBJS'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os LN_S CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP GNAT_BUILDS_SHARED DEFAULT_LIBRARY_TYPE PKG_CONFIG HAVE_GTKADA GTK_GCC_FLAGS WITH_GTK PYTHON PYTHON_BASE PYTHON_VERSION PYTHON_DIR PYTHON_LIBS PYTHON_CFLAGS WITH_PYTHON WITH_POSTGRES PATH_LIBPQ PYGTK_PREFIX PYGTK_INCLUDE WITH_PYGTK WITH_GMP GMP_CFLAGS GMP_LIBS GMP_LIBS_GPR PYTHON_LIBS_GPR PYTHON_CFLAGS_GPR PYGTK_INCLUDE_GPR GTK_GCC_FLAGS_GPR WITH_SYSLOG MAKEINFO TEXI2DVI LIBOBJS LTLIBOBJS'
ac_subst_files=''
# Initialize some variables set by options.
@@ -863,6 +863,8 @@ Optional Packages:
--with-postgresql=<path>
Specify the full path to the PostgreSQL installation
--without-postgresql Disable PostgreSQL support
+ --with-gmp=<path> Specify the full path of the gmp installation
+ --without-gmp Disable support for gmp
Some influential environment variables:
CC C compiler command
@@ -3493,7 +3495,7 @@ echo "${ECHO_T}yes (version $PYTHON_MAJO
;;
esac
- if -f ${PYTHON_DIR}/libpython${PYTHON_VERSION}.a ; then
+ if test -f ${PYTHON_DIR}/libpython${PYTHON_VERSION}.a ; then
PYTHON_LIBS="${PYTHON_DIR}/libpython${PYTHON_VERSION}.a ${PYTHON_LIBS}"
else
PYTHON_LIBS="-L${PYTHON_DIR} -lpython${PYTHON_VERSION} ${PYTHON_LIBS}"
@@ -3787,6 +3789,244 @@ echo "${ECHO_T}no since python not found
+
+# Check whether --with-gmp or --without-gmp was given.
+if test "${with_gmp+set}" = set; then
+ withval="$with_gmp"
+ GMP_PATH_WITH=$withval
+else
+ GMP_PATH_WITH=yes
+fi;
+
+ GMP_CFLAGS=""
+ GMP_LIBS=""
+ if test x"$GMP_PATH_WITH" = xno ; then
+ echo "$as_me:$LINENO: checking for gmp" >&5
+echo $ECHO_N "checking for gmp... $ECHO_C" >&6
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+ WITH_GMP=no
+
+ else
+ if test x"$GMP_PATH_WITH" = xyes ; then
+ echo "$as_me:$LINENO: checking for __gmpz_init in -lgmp" >&5
+echo $ECHO_N "checking for __gmpz_init in -lgmp... $ECHO_C" >&6
+if test "${ac_cv_lib_gmp___gmpz_init+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lgmp $LIBS"
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char __gmpz_init ();
+int
+main ()
+{
+__gmpz_init ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_lib_gmp___gmpz_init=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_gmp___gmpz_init=no
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_gmp___gmpz_init" >&5
+echo "${ECHO_T}$ac_cv_lib_gmp___gmpz_init" >&6
+if test $ac_cv_lib_gmp___gmpz_init = yes; then
+ WITH_GMP=yes
+else
+ WITH_GMP=no
+fi
+
+ if test "${ac_cv_header_gmp_h+set}" = set; then
+ echo "$as_me:$LINENO: checking for gmp.h" >&5
+echo $ECHO_N "checking for gmp.h... $ECHO_C" >&6
+if test "${ac_cv_header_gmp_h+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_gmp_h" >&5
+echo "${ECHO_T}$ac_cv_header_gmp_h" >&6
+else
+ # Is the header compilable?
+echo "$as_me:$LINENO: checking gmp.h usability" >&5
+echo $ECHO_N "checking gmp.h usability... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+#include <gmp.h>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_header_compiler=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_header_compiler=no
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
+echo "${ECHO_T}$ac_header_compiler" >&6
+
+# Is the header present?
+echo "$as_me:$LINENO: checking gmp.h presence" >&5
+echo $ECHO_N "checking gmp.h presence... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <gmp.h>
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ ac_header_preproc=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_header_preproc=no
+fi
+rm -f conftest.err conftest.$ac_ext
+echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
+echo "${ECHO_T}$ac_header_preproc" >&6
+
+# So? What about this header?
+case $ac_header_compiler:$ac_header_preproc in
+ yes:no )
+ { echo "$as_me:$LINENO: WARNING: gmp.h: accepted by the compiler, rejected by the preprocessor!" >&5
+echo "$as_me: WARNING: gmp.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
+ { echo "$as_me:$LINENO: WARNING: gmp.h: proceeding with the preprocessor's result" >&5
+echo "$as_me: WARNING: gmp.h: proceeding with the preprocessor's result" >&2;}
+ (
+ cat <<\_ASBOX
+## ------------------------------------ ##
+## Report this to bug-autoconf@gnu.org. ##
+## ------------------------------------ ##
+_ASBOX
+ ) |
+ sed "s/^/$as_me: WARNING: /" >&2
+ ;;
+ no:yes )
+ { echo "$as_me:$LINENO: WARNING: gmp.h: present but cannot be compiled" >&5
+echo "$as_me: WARNING: gmp.h: present but cannot be compiled" >&2;}
+ { echo "$as_me:$LINENO: WARNING: gmp.h: check for missing prerequisite headers?" >&5
+echo "$as_me: WARNING: gmp.h: check for missing prerequisite headers?" >&2;}
+ { echo "$as_me:$LINENO: WARNING: gmp.h: proceeding with the preprocessor's result" >&5
+echo "$as_me: WARNING: gmp.h: proceeding with the preprocessor's result" >&2;}
+ (
+ cat <<\_ASBOX
+## ------------------------------------ ##
+## Report this to bug-autoconf@gnu.org. ##
+## ------------------------------------ ##
+_ASBOX
+ ) |
+ sed "s/^/$as_me: WARNING: /" >&2
+ ;;
+esac
+echo "$as_me:$LINENO: checking for gmp.h" >&5
+echo $ECHO_N "checking for gmp.h... $ECHO_C" >&6
+if test "${ac_cv_header_gmp_h+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_header_gmp_h=$ac_header_preproc
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_gmp_h" >&5
+echo "${ECHO_T}$ac_cv_header_gmp_h" >&6
+
+fi
+
+
+ GMP_LIBS="-lgmp"
+ else
+ GMP_LIBS="-L$GMP_PATH_WITH -lgmp"
+ GMP_CFLAGS="-I$GMP_PATH_WITH"
+ WITH_GMP=yes
+ fi
+ fi
+
+
+
+
+
+
+ value=$GMP_LIBS
+ output=GMP_LIBS_GPR
+ result=""
+ for v in $value; do
+ if test "$result" != ""; then
+ result="$result, "
+ fi
+ result="$result\"$v\""
+ done
+ GMP_LIBS_GPR=$result
+
+
+
+
value=$PYTHON_LIBS
output=PYTHON_LIBS_GPR
result=""
@@ -4103,10 +4343,14 @@ echo "$as_me: use --with-postgres to
echo "$as_me: PostgreSQL: $WITH_POSTGRES $PATH_LIBPQ" >&6;}
{ echo "$as_me:$LINENO: use --with-postgres to override" >&5
echo "$as_me: use --with-postgres to override" >&6;}
+{ echo "$as_me:$LINENO: gmp: $WITH_GMP" >&5
+echo "$as_me: gmp: $WITH_GMP" >&6;}
+{ echo "$as_me:$LINENO: use --with-gmp to override" >&5
+echo "$as_me: use --with-gmp to override" >&6;}
{ echo "$as_me:$LINENO: --------------------------------------------" >&5
echo "$as_me: --------------------------------------------" >&6;}
- ac_config_files="$ac_config_files gnatcoll_shared.gpr docs/Makefile Makefile.conf src/gnatcoll_python.gpr distrib/gnatcoll.gpr distrib/gnatcoll_python.gpr docs/gnatcoll_include.texi"
+ ac_config_files="$ac_config_files gnatcoll_shared.gpr docs/Makefile Makefile.conf src/gnatcoll_gmp.gpr src/gnatcoll_python.gpr distrib/gnatcoll.gpr distrib/gnatcoll_python.gpr distrib/gnatcoll_gmp.gpr docs/gnatcoll_include.texi"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
@@ -4659,9 +4903,11 @@ do
"gnatcoll_shared.gpr" ) CONFIG_FILES="$CONFIG_FILES gnatcoll_shared.gpr" ;;
"docs/Makefile" ) CONFIG_FILES="$CONFIG_FILES docs/Makefile" ;;
"Makefile.conf" ) CONFIG_FILES="$CONFIG_FILES Makefile.conf" ;;
+ "src/gnatcoll_gmp.gpr" ) CONFIG_FILES="$CONFIG_FILES src/gnatcoll_gmp.gpr" ;;
"src/gnatcoll_python.gpr" ) CONFIG_FILES="$CONFIG_FILES src/gnatcoll_python.gpr" ;;
"distrib/gnatcoll.gpr" ) CONFIG_FILES="$CONFIG_FILES distrib/gnatcoll.gpr" ;;
"distrib/gnatcoll_python.gpr" ) CONFIG_FILES="$CONFIG_FILES distrib/gnatcoll_python.gpr" ;;
+ "distrib/gnatcoll_gmp.gpr" ) CONFIG_FILES="$CONFIG_FILES distrib/gnatcoll_gmp.gpr" ;;
"docs/gnatcoll_include.texi" ) CONFIG_FILES="$CONFIG_FILES docs/gnatcoll_include.texi" ;;
*) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
@@ -4786,6 +5032,10 @@ s,@WITH_PYGTK@,$WITH_PYGTK,;t t
s,@PYGTK_PREFIX@,$PYGTK_PREFIX,;t t
s,@PYGTK_INCLUDE@,$PYGTK_INCLUDE,;t t
s,@WITH_PYGTK@,$WITH_PYGTK,;t t
+s,@WITH_GMP@,$WITH_GMP,;t t
+s,@GMP_CFLAGS@,$GMP_CFLAGS,;t t
+s,@GMP_LIBS@,$GMP_LIBS,;t t
+s,@GMP_LIBS_GPR@,$GMP_LIBS_GPR,;t t
s,@PYTHON_LIBS_GPR@,$PYTHON_LIBS_GPR,;t t
s,@PYTHON_CFLAGS_GPR@,$PYTHON_CFLAGS_GPR,;t t
s,@PYGTK_INCLUDE_GPR@,$PYGTK_INCLUDE_GPR,;t t
============================================================
--- gnatlib/configure.in 7db1db42473e84c6c4d85748a30e7a97647e3d18
+++ gnatlib/configure.in 988a0d012e2e416989ccd6c9038ab6b7738281b6
@@ -10,6 +10,8 @@ AM_PATH_PYGTK(2.8)
AM_PATH_PYTHON
AM_PATH_POSTGRES
AM_PATH_PYGTK(2.8)
+AM_PATH_GMP
+AM_TO_GPR($GMP_LIBS, GMP_LIBS_GPR)
AM_TO_GPR($PYTHON_LIBS, PYTHON_LIBS_GPR)
AM_TO_GPR($PYTHON_CFLAGS, PYTHON_CFLAGS_GPR)
AM_TO_GPR($PYGTK_INCLUDE, PYGTK_INCLUDE_GPR)
@@ -35,6 +37,8 @@ AC_MSG_NOTICE([ use --with-postgres t
AC_MSG_NOTICE([ use --enable-syslog to override])
AC_MSG_NOTICE([ PostgreSQL: $WITH_POSTGRES $PATH_LIBPQ])
AC_MSG_NOTICE([ use --with-postgres to override])
+AC_MSG_NOTICE([ gmp: $WITH_GMP])
+AC_MSG_NOTICE([ use --with-gmp to override])
AC_MSG_NOTICE([--------------------------------------------])
-AC_OUTPUT(gnatcoll_shared.gpr docs/Makefile Makefile.conf src/gnatcoll_python.gpr distrib/gnatcoll.gpr distrib/gnatcoll_python.gpr docs/gnatcoll_include.texi)
+AC_OUTPUT(gnatcoll_shared.gpr docs/Makefile Makefile.conf src/gnatcoll_gmp.gpr src/gnatcoll_python.gpr distrib/gnatcoll.gpr distrib/gnatcoll_python.gpr distrib/gnatcoll_gmp.gpr docs/gnatcoll_include.texi)
============================================================
--- gnatlib/configure_minimal 21b43df5fa2c6795a04997203bb03614fbd02f08
+++ gnatlib/configure_minimal b8e5b433e1f3fa150a8f6cc370c75740daf7d6bd
@@ -1,3 +1,3 @@
#!/bin/sh
-./configure --disable-shared --without-postgresql --without-python --disable-gtk --disable-pygtk --disable-syslog $@
+./configure --disable-shared --without-postgresql --without-python --disable-gtk --disable-pygtk --without-gmp --disable-syslog $@
============================================================
--- gnatlib/gnatcoll_shared.gpr.in d4b11ceddfd4bc2a6167cfb7bcf98cb3e8568a5a
+++ gnatlib/gnatcoll_shared.gpr.in 56a84a38abf613e44c0c57db4269ed005d07c447
@@ -7,6 +7,8 @@ project GnatColl_Shared is
type Build_Type is ("Debug", "Production");
Build : Build_Type := External ("Gnatcoll_Build", "Production");
+ Processors := External ("PROCESSORS", "1");
+
type Yes_No is ("yes", "no");
Gtk : Yes_No := External ("GTK", "@WITH_GTK@");
Python : Yes_No := External ("PYTHON", "@WITH_PYTHON@");
@@ -45,7 +47,7 @@ project GnatColl_Shared is
end Linker;
package Builder is
- for Default_Switches ("Ada") use ("-m");
+ for Default_Switches ("Ada") use ("-m", "-j" & Processors);
end Builder;
package Ide is
============================================================
--- gps/gps.gpr 6ac9a1cb29cd4bb3ef9188ad36e14e249192691e
+++ gps/gps.gpr 7a3365e61f5b09e8cb95e3e7e8dcc414b8fa17d3
@@ -44,16 +44,18 @@ project GPS is
for Source_Dirs use ("src");
for Object_Dir use "obj";
+ Processors := external ("PROCESSORS", "1");
+
package Builder is
for Executable ("gps-main.adb") use "gps";
case Shared.Build is
when "Debug" =>
- for Default_Switches ("Ada") use ("-m", "-g");
+ for Default_Switches ("Ada") use ("-m", "-g", "-j" & Processors);
for Global_Configuration_Pragmas use "gnat_debug.adc";
when "Production" =>
- for Default_Switches ("Ada") use ("-m", "-g");
+ for Default_Switches ("Ada") use ("-m", "-g", "-j" & Processors);
for Global_Configuration_Pragmas use "gnat.adc";
end case;
end Builder;
============================================================
--- gps/src/gps-main.adb 5f65cb101d24ad92c4d66c471e683a149fd64f19
+++ gps/src/gps-main.adb a5162bfced147c0e4f3b57a65228c47785272a4e
@@ -108,6 +108,7 @@ with Code_Analysis_Module;
with Casing_Exceptions;
with Clipboard_Views;
with Code_Analysis_Module;
+with Code_Peer.Module;
with Codefix_Module;
with Command_Window;
with Cpp_Module;
@@ -183,6 +184,8 @@ procedure GPS.Main is
Create ("MODULE.Action_Editor", GNATCOLL.Traces.Off);
Code_Analysis_Trace : constant Debug_Handle :=
Create ("MODULE.Code_Analysis", GNATCOLL.Traces.On);
+ Code_Peer_Trace : constant Debug_Handle :=
+ Create ("MODULE.Code_Peer", GNATCOLL.Traces.Off);
Codefix_Trace : constant Debug_Handle :=
Create ("MODULE.Codefix", GNATCOLL.Traces.On);
Builder_Trace : constant Debug_Handle :=
@@ -289,7 +292,7 @@ procedure GPS.Main is
-- true, or as a standard command otherwise).
procedure Display_Prj_Messages (S : String);
- -- Display messages coming from the Prj packages.
+ -- Display messages coming from the Prj packages
---------------------
-- Clean_Parameter --
@@ -1433,10 +1436,6 @@ procedure GPS.Main is
VCS_Module.Register_Module (GPS_Main.Kernel);
end if;
- if Active (ClearCase_Trace) then
- VCS.ClearCase.Register_Module (GPS_Main.Kernel);
- end if;
-
if Active (VFS_Trace) then
VFS_Module.Register_Module (GPS_Main.Kernel);
end if;
@@ -1447,6 +1446,12 @@ procedure GPS.Main is
GPS.Kernel.Preferences.Register_Module (GPS_Main.Kernel);
+ if Active (ClearCase_Trace)
+ and then Clearcase_Active.Get_Pref
+ then
+ VCS.ClearCase.Register_Module (GPS_Main.Kernel);
+ end if;
+
if Active (Custom_Trace) then
Custom_Module.Register_Module (GPS_Main.Kernel);
end if;
@@ -1463,6 +1468,10 @@ procedure GPS.Main is
Code_Analysis_Module.Register_Module (GPS_Main.Kernel);
end if;
+ if Active (Code_Peer_Trace) then
+ Code_Peer.Module.Register_Module (GPS_Main.Kernel);
+ end if;
+
-- Register the supported languages and their associated LI handlers
Ada_Module.Register_Module (GPS_Main.Kernel);
============================================================
--- kernel/src/gps-kernel-preferences.adb 640920d5938c103671f30524223d3f492cda0179
+++ kernel/src/gps-kernel-preferences.adb 9b2593c1979de77a07287b7ed86b94dc5a8cb96d
@@ -814,6 +814,14 @@ package body GPS.Kernel.Preferences is
Label => -"Implicit status",
Page => -"VCS");
+ Clearcase_Active := Create
+ (Manager => Kernel.Preferences,
+ Name => "VCS-Activate-Clearcase",
+ Default => False,
+ Doc => -("Whether the internal ClearCase module is activated."),
+ Label => -"ClearCase module",
+ Page => -"VCS");
+
-- Diff_Utils --
Diff_Cmd := Create
============================================================
--- kernel/src/gps-kernel-preferences.ads 28412fa8585563f779510b07c3c92d2cb8ed0723
+++ kernel/src/gps-kernel-preferences.ads 5e3c7175ddaa19325a86459224942ff6de933a16
@@ -231,6 +231,7 @@ package GPS.Kernel.Preferences is
-- VCS --
Implicit_Status : Boolean_Preference;
+ Clearcase_Active : Boolean_Preference;
Hide_Up_To_Date : Boolean_Preference;
Hide_Not_Registered : Boolean_Preference;
CVS_Command : String_Preference;
============================================================
--- kernel/src/gps-kernel.adb 201af151daea5f02f5a51fb2d138d243274e0f62
+++ kernel/src/gps-kernel.adb 04c42c6903f429ba4283dfdef0252203f7660969
@@ -69,6 +69,7 @@ with GPS.Intl; use GPS.
with Entities; use Entities;
with File_Utils; use File_Utils;
with GPS.Intl; use GPS.Intl;
+with GPS.Editors; use GPS.Editors;
with GPS.Kernel.Clipboard; use GPS.Kernel.Clipboard;
with GPS.Kernel.Console; use GPS.Kernel.Console;
with GPS.Kernel.Contexts; use GPS.Kernel.Contexts;
@@ -407,6 +408,29 @@ package body GPS.Kernel is
Add_Watch (Id, Data);
end Setup;
+ ------------------------
+ -- Get_Buffer_Factory --
+ ------------------------
+
+ function Get_Buffer_Factory
+ (Kernel : access Kernel_Handle_Record)
+ return Editor_Buffer_Factory_Access
+ is
+ begin
+ return Kernel.Editor_Factory;
+ end Get_Buffer_Factory;
+
+ ------------------------
+ -- Set_Buffer_Factory --
+ ------------------------
+
+ procedure Set_Buffer_Factory
+ (Kernel : access Kernel_Handle_Record;
+ Factory : Editor_Buffer_Factory_Access) is
+ begin
+ Kernel.Editor_Factory := Factory;
+ end Set_Buffer_Factory;
+
---------------------------
-- Source_Lines_Revealed --
---------------------------
============================================================
--- kernel/src/gps-kernel.ads a4d8d88d79ea6f9a60dd9b2358909b2ba1de09b5
+++ kernel/src/gps-kernel.ads 8ff985547d431418a08226269f6602b4666ccedb
@@ -58,6 +58,8 @@ with Task_Manager;
with Switches_Chooser;
with Task_Manager;
+with GPS.Editors;
+
package GPS.Kernel is
type Kernel_Handle_Record is new Glib.Object.GObject_Record with private;
@@ -647,6 +649,21 @@ package GPS.Kernel is
package Entity_Callback is new Gtk.Handlers.User_Callback
(Glib.Object.GObject_Record, Entities.Entity_Information);
+ ---------------------
+ -- Editor_Factory --
+ ---------------------
+
+ type Editor_Buffer_Factory_Access is access all
+ GPS.Editors.Editor_Buffer_Factory'Class;
+
+ function Get_Buffer_Factory
+ (Kernel : access Kernel_Handle_Record)
+ return Editor_Buffer_Factory_Access;
+
+ procedure Set_Buffer_Factory
+ (Kernel : access Kernel_Handle_Record;
+ Factory : Editor_Buffer_Factory_Access);
+
-----------
-- Hooks --
-----------
@@ -1091,6 +1108,8 @@ private
-- Determies wether the kernel is being destroyed
Hidden_File_Matcher : Pattern_Matcher_Access;
+
+ Editor_Factory : Editor_Buffer_Factory_Access;
end record;
end GPS.Kernel;
============================================================
--- kernel/src_info/ali_parser.adb 7099fb7294937b811d5c05acac93c0bf77ab3b7b
+++ kernel/src_info/ali_parser.adb 735d0e1303ac38d8e8dd26ce8a9624c54407cfd5
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2003-2008, AdaCore --
+-- Copyright (C) 2003-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -397,8 +397,8 @@ package body ALI_Parser is
Id : Unit_Id) return Source_File
is
Base_Name : constant String :=
- Filesystems.Filename_To_UTF8
- (Get_String (Units.Table (Id).Sfile));
+ Display_Full_Name
+ (Create (Get_String (Units.Table (Id).Sfile)));
File : Source_File;
begin
@@ -452,7 +452,7 @@ package body ALI_Parser is
Dep : Sdep_Record renames Sdep.Table (Dep_Id);
Is_Separate : constant Boolean := Dep.Subunit_Name /= No_Name;
Base_Name : constant String :=
- Filesystems.Filename_To_UTF8 (Get_String (Dep.Sfile));
+ Display_Full_Name (Create (Get_String (Dep.Sfile)));
L : LI_File := LI;
begin
-- Do we have one of the files belonging to LI itself ?
============================================================
--- kernel/src_info/projects-registry.adb 15f722ba9cc45bb8cb58029d77b6a6ee6ebfdbe2
+++ kernel/src_info/projects-registry.adb 81884c567471ec1123873a13ca300fcbbbfd2334
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2002-2008, AdaCore --
+-- Copyright (C) 2002-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -997,8 +997,8 @@ package body Projects.Registry is
Current_Source : constant Name_Id :=
String_Elements (Registry) (Sources).Value;
UTF8 : constant String :=
- Filesystems.Filename_To_UTF8
- (Name_Buffer (1 .. Name_Len));
+ Display_Full_Name
+ (Create (Name_Buffer (1 .. Name_Len)));
Directory : Name_Id := No_Name;
Unit : Unit_Project;
begin
@@ -1039,8 +1039,8 @@ package body Projects.Registry is
Get_Name_String (Directory);
declare
Dir : constant String :=
- Filesystems.Filename_To_UTF8
- (Name_Buffer (1 .. Name_Len));
+ Display_Full_Name
+ (Create (Name_Buffer (1 .. Name_Len)));
begin
Name_Len := Dir'Length;
Name_Buffer (1 .. Name_Len) := Dir;
@@ -1444,8 +1444,7 @@ package body Projects.Registry is
declare
File : constant String :=
- Filesystems.Filename_To_UTF8
- (Name_Buffer (1 .. Name_Len));
+ Display_Full_Name (Create (Name_Buffer (1 .. Name_Len)));
begin
-- The project manager duplicates files that contain several
-- units. Only add them once in the project sources.
@@ -1588,8 +1587,8 @@ package body Projects.Registry is
declare
UTF8 : String :=
- Filesystems.Filename_To_UTF8
- (Buffer (1 .. Length));
+ Display_Full_Name
+ (Create (Buffer (1 .. Length)));
Part : Unit_Part;
Unit_Name : Name_Id;
begin
@@ -2169,8 +2168,8 @@ package body Projects.Registry is
if Is_Absolute_Path (Filename) then
declare
- S : constant String := Filesystems.Filename_To_UTF8
- (Normalize_Pathname (Locale, Resolve_Links => False));
+ S : constant String := Display_Full_Name
+ (Create (Normalize_Pathname (Locale, Resolve_Links => False)));
begin
Name_Len := S'Length;
Name_Buffer (1 .. Name_Len) := S;
@@ -2274,9 +2273,9 @@ package body Projects.Registry is
if Path /= null then
declare
- Full : constant String := Filesystems.Filename_To_UTF8
- (Normalize_Pathname
- (Path.all, Resolve_Links => False));
+ Full : constant String := Display_Full_Name
+ (Create
+ (Normalize_Pathname (Path.all, Resolve_Links => False)));
begin
Free (Path);
Name_Len := Full'Length;
@@ -2498,7 +2497,7 @@ package body Projects.Registry is
Dir_Iter : Path_Iterator;
begin
- -- Nothing to do if Prj.Subdirs is not set.
+ -- Nothing to do if Prj.Subdirs is not set
if Prj.Subdirs = null then
return;
end if;
============================================================
--- navigation/src/navigation_module.adb 3aa4cad20ed56a59fa90ad8b43fd654fef63efbf
+++ navigation/src/navigation_module.adb 9e4dfc298f6fe8fb66e534075617a510e0f39a22
@@ -36,6 +36,7 @@ with Projects; use Pro
with Gtk.Widget; use Gtk.Widget;
with Projects; use Projects;
+with GPS.Editors; use GPS.Editors;
with GPS.Kernel.Console; use GPS.Kernel.Console;
with GPS.Kernel.Contexts; use GPS.Kernel.Contexts;
with GPS.Kernel.Hooks; use GPS.Kernel.Hooks;
@@ -425,6 +426,7 @@ package body Navigation_Module is
(Kernel : Kernel_Handle;
File : Virtual_File) return Natural
is
+ -- COVERED
S_Line : constant String :=
Execute_GPS_Shell_Command
(Kernel, "Editor.cursor_get_line",
@@ -490,15 +492,11 @@ package body Navigation_Module is
File : Virtual_File;
Line : Natural) return Natural
is
- Line_Img : aliased String := Image (Line);
- S_Line : constant String :=
- Execute_GPS_Shell_Command
- (Kernel,
- "Editor.block_get_end",
- (Full_Name (File).all'Unrestricted_Access,
- Line_Img'Unchecked_Access));
+ Editor : constant Editor_Buffer'Class :=
+ Kernel.Get_Buffer_Factory.Get (File);
+ Loc : constant Editor_Location'Class := Editor.New_Location (Line, 1);
begin
- return Natural'Value (S_Line);
+ return Loc.Block_End.Line;
exception
when Constraint_Error =>
return 0;
@@ -513,15 +511,11 @@ package body Navigation_Module is
File : Virtual_File;
Line : Natural) return Natural
is
- Line_Img : aliased String := Image (Line);
- S_Line : constant String :=
- Execute_GPS_Shell_Command
- (Kernel,
- "Editor.block_get_start",
- (Full_Name (File).all'Unrestricted_Access,
- Line_Img'Unchecked_Access));
+ Editor : constant Editor_Buffer'Class :=
+ Kernel.Get_Buffer_Factory.Get (File);
+ Loc : constant Editor_Location'Class := Editor.New_Location (Line, 1);
begin
- return Natural'Value (S_Line);
+ return Loc.Block_Start.Line;
exception
when Constraint_Error =>
return 0;
@@ -536,15 +530,11 @@ package body Navigation_Module is
File : Virtual_File;
Line : Natural) return Language_Category
is
- Line_Img : aliased String := Image (Line);
- B_Type : constant String :=
- Execute_GPS_Shell_Command
- (Kernel,
- "Editor.block_get_type",
- (Full_Name (File).all'Unrestricted_Access,
- Line_Img'Unchecked_Access));
+ Editor : constant Editor_Buffer'Class :=
+ Kernel.Get_Buffer_Factory.Get (File);
+ Loc : constant Editor_Location'Class := Editor.New_Location (Line, 1);
begin
- return Language_Category'Value (B_Type);
+ return Loc.Block_Type;
exception
when Constraint_Error =>
return Cat_Unknown;
============================================================
--- prj_editor/src/project_explorers.adb 8aba2e0e8ec8c02de4fc0d8ae72ae2bc09ca0de1
+++ prj_editor/src/project_explorers.adb 84c60a7bdba726849533801642cc0a851f1a9fac
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2001-2008, AdaCore --
+-- Copyright (C) 2001-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -68,7 +68,6 @@ with File_Utils; use File
with Entities;
with Find_Utils; use Find_Utils;
with File_Utils; use File_Utils;
-with Filesystems; use Filesystems;
with Histories; use Histories;
with GPS.Kernel; use GPS.Kernel;
with GPS.Kernel.Console; use GPS.Kernel.Console;
@@ -1186,11 +1185,11 @@ package body Project_Explorers is
if Extending_Project (Project) /= No_Project then
-- ??? We could use a different icon instead
Set (Explorer.Tree.Model, N, Base_Name_Column,
- Filesystems.Filename_To_UTF8
- (Node_Text) & " (extended)" & Name_Suffix);
+ Display_Full_Name (Create (Node_Text))
+ & " (extended)" & Name_Suffix);
else
Set (Explorer.Tree.Model, N, Base_Name_Column,
- Filesystems.Filename_To_UTF8 (Node_Text & Name_Suffix));
+ Display_Full_Name (Create (Node_Text & Name_Suffix)));
end if;
Set_Node_Type (Explorer.Tree.Model, N, Node_Type, False);
@@ -1323,7 +1322,7 @@ package body Project_Explorers is
Node_Type : Directory_Node_Types) is
begin
Set (Explorer.Tree.Model, Node, Absolute_Name_Column,
- Filesystems.Filename_To_UTF8 (Name_As_Directory (Directory)));
+ Display_Full_Name (Create (Name_As_Directory (Directory))));
Update_Directory_Node_Text (Explorer, Project, Node);
============================================================
--- prj_editor/src/project_explorers_files.adb 2dec7217b3b8481fa22d1597e8354bf39cfc7f71
+++ prj_editor/src/project_explorers_files.adb 7af0fc5b11cde0c2e707f3bbba9bf41a231775f5
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2001-2008, AdaCore --
+-- Copyright (C) 2001-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -51,7 +51,6 @@ with Gtkada.Handlers; use Gtk
with Gtkada.MDI; use Gtkada.MDI;
with Gtkada.Handlers; use Gtkada.Handlers;
-with Filesystems; use Filesystems;
with GPS.Kernel.Contexts; use GPS.Kernel.Contexts;
with GPS.Kernel.Hooks; use GPS.Kernel.Hooks;
with GPS.Kernel.MDI; use GPS.Kernel.MDI;
@@ -309,10 +308,14 @@ package body Project_Explorers_Files is
if D.Base = Null_Iter then
Append (D.Explorer.File_Model, Iter, D.Base);
- Set (D.Explorer.File_Model, Iter, Absolute_Name_Column,
- Filesystems.Filename_To_UTF8 (D.Norm_Dir.all));
- Set (D.Explorer.File_Model, Iter, Base_Name_Column,
- Filesystems.Filename_To_UTF8 (D.Norm_Dir.all));
+ declare
+ Dir : constant String :=
+ Display_Full_Name (Create (D.Norm_Dir.all));
+ begin
+ Set (D.Explorer.File_Model, Iter, Absolute_Name_Column, Dir);
+ Set (D.Explorer.File_Model, Iter, Base_Name_Column, Dir);
+ end;
+
Set (D.Explorer.File_Model, Iter, Node_Type_Column,
Gint (Node_Types'Pos (Directory_Node)));
@@ -355,7 +358,7 @@ package body Project_Explorers_Files is
D.Norm_Dir.all & Name,
Direct_Only => False)
then
- Append (D.Dirs, Filesystems.Filename_To_UTF8 (Name));
+ Append (D.Dirs, Display_Full_Name (Create (Name)));
end if;
-- If the file belongs to the project hierarchy, we also
@@ -382,9 +385,10 @@ package body Project_Explorers_Files is
end if;
elsif Is_Directory (D.Norm_Dir.all & Name) then
- Append (D.Dirs, Filesystems.Filename_To_UTF8 (Name));
+ Append (D.Dirs, Display_Full_Name (Create (Name)));
+
else
- Append (D.Files, Filesystems.Filename_To_UTF8 (Name));
+ Append (D.Files, Display_Full_Name (Create (Name)));
end if;
end;
@@ -422,10 +426,10 @@ package body Project_Explorers_Files is
begin
Append (D.Explorer.File_Model, Iter, D.Base);
Set (D.Explorer.File_Model, Iter, Absolute_Name_Column,
- Filesystems.Filename_To_UTF8
- (D.Norm_Dir.all & Dir & Directory_Separator));
+ Display_Full_Name
+ (Create (D.Norm_Dir.all & Dir & Directory_Separator)));
Set (D.Explorer.File_Model, Iter, Base_Name_Column,
- Filesystems.Filename_To_UTF8 (Dir));
+ Display_Full_Name (Create (Dir)));
Set (D.Explorer.File_Model, Iter, Node_Type_Column,
Gint (Node_Types'Pos (Directory_Node)));
============================================================
--- prj_editor/testsuite/run 6e6d591cd1970e44420476475f7203f7246e3452
+++ prj_editor/testsuite/run 1d808eb952f37c72e856431b7654073e750f5173
@@ -16,9 +16,9 @@ pwd_replace="/foo/bar"
total=0
pwd_replace="/foo/bar"
-testsuite="../obj/testsuite"
+testsuite="../obj/$OBJ_SUBDIR/testsuite"
-run_and_exit "gprbuild -p -ws -q -P../prj_editor testsuite.adb"
+run_and_exit "gprbuild -p -ws -q -P../prj_editor testsuite.adb $EXTRA_GPRBUILD_OPT"
setup_traces
check() {
============================================================
--- refactoring/src/refactoring-parameters.adb 3fc20a741d3f163dca2b0c12c31163f9ec49a192
+++ refactoring/src/refactoring-parameters.adb aab9d734092b3e56d60e587bd6ceef2db6454dd2
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2005-2008, AdaCore --
+-- Copyright (C) 2005-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -17,7 +17,8 @@
-- Place - Suite 330, Boston, MA 02111-1307, USA. --
-----------------------------------------------------------------------
-with GNATCOLL.Scripts; use GNATCOLL.Scripts;
+with GNATCOLL.Scripts; use GNATCOLL.Scripts;
+with GPS.Editors; use GPS.Editors;
with GPS.Kernel; use GPS.Kernel;
with GPS.Kernel.Contexts; use GPS.Kernel.Contexts;
with GPS.Kernel.Scripts; use GPS.Kernel.Scripts;
@@ -25,13 +26,12 @@ with Entities.Queries; use Entities
with Commands.Interactive; use Commands, Commands.Interactive;
with Entities; use Entities;
with Entities.Queries; use Entities.Queries;
-with GNATCOLL.VFS; use GNATCOLL.VFS;
+with GNATCOLL.VFS; use GNATCOLL.VFS;
with String_Utils; use String_Utils;
with Traces; use Traces;
with GPS.Intl; use GPS.Intl;
with Refactoring.Performers; use Refactoring.Performers;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
package body Refactoring.Parameters is
@@ -90,14 +90,9 @@ package body Refactoring.Parameters is
Column : Visible_Column_Type) return Command_Return_Type
is
-- File needs to be open for get_chars to work, unfortunately
- Args2 : Argument_List_Access :=
- new Argument_List'
- (new String'(Full_Name (File).all),
- new String'("0"),
- new String'("0"));
- Found : constant String := Execute_GPS_Shell_Command
- (Kernel, "Editor.edit", Args2.all);
- pragma Unreferenced (Found);
+ View : constant Editor_View'Class :=
+ Get_Buffer_Factory (Kernel).Get (File).Open;
+ pragma Unreferenced (View);
Chars : constant String := Get_Text
(Kernel, File, Line, Column, 1_000);
@@ -144,8 +139,6 @@ package body Refactoring.Parameters is
end Add_Parameter_Name;
begin
- Free (Args2);
-
Skip_Word (Chars, First);
Skip_Blanks (Chars, First);
if First > Chars'Last
============================================================
--- refactoring/src/refactoring-performers.adb 158111c303446b4f1a04d53d4cc418f240061234
+++ refactoring/src/refactoring-performers.adb b124e6e9a1d93b4750a8515afa1c379f9bb60e9f
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2003-2008, AdaCore --
+-- Copyright (C) 2003-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -19,14 +19,13 @@ with Ada.Unchecked_Deallocation;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Unchecked_Deallocation;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
with Commands.Generic_Asynchronous;
with Commands; use Commands;
with Entities.Queries; use Entities.Queries;
with Entities; use Entities;
+with GPS.Editors; use GPS.Editors;
with GPS.Intl; use GPS.Intl;
-with GPS.Kernel.Scripts; use GPS.Kernel.Scripts;
with GPS.Kernel.Task_Manager; use GPS.Kernel.Task_Manager;
with GPS.Kernel; use GPS.Kernel;
with String_Utils; use String_Utils;
@@ -39,8 +38,6 @@ package body Refactoring.Performers is
use Location_Arrays;
use File_Arrays;
- True_Cst : aliased String := "true";
-
type Renaming_Error_Record is new File_Error_Reporter_Record with
record
No_LI_List : File_Arrays.Instance := File_Arrays.Empty_Instance;
@@ -85,30 +82,6 @@ package body Refactoring.Performers is
-- Called when all the related files have been searched and the refactoring
-- should be performed.
- function Escape_Backslash (Pathname : String) return String;
- -- Return Pathname with all backslashes escaped
-
- ----------------------
- -- Escape_Backslash --
- ----------------------
-
- function Escape_Backslash (Pathname : String) return String is
- Escaped_Pathname : String (1 .. Pathname'Length * 2);
- J : Natural := 0;
- begin
- for K in Pathname'Range loop
- J := J + 1;
- if Pathname (K) = '\' then
- Escaped_Pathname (J .. J + 1) := "\\";
- J := J + 1;
- else
- Escaped_Pathname (J) := Pathname (K);
- end if;
- end loop;
-
- return Escaped_Pathname (1 .. J);
- end Escape_Backslash;
-
----------
-- Free --
----------
@@ -213,7 +186,6 @@ package body Refactoring.Performers is
procedure On_End_Of_Search (Data : Get_Locations_Data) is
Confirmed : Boolean;
- Args3 : Argument_List (1 .. 2);
begin
Pop_State (Data.Kernel);
@@ -235,17 +207,11 @@ package body Refactoring.Performers is
Push_State (Data.Kernel, Busy);
if Data.Make_Writable then
- Args3 (2) := True_Cst'Access;
-
for F in File_Arrays.First .. Last (Data.Read_Only_Files) loop
- Args3 (1) := new String'
- (Full_Name
- (Get_Filename (Data.Read_Only_Files.Table (F))).all);
- Execute_GPS_Shell_Command
- (Data.Kernel, "Editor.edit", Args3 (1 .. 1));
- Execute_GPS_Shell_Command
- (Data.Kernel, "Editor.set_writable", Args3);
- Free (Args3 (1));
+ Get_Buffer_Factory (Data.Kernel).Get
+ (Get_Filename
+ (Data.Read_Only_Files.Table (F))).
+ Open.Set_Read_Only (False);
end loop;
end if;
@@ -330,16 +296,14 @@ package body Refactoring.Performers is
Column : Visible_Column_Type;
Length : Integer) return String
is
- Args : Argument_List_Access := new Argument_List'
- (new String'(Full_Name (From_File).all),
- new String'(Integer'Image (Line)),
- new String'(Visible_Column_Type'Image (Column)),
- new String'("0"),
- new String'(Integer'Image (Length)));
- Text : constant String := Execute_GPS_Shell_Command
- (Kernel, "Editor.get_chars", Args.all);
+ Editor : constant Editor_Buffer'Class :=
+ Kernel.Get_Buffer_Factory.Get (From_File);
+ Loc_Start : constant Editor_Location'Class := Editor.New_Location
+ (Line, Integer (Column));
+ Loc_End : constant Editor_Location'Class :=
+ Loc_Start.Forward_Char (Length - 1);
+ Text : constant String := Editor.Get_Chars (Loc_Start, Loc_End);
begin
- Free (Args);
return Text;
end Get_Text;
@@ -357,52 +321,38 @@ package body Refactoring.Performers is
Replaced_Length : Integer := 0;
Only_If_Replacing : String := "") return Boolean
is
- Args : Argument_List_Access := new Argument_List'
- (new String'(Full_Name (In_File).all),
- new String'(Integer'Image (Line)),
- new String'(Visible_Column_Type'Image (Column)),
- new String'(Text),
- new String'("0"),
- new String'(Integer'Image (Replaced_Length)));
- Args2 : Argument_List_Access := new Argument_List'
- (new String'(Integer'Image (Line)),
- new String'(Integer'Image (Line + Lines_Count (Text) - 1)));
-
+ Editor : constant Editor_Buffer'Class :=
+ Get_Buffer_Factory (Kernel).Get (In_File);
+ Loc_Start : constant Editor_Location'Class := Editor.New_Location
+ (Line, Integer (Column));
+ Loc_End : constant Editor_Location'Class :=
+ Loc_Start.Forward_Char (Replaced_Length - 1);
begin
if Replaced_Length /= 0 and then Only_If_Replacing /= "" then
declare
Replacing_Str : constant String := To_Lower (Only_If_Replacing);
- Args_Get : Argument_List_Access := new Argument_List'
- (new String'(Full_Name (In_File).all),
- new String'(Integer'Image (Line)),
- new String'(Visible_Column_Type'Image (Column)),
- new String'("0"),
- new String'(Integer'Image (Replaced_Length)));
- Str : constant String :=
- To_Lower (Execute_GPS_Shell_Command
- (Kernel,
- "Editor.get_chars",
- Args_Get.all));
-
+ Str : constant String :=
+ To_Lower (Editor.Get_Chars (Loc_Start, Loc_End));
begin
- Free (Args_Get);
-
if Str /= Replacing_Str then
return False;
end if;
end;
end if;
- Execute_GPS_Shell_Command (Kernel, "Editor.replace_text", Args.all);
+ if Replaced_Length > 0 then
+ Editor.Delete (Loc_Start, Loc_End);
+ end if;
+ Editor.Insert (Loc_Start, Text);
+
if Indent then
- Execute_GPS_Shell_Command (Kernel, "Editor.select_text", Args2.all);
- Execute_GPS_Shell_Command
- (Kernel, "Editor.indent", Argument_List'(1 .. 0 => null));
+ Editor.Indent
+ (Loc_Start,
+ Editor.New_Location
+ (Line + Lines_Count (Text) - 1, 0).End_Of_Line);
end if;
- Free (Args2);
- Free (Args);
return True;
end Insert_Text;
@@ -416,17 +366,14 @@ package body Refactoring.Performers is
Line_Start : Integer;
Line_End : Integer)
is
- Args : Argument_List_Access;
+ Editor : constant Editor_Buffer'Class :=
+ Get_Buffer_Factory (Kernel).Get (In_File);
+ Loc_Start : constant Editor_Location'Class := Editor.New_Location
+ (Line_Start, 1);
+ Loc_End : constant Editor_Location'Class :=
+ Editor.New_Location (Line_End, 1).End_Of_Line;
begin
- for L in reverse Line_Start .. Line_End loop
- Args := new Argument_List'
- (new String'(Full_Name (In_File).all),
- new String'(Integer'Image (L)),
- new String'(Integer'Image (1)),
- new String'(""));
- Execute_GPS_Shell_Command (Kernel, "Editor.replace_text", Args.all);
- Free (Args);
- end loop;
+ Editor.Delete (Loc_Start, Loc_End);
end Delete_Text;
----------------------
@@ -437,10 +384,7 @@ package body Refactoring.Performers is
(Kernel : access GPS.Kernel.Kernel_Handle_Record'Class;
File : GNATCOLL.VFS.Virtual_File) is
begin
- Execute_GPS_Shell_Command
- (Kernel,
- "File """ & Escape_Backslash (Full_Name (File).all) & """; "
- & "EditorBuffer.get ""%1""; EditorBuffer.start_undo_group ""%1""");
+ Get_Buffer_Factory (Kernel).Get (File).Start_Undo_Group;
end Start_Undo_Group;
-----------------------
@@ -451,10 +395,7 @@ package body Refactoring.Performers is
(Kernel : access GPS.Kernel.Kernel_Handle_Record'Class;
File : GNATCOLL.VFS.Virtual_File) is
begin
- Execute_GPS_Shell_Command
- (Kernel,
- "File """ & Escape_Backslash (Full_Name (File).all) & """; "
- & "EditorBuffer.get ""%1""; EditorBuffer.finish_undo_group ""%1""");
+ Get_Buffer_Factory (Kernel).Get (File).Finish_Undo_Group;
end Finish_Undo_Group;
-----------------------
============================================================
--- refactoring/src/refactoring-rename.adb 3ae40b00a84c614a763a85c2ab3a844e1083bf03
+++ refactoring/src/refactoring-rename.adb 150cb2656976a87a5e03e05c05a3deb9fa5adbd6
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2003-2008, AdaCore --
+-- Copyright (C) 2003-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -216,8 +216,7 @@ package body Refactoring.Rename is
begin
Finish_Undo_Group (Kernel, File);
if Factory.Auto_Save then
- Execute_GPS_Shell_Command
- (Kernel, "Editor.save_buffer """ & Full_Name (File).all & '"');
+ Get_Buffer_Factory (Kernel).Get (File).Save (True);
end if;
end Terminate_File;
@@ -273,10 +272,8 @@ package body Refactoring.Rename is
if L = Location_Arrays.First
or else Refs.Table (L).File /= Refs.Table (L - 1).File
then
- Execute_GPS_Shell_Command
- (Kernel, "Editor.undo """
- & Full_Name (Get_Filename (Refs.Table (L).File)).all
- & '"');
+ Get_Buffer_Factory (Kernel).Get
+ (Get_Filename (Refs.Table (L).File)).Undo;
end if;
end loop;
end if;
============================================================
--- refactoring/src/refactoring-subprograms.adb 5946dbeed1f8606a0d97edb5581fa5c8ae0f7b01
+++ refactoring/src/refactoring-subprograms.adb 705e8e0d5d4c38c8f68fe7c9d9b903d91e053947
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2005-2008, AdaCore --
+-- Copyright (C) 2005-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -22,8 +22,8 @@ with Glib; use Glib;
with Dynamic_Arrays;
with Entities.Queries; use Entities, Entities.Queries;
with Glib; use Glib;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-with GNATCOLL.Scripts; use GNATCOLL.Scripts;
+with GNATCOLL.Scripts; use GNATCOLL.Scripts;
+with GPS.Editors; use GPS.Editors;
with GPS.Intl; use GPS.Intl;
with GPS.Kernel.Console; use GPS.Kernel.Console;
with GPS.Kernel.Contexts; use GPS.Kernel.Contexts;
@@ -129,8 +129,9 @@ package body Refactoring.Subprograms is
In_Params_Count : Natural := 0;
Result, Decl : Unbounded_String;
Typ : Entity_Information;
- Args : Argument_List_Access;
First_Out_Param : Entity_Information;
+ Editor : constant Editor_Buffer'Class :=
+ Get_Buffer_Factory (Kernel).Get (File);
begin
for P in Parameter_Arrays.First .. Last (Params) loop
if Params.Table (P).PType = Out_Parameter then
@@ -236,15 +237,11 @@ package body Refactoring.Subprograms is
Result := Result & "begin" & ASCII.LF & " ";
- for L in Line_Start .. Line_End loop
- Args := new Argument_List'
- (new String'(Full_Name (File).all),
- new String'(Integer'Image (L)),
- new String'(Integer'Image (1)));
- Result := Result
- & Execute_GPS_Shell_Command (Kernel, "Editor.get_chars", Args.all);
- Free (Args);
- end loop;
+ Result := Result
+ & String'
+ (Editor.Get_Chars
+ (Editor.New_Location (Line_Start, 1),
+ Editor.New_Location (Line_End, 1).End_Of_Line));
if Out_Params_Count = 1
and then In_Out_Params_Count = 0
============================================================
--- share/plug-ins/spark.py f67c9a78a330d8697b4304d3e5440124c532065f
+++ share/plug-ins/spark.py 30a18fe74fece8ba90a2337254fbe58287b35642
@@ -2,40 +2,7 @@ Copyright (c) 2005-2008 AdaCore
Copyright (c) 2004-2008 Praxis High Integrity Systems Limited
Copyright (c) 2005-2008 AdaCore
-SPARK Toolset Customization for GPS
------------------------------------
-
-Introduction
-------------
-
-This plug-in provides support for the SPARK language and toolset.
-
-It is intended for use with Release 7.6.2 or later of the
-SPARK Toolset. The customization depends on the presence of the
-"brief output" Examiner switch, which is not available
-in earlier releases. If you don't have release 7.6.2 or better,
-please contact Praxis High Integrity Systems: sparkinfo@praxis-his.com
-
-This plug-in remains a work-in-progress, and there is lots of
-room for improvement. We welcome contributions.
-
-Use
----
-
-This plug-in will be enabled only if you have spark tools available in
-your PATH variable (e.g. SPARK Examiner, POGs, etc).
-
-Edit the project preferences (from the Project menu) and tick the necessary
-languages on the Languages tab: Index, Listing, Metafile, Siv, Vcg.
-
-Switches for the tools can be set on the same menu under the Switches tab.
-
-The Examiner output produced is always -brief so that GPS is able to parse
-the resulting files.
-
-The tools can be run from the SPARK menu, or right-clicking on files will
-produce a contextual menu. Not all tools can be run on all files and GPS
-will produce a warning if the incorrect context is selected.
+See the GPS documentation for more details.
"""
@@ -52,7 +19,6 @@ import GPS
# Nice-to-haves include:
# - Context sensitive navigation in annotations
-# - Hot keys displayed on the SPARK Menu
spark_console="SPARK Output"
spark_category="Examiner"
@@ -412,13 +378,11 @@ a = """<?xml version="1.0"?>
<!-- to select metafile and VCG as project languages. -->
<action name="Examine file" category="Spark" output="none">
- <filter language="SPARK"/>
<filter language="Ada"/>
<shell lang="python">spark.examine_file (GPS.File ("%F"))</shell>
</action>
<action name="SPARKFormat file" category="Spark" output="none">
- <filter language="SPARK" />
<filter language="Ada" />
<shell lang="python">spark.format_file ()</shell>
</action>
@@ -460,7 +424,6 @@ a = """<?xml version="1.0"?>
</action>
<action name="SPARKmake" category="Spark" output="none">
- <filter language="SPARK" />
<filter language="Ada" />
<shell lang="python">spark.sparkmake ()</shell>
</action>
@@ -480,7 +443,7 @@ a = """<?xml version="1.0"?>
<Title>_Help</Title>
</menu>
<menu action="SPARKFormat file">
- <Title>SPARK _Format File</Title>
+ <Title>SPARK_Format File</Title>
</menu>
<menu action="Simplify file">
<Title>_Simplify File</Title>
============================================================
--- share/shell_commands.xml a94f2e3618b0849079b39e097725e1cc9f75264c
+++ share/shell_commands.xml 925f69f086b9d653755db84b4e9ad38358bff7c2
@@ -4960,6 +4960,11 @@ When no match is found, this function re
<description>Delets the physical mark from the buffer. All instances referencing the same mark will no longer be valid. If you haven't given a name to the mark in the call to GPS.EditorLocation.create_mark(), it will automatically be destroyed when the last instance referencing it goes out of scope. Therefore, calling delete() is not mandatory in the case of unnamed marks, although it is still recommanded</description>
</shell_doc>
+ <shell_doc name="GPS.EditorMark.is_present">
+ <param name="self">An instance of GPS.EditorMark</param>
+ <description>Returns True if mark's location is still present in the buffer</description>
+ </shell_doc>
+
<shell_doc name="GPS.EditorMark.location">
<param name="self">An instance of GPS.EditorMark</param>
<return>An instance of GPS.EditorLocation</return>
@@ -4995,10 +5000,18 @@ When no match is found, this function re
<param name="start_line">An integer</param>
<param name="text">A string</param>
<param name="category" default="">A string</param>
+ <param name="name" default="">A string</param>
<return>An instance of GPS.EditorMark</return>
- <description>Adds one non-editable line to the buffer, starting at line start_line and contains string text. If category is specified, use it for highlighting. Create a mark at beginning of block and return it</description>
+ <description>Adds one non-editable line to the buffer, starting at line start_line and contains string text. If category is specified, use it for highlighting. Create a mark at beginning of block and return it. If name is specified, retuned mark will have this name</description>
+ <see_also name="GPS.EditorBuffer.get_mark"/>
</shell_doc>
+ <shell_doc name="GPS.EditorBuffer.remove_special_lines">
+ <param name="mark">An instance of GPS.EditorMark</param>
+ <param name="lines">An integer</param>
+ <description>Removes specified number of special lines at the specified mark. It doesn't delete the mark</description>
+ </shell_doc>
+
<shell_doc name="GPS.EditorBuffer.get">
<param name="file" default="current editor">An instance of GPS.File</param>
<param name="force" default="false">A boolean</param>
============================================================
--- src_editor/src/casing_exceptions.adb 700644d818dd0d61c0b9a4986e931aca5c0216e7
+++ src_editor/src/casing_exceptions.adb a1225e05599b90787f2735ecf27a087291c2aaed
@@ -21,11 +21,10 @@ with GNAT.OS_Lib; use GNAT.O
with Ada.Strings.Maps; use Ada.Strings.Maps;
with GNAT.OS_Lib; use GNAT.OS_Lib;
-with Basic_Types;
-
with Case_Handling.IO; use Case_Handling.IO;
with Commands.Interactive; use Commands, Commands.Interactive;
with GPS.Intl; use GPS.Intl;
+with GPS.Editors; use GPS.Editors;
with GPS.Kernel.Contexts; use GPS.Kernel.Contexts;
with GPS.Kernel.Modules; use GPS.Kernel.Modules;
with GPS.Kernel.Scripts; use GPS.Kernel.Scripts;
@@ -397,20 +396,16 @@ package body Casing_Exceptions is
W_Seps : constant Character_Set :=
To_Set (" ;.:=(),/'#*+-""><&" &
ASCII.HT & ASCII.CR & ASCII.LF);
- Before : aliased String := "1";
- After : aliased String := Integer'Image (Area'Length + 1);
- Line : aliased String :=
- Integer'Image (Line_Information (Context));
- Col : aliased String :=
- Basic_Types.Visible_Column_Type'Image
- (Column_Information (Context));
- Text : constant String := Execute_GPS_Shell_Command
- (Kernel, "Editor.get_chars",
- (1 => Full_Name (File).all'Unrestricted_Access,
- 2 => Line'Unchecked_Access,
- 3 => Col'Unchecked_Access,
- 4 => Before'Unchecked_Access,
- 5 => After'Unchecked_Access));
+ Editor : constant Editor_Buffer'Class :=
+ Kernel.Get_Buffer_Factory.Get (File);
+ Loc_Start : constant Editor_Location'Class := Editor.New_Location
+ (Line_Information (Context),
+ Integer (Column_Information (Context))).Forward_Char (-1);
+ Loc_End : constant Editor_Location'Class := Editor.New_Location
+ (Line_Information (Context),
+ Integer (Column_Information (Context)))
+ .Forward_Char (Area'Length);
+ Text : constant String := Editor.Get_Chars (Loc_Start, Loc_End);
begin
return Text'Length <= 1
or else not Is_In (Text (Text'First), W_Seps)
============================================================
--- src_editor/src/src_editor_box.adb 7b440b0e6696d12c2af8350c49a5c86b8e115ad0
+++ src_editor/src/src_editor_box.adb f1283eb752d38dee6a336be753c7301c313135aa
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2001-2008, AdaCore --
+-- Copyright (C) 2001-2009, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -73,7 +73,6 @@ with GPS.Kernel.Project; use GPS.
with GPS.Kernel.Modules; use GPS.Kernel.Modules;
with GPS.Kernel.Preferences; use GPS.Kernel.Preferences;
with GPS.Kernel.Project; use GPS.Kernel.Project;
-with GPS.Kernel.Scripts; use GPS.Kernel.Scripts;
with GPS.Kernel.Standard_Hooks; use GPS.Kernel.Standard_Hooks;
with GUI_Utils; use GUI_Utils;
with Language; use Language;
@@ -405,7 +404,6 @@ package body Src_Editor_Box is
File_Up_To_Date : Boolean;
L : Natural;
Is_Case_Sensitive : Boolean;
- Arg : GNAT.Strings.String_Access;
Char_Column : Character_Offset_Type;
begin
@@ -493,9 +491,7 @@ package body Src_Editor_Box is
end if;
end if;
- Arg := new String'(Full_Name (Filename).all);
- Execute_GPS_Shell_Command (Kernel, "Editor.cursor_center", (1 => Arg));
- Free (Arg);
+ Get_Buffer_Factory (Kernel).Get (Filename).Current_View.Center;
end Go_To_Closest_Match;
----------------
@@ -1281,7 +1277,13 @@ package body Src_Editor_Box is
Loc := Location_Cursor;
end if;
- Stop_Selection_Drag (V);
+ -- If there is indeed a menu, cancel the selection drag.
+ -- Otherwise, we are calling this function only to create a context (for
+ -- instance when displaying a tooltip) and we should not cancel the
+ -- selection drag.
+ if Menu /= null then
+ Stop_Selection_Drag (V);
+ end if;
Set_Context_Information
(Context => Context,
@@ -1405,28 +1407,52 @@ package body Src_Editor_Box is
declare
The_Line : Editable_Line_Type;
The_Column : Character_Offset_Type;
- Str : String_Access :=
- Get_String (Get_Buffer (Editor));
- -- ??? Not very efficient though
+ Str : Src_String :=
+ Get_String
+ (Get_Buffer (Editor),
+ Get_Editable_Line
+ (Editor.Source_Buffer,
+ Buffer_Line_Type (Get_Line (Entity_End)) + 1));
begin
Get_Iter_Position
(Editor.Source_Buffer, Entity_Start, The_Line, The_Column);
- Set_Entity_Information
- (Context,
- Entity_Name => Get_Text (Entity_Start, Entity_End),
- Entity_Column => Expand_Tabs
- (Editor.Source_Buffer, The_Line, The_Column),
- From_Expression =>
- Parse_Expression_Backward_To_String
- (Get_Language (Get_Buffer (Editor)),
- Buffer => Str.all,
- Start_Offset => Get_Byte_Index (Entity_End),
- Simple_Expression => True));
- -- No additional offset needed here: Str'First is always 1 in
- -- this context, Entity_End points to the character _after_
- -- the last character in entity, but Get_Offset is zero-based.
+ if Str.Contents /= null then
+ if Click_In_Selection then
+ -- If there was a selection and we clicked in it, we only
+ -- should take the selection into account. For instance,
+ -- this is a way for the user to force a specific name to
+ -- be sent to the debugger instead of the whole
+ -- expression
+ Set_Entity_Information
+ (Context,
+ Entity_Name => Get_Text (Entity_Start, Entity_End),
+ Entity_Column => Expand_Tabs
+ (Editor.Source_Buffer, The_Line, The_Column));
+
+ else
+ Set_Entity_Information
+ (Context,
+ Entity_Name => Get_Text (Entity_Start, Entity_End),
+ Entity_Column => Expand_Tabs
+ (Editor.Source_Buffer, The_Line, The_Column),
+ From_Expression =>
+ Parse_Expression_Backward_To_String
+ (Get_Language (Get_Buffer (Editor)),
+ Buffer => Str.Contents (1 .. Str.Length),
+ Start_Offset =>
+ Integer (Get_Line_Index (Entity_End)),
+ Simple_Expression => True));
+ end if;
+ else
+ Set_Entity_Information
+ (Context,
+ Entity_Name => Get_Text (Entity_Start, Entity_End),
+ Entity_Column => Expand_Tabs
+ (Editor.Source_Buffer, The_Line, The_Column));
+ end if;
+
Free (Str);
end;
============================================================
--- src_editor/src/src_editor_buffer-line_information.adb 2bfe6548dd0fe5d53c85a3917625d59c37f8ce4b
+++ src_editor/src/src_editor_buffer-line_information.adb 3d241b42c611557c5c96accdf60c7061813c7b5f
@@ -779,11 +779,12 @@ package body Src_Editor_Buffer.Line_Info
---------------------
function Add_Blank_Lines
- (Buffer : access Source_Buffer_Record'Class;
- Line : Editable_Line_Type;
+ (Buffer : access Source_Buffer_Record'Class;
+ Line : Editable_Line_Type;
Highlight_Category : Integer;
- Text : String;
- Number : Positive) return Gtk.Text_Mark.Gtk_Text_Mark
+ Text : String;
+ Number : Positive;
+ Name : String) return Gtk.Text_Mark.Gtk_Text_Mark
is
LFs : String (1 .. Natural (Number));
Buffer_Line : Buffer_Line_Type;
@@ -841,7 +842,7 @@ package body Src_Editor_Buffer.Line_Info
Buffer.Blank_Lines := Buffer.Blank_Lines + Number;
- Mark := Create_Mark (Buffer, "", Iter);
+ Mark := Create_Mark (Buffer, Name, Iter);
Buffer.Inserting := True;
Get_Iter_At_Line (Buffer, Iter, Gint (Buffer_Line - 1));
============================================================
--- src_editor/src/src_editor_buffer-line_information.ads b596666636b20e9cf1e7786b196ce3ce41852aa9
+++ src_editor/src/src_editor_buffer-line_information.ads c963984cfdc8849bfa94b4f40b262d07c1d9a733
@@ -77,11 +77,12 @@ package Src_Editor_Buffer.Line_Informati
-- Perform a click in the side column for line Line, offset Offset
function Add_Blank_Lines
- (Buffer : access Source_Buffer_Record'Class;
- Line : Editable_Line_Type;
+ (Buffer : access Source_Buffer_Record'Class;
+ Line : Editable_Line_Type;
Highlight_Category : Integer;
- Text : String;
- Number : Positive) return Gtk.Text_Mark.Gtk_Text_Mark;
+ Text : String;
+ Number : Positive;
+ Name : String) return Gtk.Text_Mark.Gtk_Text_Mark;
-- Add Number blank lines at line Line.
-- Blank lines cannot be edited, and are not saved on disk.
============================================================
--- src_editor/src/src_editor_buffer-text_handling.adb 5bb0c5503feba3f4d2bc13587d2c6e6931aecef6
+++ src_editor/src/src_editor_buffer-text_handling.adb 75e841e60a732a55528d24ac29e656a6a1d6f412
@@ -292,16 +292,16 @@ package body Src_Editor_Buffer.Text_Hand
-- instead the Line, First and Last variable below which represent the
-- real word position on the line.
- Lang : Language_Access;
- Line : Editable_Line_Type;
- Column : Character_Offset_Type;
- First : Character_Offset_Type;
- W_End : Gtk_Text_Iter;
- W_Start : Gtk_Text_Iter;
- Indent_Params : Indent_Parameters;
- Indent_Kind : Indentation_Kind;
- Result : Boolean;
- Char, Prev : Character;
+ Lang : Language_Access;
+ Line : Editable_Line_Type;
+ Column : Character_Offset_Type;
+ First : Character_Offset_Type;
+ W_End : Gtk_Text_Iter;
+ W_Start : Gtk_Text_Iter;
+ Indent_Params : Indent_Parameters;
+ Indent_Kind : Indentation_Kind;
+ Result : Boolean;
+ Char, Prev, PPrev : Character;
------------------
-- Replace_Text --
@@ -337,7 +337,13 @@ package body Src_Editor_Buffer.Text_Hand
else
Get_Cursor_Position (Buffer, W_End);
- Backward_Char (W_End, Result);
+
+ Result := False;
+
+ if not Is_Start (W_End) then
+ Backward_Char (W_End, Result);
+ end if;
+
Get_Indentation_Parameters (Lang, Indent_Params, Indent_Kind);
if Indent_Params.Casing_Policy /= On_The_Fly
@@ -350,7 +356,9 @@ package body Src_Editor_Buffer.Text_Hand
return;
end if;
- Forward_Char (W_End, Result);
+ if Result then
+ Forward_Char (W_End, Result);
+ end if;
end if;
Get_Iter_Position (Source_Buffer (Buffer), W_End, Line, Column);
@@ -365,9 +373,12 @@ package body Src_Editor_Buffer.Text_Hand
First := Column;
Char := ' ';
+ Prev := ' ';
+ PPrev := ' ';
loop
Backward_Char (W_Start, Result);
+ PPrev := Prev;
Prev := Char;
Char := Get_Char (W_Start);
@@ -378,10 +389,11 @@ package body Src_Editor_Buffer.Text_Hand
return;
end if;
- if Char = ''' and Prev = ''' then
- -- We don't want to parse past the second quote
+ if Char = ''' and then PPrev = ''' then
+ -- This is a character, we do not want to parse it
Forward_Char (W_Start, Result);
- First := First + 1;
+ Forward_Char (W_Start, Result);
+ First := First + 2;
exit;
end if;
============================================================
--- src_editor/src/src_editor_buffer.adb ec7cdd7943a705123ea08d8ac18f1216fa28d546
+++ src_editor/src/src_editor_buffer.adb e9b0a5bfccf3da0d6713b620059d85f5f77989e7
@@ -344,29 +344,6 @@ package body Src_Editor_Buffer is
function Cursor_Stop_Hook (Buffer : Source_Buffer) return Boolean;
-- Hook called after the cursor has stopped moving
- type Src_String is record
- Contents : Unchecked_String_Access;
- Length : Natural := 0;
- Read_Only : Boolean := False;
- end record;
- -- Special purpose string type to avoid extra copies and string allocation
- -- as much as possible.
- -- The actual contents of a Src_String is represented by
- -- Contents (1 .. Length) (as utf8-encoded string)
- -- Never use Free (Contents) directly, use the Free procedure below.
-
- procedure Free (S : in out Src_String);
- -- Free the memory associated with S
-
- function Get_String
- (Buffer : Source_Buffer;
- Line : Editable_Line_Type) return Src_String;
- -- Return the string at line Line, without the line terminator.
- -- Return null if the Line is not a valid line or there is no contents
- -- associated with the line.
- -- The caller is responsible for freeing the returned value..
- -- The returned string is UTF8-encoded
-
procedure Free_Column_Info
(Column_Info : Columns_Config_Access);
-- Free the info contained in Column_Info
============================================================
--- src_editor/src/src_editor_buffer.ads 5f4d06de40e782f3f7b9514ea310a5e83c9ff9e1
+++ src_editor/src/src_editor_buffer.ads 4948f228bf59e3c7c58045c680691bfe71632823
@@ -902,6 +902,33 @@ package Src_Editor_Buffer is
-- Return the iter at position (Line, Column), tab expansion included.
-- If Line is not in the text, return the Iter at beginning of text.
+ ----------------
+ -- Src_String --
+ ----------------
+
+ type Src_String is record
+ Contents : Unchecked_String_Access;
+ Length : Natural := 0;
+ Read_Only : Boolean := False;
+ end record;
+ -- Special purpose string type to avoid extra copies and string allocation
+ -- as much as possible.
+ -- The actual contents of a Src_String is represented by
+ -- Contents (1 .. Length) (as utf8-encoded string)
+ -- Never use Free (Contents) directly, use the Free procedure below.
+
+ procedure Free (S : in out Src_String);
+ -- Free the memory associated with S
+
+ function Get_String
+ (Buffer : Source_Buffer;
+ Line : Editable_Line_Type) return Src_String;
+ -- Return the string at line Line, without the line terminator.
+ -- Return null if the Line is not a valid line or there is no contents
+ -- associated with the line.
+ -- The caller is responsible for freeing the returned value..
+ -- The returned string is UTF8-encoded
+
private
procedure Set_Cursor_Position
============================================================
--- src_editor/src/src_editor_module-shell.adb b7d821bd0fea8e67fc4cc12936f43bfe845a3096
+++ src_editor/src/src_editor_module-shell.adb f0572ff7aa100ef8bb057ec310d86fca2aa2ed22
@@ -1657,7 +1657,7 @@ package body Src_Editor_Module.Shell is
Add_Blank_Lines
(Get_Buffer (Box),
Editable_Line_Type (Line),
- Highlight_Category, "", Number));
+ Highlight_Category, "", Number, ""));
Set_Return_Value (Data, Get_Id (Marker));
end if;
else
@@ -1672,7 +1672,7 @@ package body Src_Editor_Module.Shell is
Number : Integer := 0;
Box : Source_Editor_Box;
begin
- if Number_Of_Arguments (Data) >= 3 then
+ if Number_Of_Arguments (Data) >= 2 then
Number := Nth_Arg (Data, 2);
end if;
@@ -2422,8 +2422,12 @@ package body Src_Editor_Module.Shell is
Text : constant String := Nth_Arg (Data, 3);
Highlight_Category : Natural := 0;
Style : Style_Access;
+ Name : GNAT.OS_Lib.String_Access;
+
begin
- if Number_Of_Arguments (Data) >= 4 then
+ if Number_Of_Arguments (Data) >= 4
+ and then Nth_Arg (Data, 4) /= ""
+ then
Style := Get_Or_Create_Style
(Kernel, Nth_Arg (Data, 4), False);
@@ -2437,18 +2441,46 @@ package body Src_Editor_Module.Shell is
end if;
end if;
+ if Number_Of_Arguments (Data) >= 5 then
+ Name := new String'(Nth_Arg (Data, 5));
+
+ else
+ Name := new String'("");
+ end if;
+
Mark := Add_Blank_Lines
(Buffer,
Editable_Line_Type (Line),
Highlight_Category,
Text,
- 1);
+ 1,
+ Name.all);
+ Free (Name);
+
Set_Return_Value
(Data, Create_Editor_Mark (Get_Script (Data), Mark));
end;
end if;
+ elsif Command = "remove_special_lines" then
+ Get_Buffer (Buffer, Data, 1);
+ Get_Mark (Mark, Data, 2);
+
+ if Buffer /= null and then Mark /= null then
+ declare
+ Number : Natural := 0;
+
+ begin
+ if Number_Of_Arguments (Data) >= 3 then
+ Number := Nth_Arg (Data, 3);
+ end if;
+
+ Src_Editor_Buffer.Line_Information.Remove_Blank_Lines
+ (Buffer, Mark, Number);
+ end;
+ end if;
+
else
Set_Error_Msg (Data, -"Command not implemented: " & Command);
end if;
@@ -2977,8 +3009,18 @@ package body Src_Editor_Module.Shell is
if Mark /= null then
Trace (Me, "Deleting mark");
Delete_Mark (Get_Buffer (Mark), Mark);
+ end if;
+ elsif Command = "is_present" then
+ Get_Mark (Mark, Data, 1);
+
+ if Mark /= null then
+ Set_Return_Value (Data, not Get_Deleted (Mark));
+
+ else
+ Set_Return_Value (Data, False);
end if;
+
elsif Command = "location" then
Get_Mark (Mark, Data, 1);
if Mark /= null then
@@ -3363,6 +3405,8 @@ package body Src_Editor_Module.Shell is
Register_Command
(Kernel, "delete", 0, 0, Mark_Cmds'Access, EditorMark);
Register_Command
+ (Kernel, "is_present", 0, 0, Mark_Cmds'Access, EditorMark);
+ Register_Command
(Kernel, "location", 0, 0, Mark_Cmds'Access, EditorMark);
Register_Command (Kernel, "move", 1, 1, Mark_Cmds'Access, EditorMark);
@@ -3453,7 +3497,14 @@ package body Src_Editor_Module.Shell is
Register_Command
(Kernel, "is_read_only", 0, 0, Buffer_Cmds'Access, EditorBuffer);
Register_Command
- (Kernel, "add_special_line", 2, 3, Buffer_Cmds'Access, EditorBuffer);
+ (Kernel, "add_special_line", 2, 4, Buffer_Cmds'Access, EditorBuffer);
+ Register_Command
+ (Kernel,
+ "remove_special_lines",
+ 2,
+ 3,
+ Buffer_Cmds'Access,
+ EditorBuffer);
-- EditorView
============================================================
--- src_editor/src/src_editor_module.adb 1e2388f3e9a7aaebe16b2bd40213a37ee945432f
+++ src_editor/src/src_editor_module.adb 8418021a6c56b0d67fb777f09365531965c6eb06
@@ -69,6 +69,7 @@ with GPS.Intl;
with Filesystems; use Filesystems;
with Find_Utils; use Find_Utils;
with GPS.Intl; use GPS.Intl;
+with GPS.Editors; use GPS.Editors;
with GPS.Kernel.Actions; use GPS.Kernel.Actions;
with GPS.Kernel.Charsets; use GPS.Kernel.Charsets;
with GPS.Kernel.Console; use GPS.Kernel.Console;
@@ -92,6 +93,7 @@ with Src_Editor_Module.Line_Highlighting
use Src_Editor_Buffer.Line_Information;
with Src_Editor_Buffer.Text_Handling; use Src_Editor_Buffer.Text_Handling;
with Src_Editor_Module.Line_Highlighting;
+with Src_Editor_Module.Editors; use Src_Editor_Module.Editors;
with Src_Editor_Module.Markers; use Src_Editor_Module.Markers;
with Src_Editor_Module.Shell; use Src_Editor_Module.Shell;
with Src_Editor_View.Commands; use Src_Editor_View.Commands;
@@ -3120,6 +3122,11 @@ package body Src_Editor_Module is
Register_Commands (Kernel);
+ Set_Buffer_Factory
+ (Kernel,
+ new Src_Editor_Buffer_Factory'
+ (Editor_Buffer_Factory with Kernel => Kernel_Handle (Kernel)));
+
-- Register the search functions
Gtk_New (Selector, Kernel);
============================================================
--- vcs/src/commands-vcs.adb db919b008da37ca5ee3cfa87fc2056c51d0f1624
+++ vcs/src/commands-vcs.adb ac2320e264627e65a5216c863a89ca92c724be96
@@ -138,9 +138,26 @@ package body Commands.VCS is
Log := First (Command.Logs);
- if Length (Command.Logs) = 1 then
+ if Length (Command.Logs) = 0 then
+ -- No log, this is the case when no log is required by the external
+ -- VCS.
case Command.Action is
when Commit =>
+ Commit (Command.Rep, Command.Filenames, "");
+
+ when Add =>
+ Add (Command.Rep, Command.Filenames, "");
+
+ when Remove =>
+ Remove (Command.Rep, Command.Filenames, "");
+
+ when others =>
+ raise Program_Error;
+ end case;
+
+ elsif Length (Command.Logs) = 1 then
+ case Command.Action is
+ when Commit =>
Commit (Command.Rep, Command.Filenames, Data (Log));
when Add =>
============================================================
--- vcs/src/log_utils.adb 4db1c30ded69641b2a0e9320dcda72626fc67fe2
+++ vcs/src/log_utils.adb 14474edb3c6ca8ecb4b460b232f599780bc7ca03
@@ -733,58 +733,63 @@ package body Log_Utils is
First_Check, Last_Check : Command_Access := null;
begin
- if not Save_Files (Kernel, Files, Activity, Save_Logs => True) then
+ if not Save_Files
+ (Kernel, Files, Activity, Save_Logs => Ref.Require_Log)
+ then
return;
end if;
-- Build the log for the commit
- if Activity = No_Activity then
- while Files_Temp /= Null_Node loop
- -- Save any open log editors, and then get the corresponding logs
+ if Ref.Require_Log then
+ if Activity = No_Activity then
+ while Files_Temp /= Null_Node loop
+ -- Save any open log editors, and then get the corresponding
+ -- logs.
- File := Create (Full_Filename => Data (Files_Temp));
- Append (Logs, Get_Log (Kernel, File));
- Files_Temp := Next (Files_Temp);
- end loop;
+ File := Create (Full_Filename => Data (Files_Temp));
+ Append (Logs, Get_Log (Kernel, File));
+ Files_Temp := Next (Files_Temp);
+ end loop;
- else
- -- Create the Check_Activity command
+ else
+ -- Create the Check_Activity command
- if Action = Commit then
- Create (Check_Activity_Command, Kernel, Activity);
- end if;
+ if Action = Commit then
+ Create (Check_Activity_Command, Kernel, Activity);
+ end if;
- if Get_Group_Commit (Activity) then
- declare
- T_Set : Translate_Set :=
- Get_Activity_Template_Tags (Kernel, Activity);
- begin
- Insert (T_Set, Assoc ("IS_PATCH", False));
- Append
- (Logs, Parse (Get_Activity_Log_Template (Kernel), T_Set));
- end;
+ if Get_Group_Commit (Activity) then
+ declare
+ T_Set : Translate_Set :=
+ Get_Activity_Template_Tags (Kernel, Activity);
+ begin
+ Insert (T_Set, Assoc ("IS_PATCH", False));
+ Append
+ (Logs, Parse (Get_Activity_Log_Template (Kernel), T_Set));
+ end;
- else
- while Files_Temp /= Null_Node loop
- -- Save any open log editors, and then get the corresponding
- -- logs.
+ else
+ while Files_Temp /= Null_Node loop
+ -- Save any open log editors, and then get the corresponding
+ -- logs.
- File := Create (Full_Filename => Data (Files_Temp));
+ File := Create (Full_Filename => Data (Files_Temp));
- if Get_Log_From_File (Kernel, File, False) = No_File then
- -- No individual logs
- Append (Logs, Get_Log (Kernel, Activity));
+ if Get_Log_From_File (Kernel, File, False) = No_File then
+ -- No individual logs
+ Append (Logs, Get_Log (Kernel, Activity));
- else
- Append
- (Logs,
- Add_LF_To_Log (Get_Log (Kernel, File))
- & Get_Log (Kernel, Activity));
- end if;
+ else
+ Append
+ (Logs,
+ Add_LF_To_Log (Get_Log (Kernel, File))
+ & Get_Log (Kernel, Activity));
+ end if;
- Files_Temp := Next (Files_Temp);
- end loop;
+ Files_Temp := Next (Files_Temp);
+ end loop;
+ end if;
end if;
end if;
@@ -812,7 +817,10 @@ package body Log_Utils is
-- Check if the activity log is not empty
- if Activity /= No_Activity and then Get_Log (Kernel, Activity) = "" then
+ if Activity /= No_Activity
+ and then Ref.Require_Log
+ and then Get_Log (Kernel, Activity) = ""
+ then
if Message_Dialog
((-"The activity log file is empty,")
& ASCII.LF &
@@ -852,10 +860,7 @@ package body Log_Utils is
(Project, VCS_File_Check);
Log_Check_Command : constant String := Get_Attribute_Value
(Project, VCS_Log_Check);
- Log_File : constant Virtual_File :=
- Get_Log_From_File
- (Kernel, File, False,
- Action_To_Log_Suffix (Action));
+ Log_File : Virtual_File;
File_Args : String_List.List;
Log_Args : String_List.List;
Head_List : String_List.List;
@@ -905,7 +910,7 @@ package body Log_Utils is
if First_Check = null then
First_Check := Command_Access (File_Checks);
else
- Add_Consequence_Action (Last_Check, File_Checks);
+ Add_Continuation_Action (Last_Check, File_Checks);
end if;
Last_Check := Command_Access (File_Checks);
@@ -913,6 +918,11 @@ package body Log_Utils is
end if;
end if;
+ if Ref.Require_Log then
+ Log_File := Get_Log_From_File
+ (Kernel, File, False, Action_To_Log_Suffix (Action));
+ end if;
+
if Log_Check_Command /= ""
and then Log_File /= No_File
then
@@ -985,7 +995,7 @@ package body Log_Utils is
if First_Check = null then
First_Check := Command_Access (Log_Checks);
else
- Add_Consequence_Action (Last_Check, Log_Checks);
+ Add_Continuation_Action (Last_Check, Log_Checks);
end if;
Last_Check := Command_Access (Log_Checks);
============================================================
--- vcs/src/vcs-generic_vcs.adb de08a82386cec88f8413645547df10e848d06eb9
+++ vcs/src/vcs-generic_vcs.adb 729e68d198ea31915bf9cebcf0b6aa99cf25069d
@@ -1433,6 +1433,8 @@ package body VCS.Generic_VCS is
(Get_Attribute (M, "commit_directory", "FALSE"));
Ref.Administrative_Dir := new String'
(Get_Attribute (M, "administrative_directory", ""));
+ Ref.Require_Log := Boolean'Value
+ (Get_Attribute (M, "require_log", "TRUE"));
-- dir_sep is an alias for path_style and is obsolescent, if both
-- path_style and dir_sep are set, parth_style value is used.
============================================================
--- vcs/src/vcs-generic_vcs.ads d41f4e21464a07e678a40d41ad7c1c7494193e7c
+++ vcs/src/vcs-generic_vcs.ads cf242ba35ef3e764c76a03cc24d159e82ef1267d
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2003-2008, AdaCore --
+-- Copyright (C) 2003-2008, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
============================================================
--- vcs/src/vcs-unknown_vcs.adb bd2299de74a0e241fe6b243d6bf7a4790e7a5970
+++ vcs/src/vcs-unknown_vcs.adb 93b76358ef499763514358d41956f3207f0658a1
@@ -54,6 +54,18 @@ package body VCS.Unknown_VCS is
return Unknown_VCS_Name;
end Name;
+ -----------------
+ -- Require_Log --
+ -----------------
+
+ overriding function Require_Log
+ (Ref : access Unknown_VCS_Record) return Boolean
+ is
+ pragma Unreferenced (Ref);
+ begin
+ return False;
+ end Require_Log;
+
----------
-- Free --
----------
============================================================
--- vcs/src/vcs-unknown_vcs.ads 91fb5150ecbb563a079a993b17d904c5161b3499
+++ vcs/src/vcs-unknown_vcs.ads 9e6168c1f1f586a2ae35a38da9436cbf775c5747
@@ -24,7 +24,7 @@ package VCS.Unknown_VCS is
package VCS.Unknown_VCS is
type Unknown_VCS_Record is new VCS_Record with private;
- -- A value used to reference a Unknown_VCS repository.
+ -- A value used to reference a Unknown_VCS repository
type Unknown_VCS_Access is access all Unknown_VCS_Record'Class;
@@ -33,6 +33,9 @@ package VCS.Unknown_VCS is
overriding function Name (Ref : access Unknown_VCS_Record) return String;
+ overriding function Require_Log
+ (Ref : access Unknown_VCS_Record) return Boolean;
+
procedure Free (Ref : access Unknown_VCS_Record);
overriding procedure Get_Status
============================================================
--- vcs/src/vcs.adb 28d0511dad2186dfa17f1293c8a6e8c0b9b92de0
+++ vcs/src/vcs.adb 268bad919b8a1701d15b4d8472f330a32be27d6d
@@ -364,4 +364,13 @@ package body VCS is
return Ref.Action_Labels (Action) /= null;
end Is_Action_Defined;
+ -----------------
+ -- Require_Log --
+ -----------------
+
+ function Require_Log (Ref : access VCS_Record) return Boolean is
+ begin
+ return Ref.Require_Log;
+ end Require_Log;
+
end VCS;
============================================================
--- vcs/src/vcs.ads e55ecc66e4aeb821165472bae5b48e3af35a73aa
+++ vcs/src/vcs.ads 0ba144b3890c079b49dd262f066228909d1929ad
@@ -114,6 +114,10 @@ package VCS is
function Commit_Directory (Ref : access VCS_Record) return Boolean;
-- Returns True if an added/removed directories needs to be committed
+ function Require_Log (Ref : access VCS_Record) return Boolean;
+ -- Returns Trus if GPS must check for log presence and open if necessary
+ -- log editor.
+
function Ignore_Filename (Ref : access VCS_Record) return String;
-- Returns the file containing a list of file to ignore. Returns the empty
-- string if no such file is set for this VCS.
@@ -526,6 +530,7 @@ private
Query_Status_By_Dir : Boolean := False;
Atomic_Commands : Boolean := False;
Commit_Directory : Boolean := False;
+ Require_Log : Boolean := True;
Path_Style : OS_Utils.Path_Style := System_Default;
Ignore_Filename : GNAT.Strings.String_Access;
Used : Boolean := False;
============================================================
--- vcs/src/vcs_activities.adb 0f1ef7cee23fcf407f7d1605d0881fef1a1c709f
+++ vcs/src/vcs_activities.adb ca02eefcc591e1f14caf8846150396c75aea1b00
@@ -29,13 +29,13 @@ with GPS.Kernel.Project; use GPS
with Glib.Xml_Int; use Glib.Xml_Int;
with GPS.Kernel.Project; use GPS.Kernel.Project;
+with GPS.Kernel.Console; use GPS.Kernel.Console;
with Log_Utils; use Log_Utils;
with Projects; use Projects;
with Projects.Registry; use Projects.Registry;
with String_Hash;
with Traces; use Traces;
with VCS.Unknown_VCS; use VCS.Unknown_VCS;
-with VCS_Module; use VCS_Module;
with VCS_View; use VCS_View;
with VCS_View_API; use VCS_View_API;
with XML_Parsers;
@@ -594,9 +594,7 @@ package body VCS_Activities is
F_Activity : constant Activity_Id := Get_File_Activity (File);
Project : constant Project_Type :=
Get_Project_From_File (Get_Registry (Kernel).all, File);
- VCS : constant VCS_Access :=
- Get_VCS_From_Id
- (Get_Attribute_Value (Project, VCS_Kind_Attribute));
+ VCS : constant VCS_Access := Get_Current_Ref (Kernel, Project);
Item : Activity_Record := Get (Activity);
procedure Add (File : Virtual_File);
@@ -635,16 +633,18 @@ package body VCS_Activities is
-- Check that the new file is using the same VCS. Also check that the
-- file is not yet part of an open activity.
- if (Item.VCS /= null and then VCS /= Item.VCS)
- or else (F_Activity /= No_Activity
- and then not Is_Closed (F_Activity))
- then
- -- ??? dialog saying that it is not possible (2 diff VCS)
- -- ??? or activity is already committed.
- return;
+ if Item.VCS /= null and then VCS /= Item.VCS then
+ Console.Insert
+ (Kernel,
+ "Cannot add " & Full_Name (File).all
+ & " to activity, VCS not matching.");
+
+ elsif F_Activity /= No_Activity and then not Is_Closed (F_Activity) then
+ Console.Insert (Kernel, "Cannot add a file to a closed activity.");
+
+ else
+ Add (File);
end if;
-
- Add (File);
end Add_File;
-----------------
============================================================
--- vcs/src/vcs_module.adb 7ebbbeec0656f2a5cfb4cdc0181baf95904cfcd0
+++ vcs/src/vcs_module.adb 318812cc015dd2a4537972af999fe9d309b78853
@@ -219,6 +219,9 @@ package body VCS_Module is
function One_Action_Defined (Actions : VCS_Actions) return Boolean;
-- Returns true if at least one action in Actions is defined
+ function Log_Required_In_VCS return Boolean;
+ -- Returns true if at least one VCS requires log content
+
VCS_Menu : constant String := "/_" & (-"VCS");
Dir_Filter : constant Action_Filter :=
Lookup_Filter (Kernel, "Directory");
@@ -273,6 +276,31 @@ package body VCS_Module is
return False;
end One_Action_Defined;
+ -------------------------
+ -- Log_Required_In_VCS --
+ -------------------------
+
+ function Log_Required_In_VCS return Boolean is
+
+ procedure Check_Log (VCS : VCS_Access);
+ -- Check that log requires VCS
+
+ Result : Boolean := False;
+
+ ---------------
+ -- Check_Log --
+ ---------------
+
+ procedure Check_Log (VCS : VCS_Access) is
+ begin
+ Result := Result or VCS.Require_Log;
+ end Check_Log;
+
+ begin
+ For_Every_VCS (Check_Log'Access);
+ return Result;
+ end Log_Required_In_VCS;
+
----------------------
-- Create_Separator --
----------------------
@@ -432,27 +460,31 @@ package body VCS_Module is
File_Filter,
On_Menu_Remove_Annotate'Access, (1 => Annotate));
- Register_Action_Menu
- ("Edit revision log",
- -"Edit the revision log for the current file",
- -"Edit revision log",
- File_Filter,
- On_Menu_Edit_Log'Access, (Add, Commit));
+ -- Add the log handling actions only if at least one VCS supports log
- Register_Action_Menu
- ("Edit global ChangeLog",
- -"Edit the global ChangeLog for the current selection",
- -"Edit global ChangeLog",
- File_Filter,
- On_Menu_Edit_ChangeLog'Access, (Add, Remove, Commit));
+ if Log_Required_In_VCS then
+ Register_Action_Menu
+ ("Edit revision log",
+ -"Edit the revision log for the current file",
+ -"Edit revision log",
+ File_Filter,
+ On_Menu_Edit_Log'Access, (Add, Commit));
- Register_Action_Menu
- ("Remove revision log",
- -"Remove the revision log corresponding to the current file",
- -"Remove revision log",
- File_Filter,
- On_Menu_Remove_Log'Access, (Add, Remove, Commit));
+ Register_Action_Menu
+ ("Edit global ChangeLog",
+ -"Edit the global ChangeLog for the current selection",
+ -"Edit global ChangeLog",
+ File_Filter,
+ On_Menu_Edit_ChangeLog'Access, (Add, Remove, Commit));
+ Register_Action_Menu
+ ("Remove revision log",
+ -"Remove the revision log corresponding to the current file",
+ -"Remove revision log",
+ File_Filter,
+ On_Menu_Remove_Log'Access, (Add, Remove, Commit));
+ end if;
+
Create_Separator;
Register_Action_Menu
============================================================
--- vcs/src/vcs_status.adb 752d2b349b13646c7b953de2150bf9c77f5544fd
+++ vcs/src/vcs_status.adb 2670f64ebe941e5579a7cc7c65c56df2f7ac81eb
@@ -31,7 +31,7 @@ with VCS_View; use VCS_View
with String_Utils; use String_Utils;
with Traces; use Traces;
with VCS_View; use VCS_View;
-with VCS_Module; use VCS_Module;
+with VCS_View_API; use VCS_View_API;
with XML_Parsers;
package body VCS_Status is
@@ -320,9 +320,7 @@ package body VCS_Status is
Get_Project_From_File
(Get_Registry (Kernel).all, File);
VCS : constant VCS_Access :=
- Get_VCS_From_Id
- (Get_Attribute_Value
- (Project, VCS_Kind_Attribute));
+ Get_Current_Ref (Kernel, Project);
Status : constant Status_Id :=
Status_Id'Value
(Get_Attribute (Node, "status", "unknown_id"));
============================================================
--- vcs/src/vcs_view-explorer.adb 03a56dc326c47c9d9e93a8fb53c711ade05c4161
+++ vcs/src/vcs_view-explorer.adb 8741af48c27015f29fe3e1cc6bd83c97e49fe92d
@@ -219,7 +219,7 @@ package body VCS_View.Explorer is
File : constant Virtual_File := Create
(Get_String (Explorer.Model, Iter, Name_Column));
Line : constant Line_Record :=
- Get_Cache (Get_Status_Cache, File);
+ Get_Cache (Get_Status_Cache, File);
Success : Boolean;
begin
Fill_Info (Explorer, Iter, Line, Success);
@@ -348,16 +348,6 @@ package body VCS_View.Explorer is
end if;
end On_Remove_Project;
- ----------
- -- Free --
- ----------
-
- procedure Free (X : in out Natural) is
- pragma Unreferenced (X);
- begin
- null;
- end Free;
-
-------------------------
-- Display_File_Status --
-------------------------
============================================================
--- vcs/src/vcs_view-explorer.ads 0a3a1021cbe870778f615d6fb75c0ddfec98f446
+++ vcs/src/vcs_view-explorer.ads 267523dd6899bfcab8ce4e24c1833a1fbf753b9d
@@ -86,7 +86,7 @@ private
-- Store for each file the current status. This is a cache to avoid sending
-- requests to the VCS.
- procedure Free (X : in out Natural);
+ procedure Free (X : in out Natural) is null;
package File_Hash is new String_Hash (Natural, Free, 1);
use File_Hash.String_Hash_Table;
============================================================
--- vcs/src/vcs_view_api.adb d9e13b17867337c8ed94cadec59d0b38cb66c6bf
+++ vcs/src/vcs_view_api.adb 3f97e5b1663f9b019c5d2ed4f097358d8205b4b6
@@ -826,7 +826,7 @@ package body VCS_View_API is
Via_Log : Boolean := False) is
begin
if Actions (Action) /= null then
- if Via_Log then
+ if Via_Log and Ref.Require_Log then
Gtk_New (Item, Actions (Action).all & (-" (via revision log)"));
else
Gtk_New (Item, Actions (Action).all);
@@ -1064,8 +1064,8 @@ package body VCS_View_API is
end;
else
- Log_Exists := Has_File_Information (Context) and then
- Get_Log_From_File
+ Log_Exists := Has_File_Information (Context)
+ and then Get_Log_From_File
(Kernel, File_Information (Context), False) /= No_File;
Add_Action (Status_Files, On_Menu_Get_Status'Access);
@@ -1128,29 +1128,35 @@ package body VCS_View_API is
On_Menu_Remove_Annotate'Access, Context);
Set_Sensitive (Item, Section_Active);
+
+ Items_Inserted := True;
end if;
- Gtk_New (Item, Label => -"Edit revision log");
- Append (Menu, Item);
- Context_Callback.Connect
- (Item, Gtk.Menu_Item.Signal_Activate,
- On_Menu_Edit_Log'Access, Context);
- Set_Sensitive (Item, Section_Active);
+ if Ref.Require_Log then
+ Gtk_New (Item, Label => -"Edit revision log");
+ Append (Menu, Item);
+ Context_Callback.Connect
+ (Item, Gtk.Menu_Item.Signal_Activate,
+ On_Menu_Edit_Log'Access, Context);
+ Set_Sensitive (Item, Section_Active);
- Gtk_New (Item, Label => -"Edit global ChangeLog");
- Append (Menu, Item);
- Context_Callback.Connect
- (Item, Gtk.Menu_Item.Signal_Activate,
- On_Menu_Edit_ChangeLog'Access, Context);
- Set_Sensitive (Item, Section_Active);
+ Gtk_New (Item, Label => -"Edit global ChangeLog");
+ Append (Menu, Item);
+ Context_Callback.Connect
+ (Item, Gtk.Menu_Item.Signal_Activate,
+ On_Menu_Edit_ChangeLog'Access, Context);
+ Set_Sensitive (Item, Section_Active);
- Gtk_New (Item, Label => -"Remove revision log");
- Append (Menu, Item);
- Context_Callback.Connect
- (Item, Gtk.Menu_Item.Signal_Activate,
- On_Menu_Remove_Log'Access, Context);
- Set_Sensitive (Item, Section_Active);
+ Gtk_New (Item, Label => -"Remove revision log");
+ Append (Menu, Item);
+ Context_Callback.Connect
+ (Item, Gtk.Menu_Item.Signal_Activate,
+ On_Menu_Remove_Log'Access, Context);
+ Set_Sensitive (Item, Section_Active);
+ Items_Inserted := True;
+ end if;
+
Add_Separator;
-- Removed for files inside activities. See previous comments
@@ -2073,6 +2079,7 @@ package body VCS_View_API is
is
Kernel : constant Kernel_Handle := Get_Kernel (Context);
Suffix : constant String := Action_To_Log_Suffix (Action);
+ VCS : constant VCS_Access := Get_Current_Ref (Context);
Real_Files : String_List.List;
Files_Temp : String_List.List_Node;
All_Logs_Exist : Boolean := True;
@@ -2118,33 +2125,35 @@ package body VCS_View_API is
Files_Temp := Next (Files_Temp);
end loop;
- Files_Temp := String_List.First (Real_Files);
+ -- Open log editors for files that don't have a log
- -- Open log editors for files that don't have a log
+ if VCS.Require_Log then
+ Files_Temp := String_List.First (Real_Files);
- while Files_Temp /= String_List.Null_Node loop
- File := Create (Full_Filename => String_List.Data (Files_Temp));
+ while Files_Temp /= String_List.Null_Node loop
+ File := Create (Full_Filename => String_List.Data (Files_Temp));
- if Get_Log_From_File (Kernel, File, False) = GNATCOLL.VFS.No_File then
- Get_Log_From_ChangeLog (Kernel, File, Suffix);
- All_Logs_Exist := False;
+ if Get_Log_From_File (Kernel, File, False)
+ = GNATCOLL.VFS.No_File
+ then
+ Get_Log_From_ChangeLog (Kernel, File, Suffix);
+ All_Logs_Exist := False;
- Open_File_Editor
- (Kernel,
- Get_Log_From_File (Kernel, File, True, Suffix),
- Group => Group_Consoles,
- Initial_Position => Position_Bottom);
- end if;
+ Open_File_Editor
+ (Kernel,
+ Get_Log_From_File (Kernel, File, True, Suffix),
+ Group => Group_Consoles,
+ Initial_Position => Position_Bottom);
+ end if;
- Files_Temp := String_List.Next (Files_Temp);
- end loop;
+ Files_Temp := String_List.Next (Files_Temp);
+ end loop;
+ end if;
-- If All files have a log, commit the whole lot
if All_Logs_Exist then
- Log_Action_Files
- (Kernel, Get_Current_Ref (Context),
- Action, Real_Files, No_Activity);
+ Log_Action_Files (Kernel, VCS, Action, Real_Files, No_Activity);
end if;
String_List.Free (Real_Files);
============================================================
--- widgets/src/gtkada-color_combo.adb 28e21620cfc4e7bf04a1a5613c9644dac40bae70
+++ widgets/src/gtkada-color_combo.adb 51af8410b084808e28d49313584efa031136ee00
@@ -30,14 +30,12 @@ with Glib; use Glib;
with Glib; use Glib;
-with Gtk.Button; use Gtk.Button;
with Gtk.Color_Selection; use Gtk.Color_Selection;
-with Gtk.Frame; use Gtk.Frame;
+with Gtk.Dialog; use Gtk.Dialog;
with Gtk.Handlers; use Gtk.Handlers;
pragma Elaborate_All (Gtk.Handlers);
with Gtk.Object; use Gtk.Object;
with Gtk.Pixmap; use Gtk.Pixmap;
-with Gtk.Toggle_Button; use Gtk.Toggle_Button;
with Gtk.Widget; use Gtk.Widget;
with Gtkada.Handlers; use Gtkada.Handlers;
@@ -46,12 +44,12 @@ package body Gtkada.Color_Combo is
package body Gtkada.Color_Combo is
+ use Gtk.Color_Selection_Dialog;
+
Combo_Class_Record : GObject_Class := Uninitialized_Class;
Combo_Signals : constant chars_ptr_array :=
(1 => New_String (String (Signal_Color_Changed)));
- -- ??? Should implement a destroy callback
-
package Color_Cb is new Gtk.Handlers.Callback (Gtk_Color_Combo_Record);
procedure Color_Selected
@@ -62,9 +60,12 @@ package body Gtkada.Color_Combo is
(Combo : access Gtk_Color_Combo_Record'Class);
-- Redisplay the contents of the button
- procedure Button_Clicked (Combo : access Gtk_Widget_Record'Class);
+ procedure Button_Clicked (Combo : access Gtk_Color_Combo_Record'Class);
-- Called when the button is clicked
+ procedure On_Destroy (Combo : access Gtk_Color_Combo_Record'Class);
+ -- Called when the combo is destroyed
+
-------------
-- Gtk_New --
-------------
@@ -83,7 +84,7 @@ package body Gtkada.Color_Combo is
Signal_Parameters : constant Signal_Parameter_Types :=
(1 => (1 => GType_None));
begin
- Gtk.Extra.Combo_Button.Initialize (Combo);
+ Gtk.Button.Initialize (Combo, "");
Initialize_Class_Record
(Combo,
@@ -92,28 +93,50 @@ package body Gtkada.Color_Combo is
Type_Name => "GtkColorCombo",
Parameters => Signal_Parameters);
- Widget_Callback.Object_Connect
- (Get_Button (Combo), Signal_Clicked,
- Widget_Callback.To_Marshaller (Button_Clicked'Access), Combo);
+ Color_Cb.Connect
+ (Combo, Signal_Clicked,
+ Color_Cb.To_Marshaller (Button_Clicked'Access));
+ Color_Cb.Connect
+ (Combo, Signal_Destroy,
+ Color_Cb.To_Marshaller (On_Destroy'Access));
- Gtk_New (Combo.Selection);
- Add (Get_Frame (Combo), Combo.Selection);
+ Gtk_New (Combo.Selection, "Select a color");
Color_Cb.Object_Connect
- (Combo.Selection, Signal_Color_Changed, Color_Selected'Access, Combo);
+ (Get_Colorsel (Combo.Selection),
+ Signal_Color_Changed, Color_Selected'Access, Combo);
Color_Cb.Connect
(Combo, Signal_Map, Display_Button'Access, After => True);
- Show (Combo.Selection);
end Initialize;
--------------------
-- Button_Clicked --
--------------------
- procedure Button_Clicked (Combo : access Gtk_Widget_Record'Class) is
+ procedure Button_Clicked (Combo : access Gtk_Color_Combo_Record'Class) is
+ Result : Gtk_Response_Type;
+ pragma Unreferenced (Result);
+ Color_Combo : constant Gtk_Color_Combo := Gtk_Color_Combo (Combo);
+ Color : constant Gdk_Color := Color_Combo.Color;
+
begin
- Set_Active (Get_Toggle_Button (Gtk_Color_Combo (Combo)), True);
+ if Run (Color_Combo.Selection) /= Gtk_Response_OK then
+ Color_Combo.Color := Color;
+ Display_Button (Color_Combo);
+ Color_Changed (Color_Combo);
+ end if;
+
+ Hide (Color_Combo.Selection);
end Button_Clicked;
+ ----------------
+ -- On_Destroy --
+ ----------------
+
+ procedure On_Destroy (Combo : access Gtk_Color_Combo_Record'Class) is
+ begin
+ Destroy (Combo.Selection);
+ end On_Destroy;
+
-------------------
-- Color_Changed --
-------------------
@@ -139,7 +162,7 @@ package body Gtkada.Color_Combo is
Green => Gdouble (Green (Combo.Color)) / Gdouble (Gushort'Last),
Blue => Gdouble (Blue (Combo.Color)) / Gdouble (Gushort'Last),
Opacity => 1.0);
- Set_Color (Combo.Selection, Components);
+ Set_Color (Get_Colorsel (Combo.Selection), Components);
Display_Button (Combo);
end Set_Color;
@@ -207,7 +230,7 @@ package body Gtkada.Color_Combo is
Color : Gdk_Color;
Components : Color_Array;
begin
- Get_Color (Combo.Selection, Components);
+ Get_Color (Get_Colorsel (Combo.Selection), Components);
Set_Rgb
(Color,
Gcolor_Int (Components (Red) * Gdouble (Guint16'Last)),
@@ -235,7 +258,7 @@ package body Gtkada.Color_Combo is
return;
end if;
- Pixmap := Gtk_Pixmap (Get_Child (Get_Button (Combo)));
+ Pixmap := Gtk_Pixmap (Get_Child (Combo));
if Pixmap = null then
Create_From_Xpm_D
@@ -247,7 +270,7 @@ package body Gtkada.Color_Combo is
Gtk_New (Pixmap, Val, Mask);
Gdk.Pixmap.Unref (Val);
Gdk.Bitmap.Unref (Mask);
- Add (Get_Button (Combo), Pixmap);
+ Add (Combo, Pixmap);
Show (Pixmap);
end if;
============================================================
--- widgets/src/gtkada-color_combo.ads 2573fb49fdb85a3f75546e04c8e569f9bd09a70a
+++ widgets/src/gtkada-color_combo.ads a9b7726a865bb1ac4db8e5d5f9088b46c542b791
@@ -1,8 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2000-2006 --
--- AdaCore --
+-- Copyright (C) 2000-2008, AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
-- under the terms of the GNU General Public License as published by --
@@ -18,13 +17,13 @@
-- Place - Suite 330, Boston, MA 02111-1307, USA. --
-----------------------------------------------------------------------
-with Gtk.Extra.Combo_Button; use Gtk.Extra.Combo_Button;
with Gdk.Color;
-with Gtk.Color_Selection;
+with Gtk.Button; use Gtk.Button;
+with Gtk.Color_Selection_Dialog;
package Gtkada.Color_Combo is
- type Gtk_Color_Combo_Record is new Gtk_Combo_Button_Record with private;
+ type Gtk_Color_Combo_Record is new Gtk_Button_Record with private;
type Gtk_Color_Combo is access all Gtk_Color_Combo_Record'Class;
procedure Gtk_New (Combo : out Gtk_Color_Combo);
@@ -59,8 +58,8 @@ private
-- Emit the "color_changed" signal.
private
- type Gtk_Color_Combo_Record is new Gtk_Combo_Button_Record with record
+ type Gtk_Color_Combo_Record is new Gtk_Button_Record with record
Color : Gdk.Color.Gdk_Color;
- Selection : Gtk.Color_Selection.Gtk_Color_Selection;
+ Selection : Gtk.Color_Selection_Dialog.Gtk_Color_Selection_Dialog;
end record;
end Gtkada.Color_Combo;
============================================================
--- widgets/src/gtkada-file_selector.adb 0e7ded67948abbc404bdf418d1b19ef878b570a5
+++ widgets/src/gtkada-file_selector.adb 31b59a1e180f3a792f3f0ed5b7ea11fcef504431
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
--- Copyright (C) 2001-2008, AdaCore --
+-- Copyright (C) 2001-2009, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
@@ -569,7 +569,7 @@ package body Gtkada.File_Selector is
Set_Position (File_Selector, Win_Pos_Mouse);
Set_Text
(File_Selector.Selection_Entry,
- Filesystems.Filename_To_UTF8 (Default_Name));
+ Display_Full_Name (Create (Default_Name)));
if File_Pattern /= "" then
declare
@@ -1755,8 +1755,8 @@ package body Gtkada.File_Selector is
Set_Text
(Win.Selection_Entry,
- Filesystems.Filename_To_UTF8
- (Best_Match (1 .. Suffix_Length)));
+ Display_Full_Name
+ (Create (Best_Match (1 .. Suffix_Length))));
Set_Position (Win.Selection_Entry, Gint (Suffix_Length));
end if;
@@ -1766,12 +1766,13 @@ package body Gtkada.File_Selector is
if Suffix_Length > 0 then
Set_Text
(Win.Selection_Entry,
- Filesystems.Filename_To_UTF8
- (Best_Match (1 .. Suffix_Length)));
+ Display_Full_Name
+ (Create (Best_Match (1 .. Suffix_Length))));
Set_Position (Win.Selection_Entry, Gint (Suffix_Length));
- Dir := GNATCOLL.VFS.Sub_Dir (Win.Current_Directory,
- Best_Match (1 .. Suffix_Length));
+ Dir := GNATCOLL.VFS.Sub_Dir
+ (Win.Current_Directory, Best_Match (1 .. Suffix_Length));
+
if Is_Directory (Dir)
and then Win.Current_Directory /= Dir
then