The unified diff between revisions [585b4bfc..] and [cd6af1d0..] is displayed below. It can also be downloaded as a raw diff.
#
#
# delete "docgen2/resources/support/tags.css"
#
# rename "common/src/interactive_consoles.adb"
# to "widgets/src/interactive_consoles.adb"
#
# rename "common/src/interactive_consoles.ads"
# to "widgets/src/interactive_consoles.ads"
#
# add_dir "docgen2/resources/custom"
#
# add_file "docgen2/resources/custom/tags.css"
# content [85968042ad6e12d746598c75362216936cb8cf4c]
#
# add_file "docs/docgen.jpg"
# content [84349a0ca23458abd481d83e07ba4c708861cfeb]
#
# add_file "kernel/src_info/prj_output.adb"
# content [f2c3b2ec75901d1537e9a33a1c2115c1e49edcb9]
#
# add_file "kernel/src_info/prj_output.ads"
# content [a5a5ac47cadd5e26a2d99d92f275af740bf91675]
#
# add_file "share/plug-ins/docgen_base_tags.py"
# content [7d845b5f13803532b882375cce235e2da0fad26e]
#
# add_file "widgets/src/gtkada-terminal.adb"
# content [ca97052bf0ca57d5f6bfea1657f4a61cca7236d8]
#
# add_file "widgets/src/gtkada-terminal.ads"
# content [a39b83112a04905edb17ce0f980354bc073b6d0f]
#
# add_file "widgets/src/gtkada_terminal.c"
# content [73d405501cad70418c4d824473f9c47eecb5b97e]
#
# patch "Makefile.in"
# from [b53cba3efe0609ecdcb2f17cc8900d8ea02ca3dd]
# to [926c975d51b595d7cc15faf69269dc5229c1e9cd]
#
# patch "builder/src/build_command_manager.adb"
# from [99ea69df1614ac0db1a54eb0d160d14d51cdd6be]
# to [18e5d0f9bf1607f6c29f646206cf5ee53156bb38]
#
# patch "builder/src/builder_facility_module-scripts.adb"
# from [245eb44c7cf2c99c440cce0847a232f6ab14f6db]
# to [5baa80afbdbc4a59ed9540c4159fc511b589ab94]
#
# patch "builder/src/builder_facility_module.adb"
# from [18507e087732b067880bb35d4f750855fc203009]
# to [16822bf269d907a443b19f3cb122d46875b1f409]
#
# patch "builder/src/builder_facility_module.ads"
# from [c3f99e6fb9a08a5120fa1bdbc2e3dcf0deb2ab09]
# to [18c359bbc67b371c2e247483f7656398fce347b6]
#
# patch "builder/src/builder_module.adb"
# from [28dff7e565400acc916afde0cd3f1961d770784a]
# to [eb06a97f3f2ffff95dfa394b9082a1dc4143402a]
#
# patch "code_analysis/src/code_analysis_module.adb"
# from [50afeb20706593d439c725257d8c28abb12fe36e]
# to [5b496a4dd378d95fdc76f16988e3baf9da62ee59]
#
# patch "codefix/codefix.gpr"
# from [61159fe3cd9ac7516d56d61590fdab133dd25062]
# to [0f14d955eca65c27776baa578a17e4e484a41bd7]
#
# patch "codefix/src/codefix-error_lists.adb"
# from [54fae03b57ca907ad05c1a36424c76307eb64e84]
# to [c6bbf3214faa0034fbd559cff5e9344e0209292a]
#
# patch "common/common_no_xmlada.gpr.in"
# from [31d91273923875d497e3314a6d497e66f6f60349]
# to [d6ca16289cd45c7bae3f3be870158f85404aac84]
#
# patch "common/common_with_xmlada.gpr.in"
# from [2abaa8e72f4bd1d57e2389a09f9cc1f2f4d624ab]
# to [39569dedb56fcd3f508d8cd4b8b3baf0738340b4]
#
# patch "common/expect/expWinSlaveDbg.c"
# from [3368e463b184640d331cf93d879395a51c23ef10]
# to [cdfe242c295eeb28a48adac463b50f2a51cf6330]
#
# patch "common/expect/expWinSlaveDrv.c"
# from [8083f91b61158ba8c933bb467c874f9e898f0392]
# to [8154f89fb947a84240273726cd8bfc281dd560bb]
#
# patch "common/expect/expWinSlaveKey.c"
# from [7806192da61fff13bae9dd2db05d5a17e0bfda96]
# to [b0092b57e4f632093e04558fdf23af74dfe48fcc]
#
# patch "common/src/ada_analyzer.adb"
# from [e48fb046e6b60294b04084bdce94fe35b28db207]
# to [1110a7630da54fcbc4519f3d16419a1569d9ca7b]
#
# patch "common/src/c_analyzer.adb"
# from [c214a4c0d36664b9e129b21119abc556a922f59b]
# to [28d7e6646cded8ee40f9b0a09c5955d4373eeece]
#
# patch "common/src/gui_utils.adb"
# from [aa2c4530bdbb2c9a6b343a0546c6f64effbd99c4]
# to [da1b7624b0f09aa2848462d64714f6443a2198f1]
#
# patch "common/src/remote_descriptors.adb"
# from [16e78978059a5d6dba0940c99efd84d3fca0c499]
# to [69621d757d0ca95484c9009c7b0d382efb51ee54]
#
# patch "common/src/string_utils.adb"
# from [c1cd13817cd5fc953da9d86b87921da12aead858]
# to [018418c716cf44b345ba75fbe32ba882dc131588]
#
# patch "common/src/string_utils.ads"
# from [95c04b650c4852f43b9cd90c139a4340cb9358d3]
# to [bc0a8037f9a1ad28a01bb0e22fc98b0db8073c79]
#
# patch "common/tty/terminals.c"
# from [432b6d80f244362e914ccaac82b1f1ac951709ad]
# to [24c96c580f380eaca06e33c3d7a8ccbbaa673950]
#
# patch "custom/src/expect_interface.adb"
# from [e2ea51e89ba08a4e0bd7191c4002329bfc2e4a59]
# to [986689b8618ae7dffa267cc673725f3611a2a781]
#
# patch "distrib/.gps_wrapper"
# from [6de489133800c2f03d20eecea997fcbfc0f31362]
# to [310897dc0ed9109095fb7b819b4be212be10cefa]
#
# patch "distrib/features"
# from [955c2600ffb1adf38f2d1d50a1030210e110eab4]
# to [fed18c7ae439ae2f39933a0d060618822c36435d]
#
# patch "distrib/known-problems"
# from [7ba5937d702b36c642620b7bdcc8e50822ff3c12]
# to [3beace0c2593a1bd42fb299aa4695fc326f142bf]
#
# patch "distrib.gpr"
# from [a5e5483531e18c52aa68803aa5f790d983cc436c]
# to [1c4f55d50b5e853ef35cfebdb97fe92a7e7e8205]
#
# patch "docgen2/resources/html.tmpl"
# from [598511d24a2befc57b1658ac2796d4ea4e84d7ab]
# to [6ce4eb875323c71d55cfee366c8cfdafdf904776]
#
# patch "docgen2/src/docgen2-scripts.adb"
# from [1485b25d4a6dd76b2afdb4300a8e7a8839bae511]
# to [8af6e3a38748a5291d5f2bc8eb652f8f75c5265f]
#
# patch "docgen2/src/docgen2-scripts.ads"
# from [b3cd97b3587f8483b61deb316ca20aa0b645d7f2]
# to [f907b6422660660e2304f3b0a45849715750f609]
#
# patch "docgen2/src/docgen2.adb"
# from [e83c0fb526eca842ba8891ceed0337f53e60eb76]
# to [89cb09f74074dd20093ea905450cc256d7f84e24]
#
# patch "docgen2/src/docgen2_backend-html.adb"
# from [dc423c28d3b91f7d617eb94d86701bd34e6cb30b]
# to [60b1acaac089ddd5535b5870406cdf9c4e927f02]
#
# patch "docs/docs.gpr"
# from [7387a9bd2ae78409e99e0dad2ba3bf14dd9a9a72]
# to [efd9e7770f76d7a01be0ec21a19d4e16d2176dd3]
#
# patch "docs/gps.texi"
# from [26da3e6ae8c6041bc584d4d861f322b26e45e402]
# to [1554dec52b7bd9a3fbedd69d91f0f18bd00912e0]
#
# patch "examples/python/doc.py"
# from [e2ca4257668571dbc1fb5aff448662a21b74021c]
# to [02a750afc5a4e2ed87e7edb15441f319744c7ef6]
#
# patch "gnatlib/Makefile"
# from [34afe312b8c27be06ca8c3d4d2fbdb407b2301c5]
# to [598d5ec26f6b261e8c000eb281fe4df44c01fe59]
#
# patch "gnatlib/docs/gnatcoll.texi"
# from [eb8a3ed4a77c455dc2c85e534a5f560971839b11]
# to [422b53945eaf614a48ad68e75da3c7087408ebf7]
#
# patch "gnatlib/src/gnatcoll-filesystem-unix-remote.adb"
# from [a5e52d2ba799b9a1363fd2b280345bfd43d21798]
# to [5a2e1b0f29b9b99a465cde3caf96d21fc23527ca]
#
# patch "gnatlib/src/gnatcoll-filesystem-unix-remote.ads"
# from [89e7a748f80b98056ae0c9ef339de6be83d2a031]
# to [e92c839e1a120205b736f36154a3e3cd82ea3926]
#
# patch "gnatlib/src/gnatcoll-filesystem-unix.adb"
# from [bb844f3bdfd66fd1dca88ce6b2e9b16cdfb58f85]
# to [b472cbf158f534be0eebcc3d4d3e9bd2b1de7264]
#
# patch "gnatlib/src/gnatcoll-filesystem-unix.ads"
# from [ac588d4d4d82f08e0bcf063bc65f2ac5adbd7380]
# to [0295bf56eb941fc0b565e64bb7ac8eba1208a72e]
#
# patch "gnatlib/src/gnatcoll-filesystem-windows-remote.adb"
# from [d9a9a66e8d710466fbc80f2fef78db0a71ad9961]
# to [6a69f842f493751a6623c5c6cbb1006295b63bd0]
#
# patch "gnatlib/src/gnatcoll-filesystem-windows-remote.ads"
# from [d019b0cf109ff74bbef162940441716ebb1395fc]
# to [f5a252d9c27023daa3f7d897836229988e534c8f]
#
# patch "gnatlib/src/gnatcoll-filesystem-windows.adb"
# from [dcb71cbe96193bfd4b41bead7519156c4d1425a3]
# to [59c0949da57ba62d103635a93f7afd0184567e0b]
#
# patch "gnatlib/src/gnatcoll-filesystem-windows.ads"
# from [78b9e7f4f1a5318841a66b622f1407ba0b5ac087]
# to [d3b8167eb5356c9d0b68ec36fae3678b7b1fd473]
#
# patch "gnatlib/src/gnatcoll-filesystem.adb"
# from [bb459f22f09330beba8528c5a953463e0e0ae215]
# to [a2ff624e99969931610a736eab1aeb0e7eb7d231]
#
# patch "gnatlib/src/gnatcoll-filesystem.ads"
# from [e2b0258cd89436015a75866a23d2bb268903c422]
# to [3419b3c38c3ad6f8b80f12ac3d317f12f0a5bbf2]
#
# patch "gnatlib/src/python/gnatcoll-python.adb"
# from [eb9e220f2b0cc73d2ee62fc994f7658e859884b5]
# to [7b06e9c358dea1730fb8b002c62c76afb9430c91]
#
# patch "gnatlib/src/python/gnatcoll-python.ads"
# from [46e371f1eb490324cdfee52fbfcc8d06a476afb5]
# to [631c2291d6ef2b788f10ecb0d37f42c3150fff9d]
#
# patch "gnatlib/src/python/python_support.c"
# from [f8f879897df530a28d05c4d2f3a10b71542d6be2]
# to [fcfa934fb3ca87eb24f68b70a3fb6c86c7d02ba8]
#
# patch "gps/.gnatdebug"
# from [9cedc4ddb69ae73825ca36e7923032129593bbd6]
# to [feef714b94330a9926323d1efc8e1901c388ec2d]
#
# patch "gps/src/gps-main.adb"
# from [b3b788653e6ad03ae412f361374978eba6b5b0cb]
# to [4d84efad3c2c1244bd97ee6d8389959cae1759ca]
#
# patch "gvd/gvd/gvd-consoles.adb"
# from [a95c215f613f48967337308cadd4522aad0d57ff]
# to [afe11fc3c49a9038dfac53790e1ee726d60aae5c]
#
# patch "gvd/gvd/gvd-process.adb"
# from [054d31ca82ce38fd7ab6f6ded94c6212df2abe5c]
# to [3c228d619c188199ea5b31f485bbf045141eeaa2]
#
# patch "gvd/gvd/gvd-trace.adb"
# from [05bba057843039117d2460a2069e126070046fa8]
# to [6246e13e0fb7904e3c79831a792e18925eca1eff]
#
# patch "help/src/help_module-display_help_unix.adb"
# from [6329ae015712981de9430a5c4d0c35a0bc2d7696]
# to [bca2bc766da3838f1edd8286a9420b5a9cc8a267]
#
# patch "help/src/help_module.adb"
# from [d3cb8a8a4cf8842b888b1135555930e7affb5f5f]
# to [d27d961f4f6ec2117211ca7709b51b50c8196ddf]
#
# patch "kernel/src/default_preferences-enums.adb"
# from [262141c3bae291072714788814a1cb12316ad1be]
# to [7ebf60d83bd0196a113c944585a43e8c8a30907a]
#
# patch "kernel/src/gps-kernel-commands.adb"
# from [6e6b88f814f8036be51af27dc56f8ee85d7952f3]
# to [7bfd437bf976537160ff21758f30e6f31740225b]
#
# patch "kernel/src/gps-kernel-commands.ads"
# from [4de1f1a81f9ec6ca52691df39dc8bb61bc195c1c]
# to [703d5959b9351bffa457893f9a5e30f58e5b03da]
#
# patch "kernel/src/gps-kernel-console.adb"
# from [338be9aa173827fadeebb07f44fda6796102f1e3]
# to [a39f76b97d81073600c1eee5a4294ac8962f4136]
#
# patch "kernel/src/gps-kernel-console.ads"
# from [66e32655c79fb2db4a9ba1bc253d7d2f0a91d1eb]
# to [cd361109f6ce0b002d0d38f4bac3f8852b689f81]
#
# patch "kernel/src/gps-kernel-mdi.adb"
# from [26d9ffc4e4f1a8c4b48bed8409584d15a7370a09]
# to [27f5da70c66b0d80426cb59d0673d327c76c9726]
#
# patch "kernel/src/gps-kernel-remote.adb"
# from [aecccf075179014d9e73c0756b9c08d4e2a31dd9]
# to [82ded91952d6d30b71040a8dd7b8c5984de20405]
#
# patch "kernel/src/gps-kernel-scripts.adb"
# from [54725edc030ea815b804a622c3843430d6523555]
# to [00e69ae417f64650636dd19e9ed1bd84aaebfc72]
#
# patch "kernel/src/gps-kernel-timeout.adb"
# from [33eeafd41825cf13583a1cd97c2b875451b9a584]
# to [dabeb91a59860c9e51eeff9ba3c81b4078189593]
#
# patch "kernel/src/gps-kernel-timeout.ads"
# from [9c047242a7031f4e61e9e327ff65d3d960728d0d]
# to [208a4f81b729125ec6d396518855deeb24d335ba]
#
# patch "kernel/src/gps-location_view.adb"
# from [1821403354f5f8a5b840c6ce69b9783cdc89da60]
# to [aa05f430ccf8e3c2682753d8f876a772dd5493b6]
#
# patch "kernel/src/gps-main_window.adb"
# from [7e4e390f7eae936722737be186baf69e0b6ae1f2]
# to [f0741a6347678dadd834fc26fa5f2c966907df85]
#
# patch "kernel/src_info/projects-editor.adb"
# from [5c9fa67023cac9450b9fa73960752c66f545383f]
# to [9f90555b666f34ac2b1368037e78aa6c2a4f9216]
#
# patch "kernel/src_info/projects-registry.adb"
# from [cf68abd7cfc2c0eda82604216c3c3f6c805724e7]
# to [a30cd2e99f63aa8343a548d6f218c878d728099e]
#
# patch "plugins.gpr"
# from [6df1e78475f8d6ffdd5de8e5035d2eda9ccfbd89]
# to [f32dca1280563c9fc411bb539bce9d6339c406a9]
#
# patch "share/default.gpr"
# from [18e238c51de9d4000f4574c9c94c2db474d045f2]
# to [7acb233996eceaa9449a092cc60c0a49c170c0ff]
#
# patch "share/library/ispell.py"
# from [9b42dda01bce94d8ff864ba0150c924351a5b7a3]
# to [190234fb463c6af995513916d9bd3aa14491cba4]
#
# patch "share/library/rectangles.py"
# from [c409f93da0f6fd3c8a512ab2b70a359e24edbdda]
# to [573a0be96c09e77c6caba5046693cfe0ef601ad7]
#
# patch "share/plug-ins/build_modes.xml"
# from [53d41e07f841cc0579cc67a9e6bd1fd51c3b0b83]
# to [78024b088724be9a146448623cd8c5752f44e2cf]
#
# patch "share/plug-ins/gnatpsta.py"
# from [04f8333908787a18a835f14bb711b39a3171fd35]
# to [4f98b4ebc989bf6b8c4fef49e0b8686de0b58bf0]
#
# patch "share/plug-ins/gps_utils/__init__.py"
# from [a8747ff4b888b09f6f10584a05ad3868f38cb658]
# to [c819fdda40eac331f857b016fd71be9e4be11d35]
#
# patch "share/plug-ins/gps_utils/console_process.py"
# from [0266d3172c1bf6eb691894b4c25de5f0f1349a6d]
# to [8ad566d40bd8af62c47575177b729b7315fc381b]
#
# patch "share/plug-ins/shell.py"
# from [19ef3f47c2ef56240c3a8873b398a62a0db69dfb]
# to [54d4c7610955fa377efe256a29e948746296d62c]
#
# patch "share/plug-ins/spark.py"
# from [8ce28f9527f37b8ac1cfd3ee38f4770ef9850fd5]
# to [d0854ffbe3614c1bb14a0804b1f9c958855d95b5]
#
# patch "share/shell_commands.xml"
# from [4308d628a11619d0df704f5010d7ea81eb2685a6]
# to [a94f2e3618b0849079b39e097725e1cc9f75264c]
#
# patch "src_editor/src/completion_module.adb"
# from [165da68871bc0c4a1c804887ad87ab394e2902d5]
# to [c0e1f73f148ca931bb6c5135cdda495f88894c11]
#
# patch "src_editor/src/src_editor_buffer-line_information.adb"
# from [0cc78743c9e86ee580dae376567a0c7dda9a3f1b]
# to [2bfe6548dd0fe5d53c85a3917625d59c37f8ce4b]
#
# patch "src_editor/src/src_editor_buffer-line_information.ads"
# from [bb8ff1549d216778e1e8ec5bdb0ff2284066ed51]
# to [b596666636b20e9cf1e7786b196ce3ce41852aa9]
#
# patch "src_editor/src/src_editor_buffer.adb"
# from [0ad931732ba2c6262892372d201bef14b6477407]
# to [13ee8312173e67ff097d0cd88f2a6fb38c2a5761]
#
# patch "vcs/src/vcs_view-explorer.adb"
# from [8c25a565754a0f6edc6ed6e1000df933357eb523]
# to [03a56dc326c47c9d9e93a8fb53c711ade05c4161]
#
# patch "widgets/src/build_configurations.adb"
# from [2bdb4f5e6448cebdfe943184ffe224b684885224]
# to [d98140566a382f16da642f67755f10b851baf384]
#
# patch "widgets/src/interactive_consoles.adb"
# from [b42fba369a7ac1d219cb42655dc0fc392bbe2fd0]
# to [efeda90feea8f8e66c9e34550c1995f39d1244da]
#
# patch "widgets/src/interactive_consoles.ads"
# from [ee31102d1c58ca7ad274253354c9cc3874875175]
# to [f21e0e9f29743f2774b11ee73794fa1cbdafbf08]
#
# set "docs/docgen.jpg"
# attr "mtn:manual_merge"
# value "true"
#
============================================================
--- docgen2/resources/custom/tags.css 85968042ad6e12d746598c75362216936cb8cf4c
+++ docgen2/resources/custom/tags.css 85968042ad6e12d746598c75362216936cb8cf4c
@@ -0,0 +1,43 @@
+div.summary:before
+{
+ content: "Summary: ";
+ font-weight: bold;
+}
+div.summary
+{
+ border-bottom: 1px dotted #e0e0e0;
+}
+
+div.description:before
+{
+ content: "Description: ";
+ font-weight: bold;
+}
+div.description
+{
+ font-style: italic;
+ border-bottom: 1px dotted #e0e0e0;
+}
+
+div.parameter *
+{
+ font-style: italic;
+ color: #444;
+ display: inline;
+}
+
+div.exception:before
+{
+ content: "Exception: ";
+ font-weight: bold;
+}
+
+div.seealso:before
+{
+ content: "See also: ";
+ font-weight: bold;
+}
+div.seealso
+{
+ font-style: italic;
+}
============================================================
# docs/docgen.jpg is binary
============================================================
--- kernel/src_info/prj_output.adb f2c3b2ec75901d1537e9a33a1c2115c1e49edcb9
+++ kernel/src_info/prj_output.adb f2c3b2ec75901d1537e9a33a1c2115c1e49edcb9
@@ -0,0 +1,62 @@
+-----------------------------------------------------------------------
+-- 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 Output; use Output;
+
+package body Prj_Output is
+
+ Default_Output_Proc : Output.Output_Proc := null;
+
+ --------------------------------
+ -- Set_Default_Output_Handler --
+ --------------------------------
+
+ procedure Set_Default_Output_Handler
+ (P : Output.Output_Proc)
+ is
+ begin
+ Default_Output_Proc := P;
+ Output.Set_Special_Output (P);
+ end Set_Default_Output_Handler;
+
+ ------------------------
+ -- Set_Special_Output --
+ ------------------------
+
+ procedure Set_Special_Output
+ (P : Output.Output_Proc)
+ is
+ begin
+ if P = null then
+ Output.Set_Special_Output (Default_Output_Proc);
+ else
+ Output.Set_Special_Output (P);
+ end if;
+ end Set_Special_Output;
+
+ ---------------------------
+ -- Cancel_Special_Output --
+ ---------------------------
+
+ procedure Cancel_Special_Output is
+ begin
+ Output.Set_Special_Output (Default_Output_Proc);
+ end Cancel_Special_Output;
+
+end Prj_Output;
============================================================
--- kernel/src_info/prj_output.ads a5a5ac47cadd5e26a2d99d92f275af740bf91675
+++ kernel/src_info/prj_output.ads a5a5ac47cadd5e26a2d99d92f275af740bf91675
@@ -0,0 +1,42 @@
+-----------------------------------------------------------------------
+-- 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 package controls the Output procedures handling, used by Prj.*
+-- packages when displaying errors or information while loading/updating a
+-- project.
+
+with Output;
+
+package Prj_Output is
+
+ procedure Set_Default_Output_Handler
+ (P : Output.Output_Proc);
+ -- Set P as the default output handler. If P is null, this removes the
+ -- default handler.
+
+ procedure Set_Special_Output
+ (P : Output.Output_Proc);
+ -- Set P as a temporary output handler. Setting P to null is equivalent to
+ -- calling Cancel_Special_Output.
+
+ procedure Cancel_Special_Output;
+ -- Removes the temporary output handler, and restores the default one, as
+ -- previously set by Set_Default_Output_Handler.
+
+end Prj_Output;
============================================================
--- share/plug-ins/docgen_base_tags.py 7d845b5f13803532b882375cce235e2da0fad26e
+++ share/plug-ins/docgen_base_tags.py 7d845b5f13803532b882375cce235e2da0fad26e
@@ -0,0 +1,98 @@
+"""
+Handling of documentation tags. This script can be used as is or as a basis for
+ your own documentation tags.
+
+The list of custom tags is:
+- description
+- summary
+- parameter (attribute "name" is expected)
+- exception
+- seealso
+- c_version
+- group (this builds a custom index from all <group>A Group</group> tags)
+
+"""
+
+import GPS, re, os
+
+class ParameterTagHandler (GPS.DocgenTagHandler):
+ """Handling for <parameter name="param">Description of the paramter</parameter>"""
+ def __init__ (self):
+ GPS.DocgenTagHandler.__init__ (self, "parameter", on_match = self.on_match)
+
+ def on_match (self, docgen, attrs, value, entity_name, entity_href):
+ res = re.split ('name=\"([^"]*)\"', attrs)
+ if len (res) > 1:
+ return """<div class="parameter"><span class="name">%s:</span> %s</div>""" % (res[1], value)
+ else:
+ return """<div class="parameter" %s>%s</div>""" % (attrs, value)
+
+class CVersionTagHandler (GPS.DocgenTagHandler):
+ """Handling for <c_version>xx.yy</c_version>"""
+ def __init__ (self):
+ GPS.DocgenTagHandler.__init__ (self, "c_version", on_match = self.on_match)
+
+ def on_match (self, docgen, attrs, value, entity_name, entity_href):
+ return """<p>Binding from C File version <b>%s</b></p>""" % (value)
+
+class GroupTagHandler (GPS.DocgenTagHandler):
+ """Handling for <group>A Group of packages</group>"""
+ def __init__ (self):
+ GPS.DocgenTagHandler.__init__ \
+ (self, "group",
+ on_match=self.on_match,
+ on_start=self.on_start,
+ on_exit=self.on_exit)
+ self.groups = {}
+
+ def on_start (self, docgen):
+ self.groups = {}
+
+ def on_match (self, docgen, attrs, value, entity_name, entity_href):
+ if not self.groups.has_key (value):
+ self.groups[value] = []
+ self.groups[value].append ("""<a href="%s">%s</a>""" % (entity_href,entity_name));
+ return " "
+
+ def on_exit (self, docgen):
+ if len (self.groups) == 0:
+ return
+
+ # first print the right-side box containing the group index
+ content=""
+ content += """<div class='default' id='rightSide'>"""
+ content += """<div id='rightSideInside'>"""
+ content += """<div id='Index'>"""
+ content += """<h2>Index</h2>"""
+ content += """<ul>"""
+ n = 0
+ for group in sorted(self.groups.keys()):
+ content += """<li><a href="#%d">%s</a></li>""" % (n, group)
+ n += 1
+ content += """</ul></div></div></div>"""
+
+ content += """<div class="title">Package Groups</div>"""
+ n = 0
+ for group in sorted(self.groups.keys()):
+ content += """<p><a name="%d"></a><h1>%s</h1>\n""" % (n, group)
+ n += 1
+ for href in sorted(self.groups[group]):
+ content += "%s<br/>\n" % (href)
+ content += "</p>\n"
+
+ if content != "":
+ docgen.generate_index_file ("Package groups", "groups.html", content);
+
+def on_gps_start (hook):
+ # use default tag handling for description, summary, exception and seealso
+ GPS.Docgen.register_css (GPS.get_system_dir() + "share/gps/docgen2/custom/tags.css");
+ GPS.Docgen.register_tag_handler (GPS.DocgenTagHandler ("description"))
+ GPS.Docgen.register_tag_handler (GPS.DocgenTagHandler ("summary"))
+ GPS.Docgen.register_tag_handler (GPS.DocgenTagHandler ("exception"))
+ GPS.Docgen.register_tag_handler (GPS.DocgenTagHandler ("seealso"))
+ # register <parameter>, <c_version> and <group> tags.
+ GPS.Docgen.register_tag_handler (ParameterTagHandler ())
+ GPS.Docgen.register_tag_handler (CVersionTagHandler ())
+ GPS.Docgen.register_tag_handler (GroupTagHandler ())
+
+GPS.Hook ("gps_started").add (on_gps_start)
============================================================
--- widgets/src/gtkada-terminal.adb ca97052bf0ca57d5f6bfea1657f4a61cca7236d8
+++ widgets/src/gtkada-terminal.adb ca97052bf0ca57d5f6bfea1657f4a61cca7236d8
@@ -0,0 +1,1543 @@
+-----------------------------------------------------------------------
+-- GtkAda - Ada95 binding for Gtk+/Gnome --
+-- --
+-- Copyright (C) 2008-2008, AdaCore --
+-- --
+-- This library 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 library 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. --
+-- --
+-- As a special exception, if other files instantiate generics from --
+-- this unit, or you link this unit with other files to produce an --
+-- executable, this unit does not by itself cause the resulting --
+-- executable to be covered by the GNU General Public License. This --
+-- exception does not however invalidate any other reasons why the --
+-- executable file might be covered by the GNU Public License. --
+-----------------------------------------------------------------------
+
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Glib; use Glib;
+with Glib.Object; use Glib.Object;
+with Glib.Properties; use Glib.Properties;
+with Glib.Unicode; use Glib.Unicode;
+with Gtk.Text_Buffer; use Gtk.Text_Buffer;
+with Gtk.Text_Iter; use Gtk.Text_Iter;
+with Gtk.Text_Mark; use Gtk.Text_Mark;
+with Gtk.Text_Tag; use Gtk.Text_Tag;
+with Gtk.Text_Tag_Table; use Gtk.Text_Tag_Table;
+with Gtk.Widget; use Gtk.Widget;
+with Pango.Enums; use Pango.Enums;
+with Interfaces.C.Strings; use Interfaces.C, Interfaces.C.Strings;
+with System; use System;
+with GNATCOLL.Traces; use GNATCOLL.Traces;
+
+package body Gtkada.Terminal is
+ Me : constant Trace_Handle := Create ("TERM", Off);
+
+ type c_char_array is array (size_t) of char;
+ for c_char_array'Component_Size use CHAR_BIT;
+
+ type c_char_array_access is access c_char_array;
+
+ function UC is new Ada.Unchecked_Conversion
+ (System.Address, c_char_array_access);
+
+ type Insert_Callback is access procedure
+ (Widget : System.Address;
+ Pos : access Gtk.Text_Iter.Gtk_Text_Iter;
+ Text : System.Address;
+ Length : Gint);
+ pragma Convention (C, Insert_Callback);
+
+ type Capability is
+ (Self_Insert,
+ Do_Nothing,
+ Beginning_Of_Line,
+ Insert_Lines, -- "AL"
+ Delete_Chars, -- "DC"
+ End_Alternative_Charset, -- "ae"
+ Start_Alternative_Charset, -- "as"
+ Delete_Lines, -- "DL"
+ Cursor_Down, -- "DO"
+ Cursor_Down_Multiple,
+ Insert_Chars, -- "IC"
+ Keypad_Center_Key, -- "K2"
+ Cursor_Left,
+ Cursor_Left_Multiple, -- "LE"
+ Cursor_Right_Multiple, -- "RI"
+ Normal_Scroll, -- "SF"
+ Scroll_Back, -- "SR"
+ Cursor_Up_Multiple, -- "UP"
+ Insert_One_Line, -- "al"
+ Audio_Bell, -- "bl"
+ Move_To_Prev_Tab, -- "bt"
+ Clear_To_End_Of_Screen, -- "cd"
+ Clear_To_End_Of_Line, -- "ce"
+ Clear_Screen_And_Home, -- "cl"
+ Move_Cursor, -- "cm"
+ Newline, -- "sf"
+ Scroll_Region, -- "cs"
+ Clear_Tabs, -- "ct"
+ Delete_One_Char, -- "dc"
+ Delete_One_Line, -- "dl"
+ Erase_Chars_At_Cursor, -- "ec"
+ End_Insert_Mode, -- "ei"
+ Cursor_Home, -- "ho"
+ Begin_Insert_Mode, -- "im"
+ Initialize_String, -- "is"
+ Function_1, -- "k1"
+ Function_2, -- "k2"
+ Function_3, -- "k3"
+ Function_4, -- "k4"
+ Function_5, -- "k5"
+ Function_6, -- "k6"
+ Function_7, -- "k7"
+ Function_8, -- "k8"
+ Function_9, -- "k9"
+ Key_For_Delete_Char, -- "kD"
+ Key_Insert_Mode, -- "kI"
+ Key_Next_Page, -- "kN"
+ Key_Prev_Page, -- "kP"
+ Key_Cursor_Down, -- "kd"
+ Turn_Keypad_Off, -- "ke"
+ Key_Cursor_Home, -- "kh"
+ Key_Cursor_Left, -- "kl"
+ Key_Cursor_Right, -- "kr"
+ Turn_Keypad_On, -- "ks"
+ Key_Cursor_Up, -- "ku"
+ Start_Blinking, -- "mb"
+ Start_Bold_Mode, -- "md"
+ End_All_Modes, -- "me"
+ Meta_Mode_On, -- "mm"
+ Meta_Mode_Off, -- "mo"
+ Start_Reverse_Mode, -- "mr"
+ Cursor_Right, -- "nd"
+ Restore_Saved_Position, -- "rc"
+ Save_Position, -- "sc"
+ End_Standout_Mode, -- "se"
+ Start_Standout_Mode, -- "so"
+ Reverse_Scroll, -- "sr"
+ Set_Tabulator_Stop, -- "st"
+ End_Program_Using_Cursor, -- "te"
+ Begin_Program_Using_Cursor, -- "ti"
+ End_Underlining, -- "ue"
+ Cursor_Up, -- "up"
+ Start_Underlining, -- "us"
+ Visible_Bell, -- "vb"
+ Normal_Cursor_Visible, -- "ve"
+ Cursor_Invisible, -- "vi"
+ Standout_Cursor, -- "vs"
+ Memory_Unlock,
+ Memory_Lock,
+ Enable_Line_Wrap,
+ Disable_Line_Wrap,
+ Set_Char_Attribute,
+ Display_In_Status_Line);
+
+ type FSM_State is record
+ Callback : Capability;
+
+ Any_Number : FSM_Transition_Access;
+ -- State reached after reading a %d. If set, this will not check for
+ -- '0' .. '9' entries in Transitions table
+
+ String_Stopper : char := char'Val (127);
+ -- If this is set to a value other than 127, start reading a whole
+ -- string until String_Stopper is encountered. The string read acts as
+ -- an argument to the capability. When the end of the string is reached,
+ -- Capability is executed.
+ -- eg/ a%sb
+ -- FSM.Transitions ('a') :=
+ -- (string_stopped := 'b',
+ -- Callback := ...)
+
+ Transitions : FSM_Transition_Access;
+ end record;
+ pragma Pack (FSM_State);
+ Null_State : constant FSM_State :=
+ (Self_Insert, null, char'Val (127), null);
+ subtype Escape_Chars is char range nul .. char'Val (127);
+ type FSM_Transition is array (Escape_Chars) of FSM_State;
+
+ type GtkAda_Terminal_Class is record
+ C_Class : GObject_Class := Uninitialized_Class;
+ Default_Insert_Callback : Insert_Callback := null;
+ end record;
+ Class : GtkAda_Terminal_Class;
+
+ Alternate_Charset : array (Character) of Gunichar :=
+ ('+' => 16#2192#, -- arrow pointing right
+ ',' => 16#2190#, -- arrow pointing left
+ '-' => 16#2191#, -- arrow pointing up
+ '.' => 16#2193#, -- arrow pointing down
+ '0' => 16#2588#, -- solid square block
+ '`' => 16#25C6#, -- diamond
+ 'a' => 16#2592#, -- checker board (stipples)
+ 'b' => 16#2409#, -- HT symbol
+ 'c' => 16#240C#, -- FF symbol
+ 'd' => 16#240D#, -- CR symbol
+ 'e' => 16#240A#, -- LF symbol
+ 'f' => 16#00B0#, -- degree symbol
+ 'g' => 16#00B1#, -- plus/minus
+ 'h' => 16#2424#, -- board of squares
+ 'i' => 16#240B#, -- lantern symbol
+ 'j' => 16#2518#, -- lower right corner
+ 'k' => 16#2510#, -- upper right corner
+ 'l' => 16#250C#, -- upper left corner
+ 'm' => 16#2514#, -- lower left corner
+ 'n' => 16#253C#, -- large plus or crossover
+ 'o' => 16#23BA#, -- scan line 1
+ 'p' => 16#23BB#, -- scan line 3
+ 'q' => 16#2500#, -- horizontal line
+ 'r' => 16#23BC#, -- scan line 7
+ 's' => 16#23BD#, -- scan line 9
+ 't' => 16#251C#, -- tee pointing right
+ 'u' => 16#2524#, -- tee pointing left
+ 'v' => 16#2534#, -- tee pointing up
+ 'w' => 16#252C#, -- tee pointing down
+ 'x' => 16#2502#, -- vertical line
+ 'y' => 16#2264#, -- less-than-or-equal-to
+ 'z' => 16#2265#, -- greater-than-or-equal-to
+ '{' => 16#03C0#, -- greek pi
+ '|' => 16#2260#, -- not-equal
+ '}' => 16#00A3#, -- UK pound sign
+ '~' => 16#00B7#, -- bullet
+ others => 0
+ );
+ -- Translates one set of characters into unicode. This is the alternate
+ -- charset mode used by terminals to display graphical 8bit characters
+
+ procedure On_Insert_Text
+ (Widget : System.Address;
+ Iter : access Gtk.Text_Iter.Gtk_Text_Iter;
+ Text : System.Address;
+ Length : Gint);
+ pragma Convention (C, On_Insert_Text);
+ -- Callback to insert text in the buffer. This replaces the predefined
+ -- version in the gtk+ source code
+
+ procedure Add_Sequence
+ (FSM : in out FSM_Transition_Access;
+ Sequence : String;
+ Func : Capability);
+ -- Add an extra sequence to a finite state machine
+
+ procedure Free (FSM : in out FSM_Transition_Access);
+ -- Free memory used by FSM (recursively)
+
+ function Parse_Xterm_Termcap return FSM_Transition_Access;
+ -- Create a state machine to analyze an xterm's escape sequences
+
+ procedure On_Destroy (Data : System.Address; Self : System.Address);
+ pragma Convention (C, On_Destroy);
+ -- The terminal is being destroyed, reclaim memory
+
+ procedure On_Move_Cursor_Left
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ Count : Positive);
+ procedure On_Move_Cursor_Right
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ Count : Natural);
+ procedure On_Move_Cursor_Up
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ Count : Natural;
+ Preserve_Column : Boolean);
+ procedure On_Move_Cursor_Down
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ Count : Natural;
+ Preserve_Column : Boolean);
+ procedure On_Set_Attribute
+ (Term : access Gtkada_Terminal_Record'Class;
+ Ansi : Integer);
+ procedure On_Clear_Screen_And_Home
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk_Text_Iter);
+ procedure On_Clear_To_End_Of_Screen
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk_Text_Iter);
+ procedure On_Clear_To_End_Of_Line
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk_Text_Iter);
+ procedure On_Newline
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk_Text_Iter);
+ procedure On_Move_Cursor
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk_Text_Iter;
+ Line : Integer;
+ Column : Integer);
+ -- Callbacks for various capabilities
+
+ procedure End_All_Modes (Term : access Gtkada_Terminal_Record'Class);
+ -- Terminates all special highlighting modes and colors
+
+ procedure Set_Col_In_Line
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk_Text_Iter;
+ Col : Gint);
+ -- Set the cursor onto a specific column in its current line
+
+ procedure Default_Insert
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ S : String;
+ Overwrite_Mode : Boolean := True);
+ procedure Default_Insert
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ S : System.Address;
+ Length : Gint;
+ Overwrite_Mode : Boolean := True);
+ -- Insert a string using the default insert method of GtkTextBuffer,
+ -- bypassing our own handler for terminals
+
+ ----------
+ -- Free --
+ ----------
+
+ procedure Free (FSM : in out FSM_Transition_Access) is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (FSM_Transition, FSM_Transition_Access);
+ begin
+ if FSM /= null then
+ for S in FSM'Range loop
+ if FSM (S).Any_Number /= null then
+ Free (FSM (S).Any_Number);
+ end if;
+
+ if FSM (S).Transitions /= null then
+ Free (FSM (S).Transitions);
+ end if;
+ end loop;
+
+ Unchecked_Free (FSM);
+ end if;
+ end Free;
+
+ ------------------
+ -- Add_Sequence --
+ ------------------
+
+ procedure Add_Sequence
+ (FSM : in out FSM_Transition_Access;
+ Sequence : String;
+ Func : Capability) is
+ begin
+ if FSM = null then
+ FSM := new FSM_Transition'(others => Null_State);
+ end if;
+
+ Assert (Me,
+ char (Sequence (Sequence'First)) in Escape_Chars,
+ "Invalid sequence: " & Sequence);
+
+ if Sequence'Length = 1 then
+ FSM (char (Sequence (Sequence'First))).Callback := Func;
+ else
+ -- If the current char is followed by any string
+
+ if Sequence'Length >= 4
+ and then Sequence (Sequence'First + 1) = '%'
+ and then Sequence (Sequence'First + 2) = 's'
+ then
+ FSM (char (Sequence (Sequence'First))).Callback := Func;
+ FSM (char (Sequence (Sequence'First))).String_Stopper :=
+ char (Sequence (Sequence'First + 3));
+
+ -- If the current char can be followed by any digit
+
+ elsif Sequence'Length >= 3
+ and then Sequence (Sequence'First + 1) = '%'
+ and then Sequence (Sequence'First + 2) = 'd'
+ then
+ Add_Sequence (FSM (char (Sequence (Sequence'First))).Any_Number,
+ Sequence (Sequence'First + 3 .. Sequence'Last),
+ Func);
+
+ else
+ Add_Sequence (FSM (char (Sequence (Sequence'First))).Transitions,
+ Sequence (Sequence'First + 1 .. Sequence'Last),
+ Func);
+ end if;
+ end if;
+ end Add_Sequence;
+
+ -------------------------
+ -- Parse_Xterm_Termcap --
+ -------------------------
+
+ function Parse_Xterm_Termcap return FSM_Transition_Access is
+ FSM : FSM_Transition_Access;
+ begin
+ -- The following are ANSI sequences which seem to work fine
+ Add_Sequence (FSM, ASCII.ESC & "[u", Restore_Saved_Position);
+ Add_Sequence (FSM, ASCII.ESC & "[s", Save_Position);
+ Add_Sequence (FSM, ASCII.ESC & "[%d;%dH", Move_Cursor);
+ Add_Sequence (FSM, ASCII.ESC & "[H", Cursor_Home);
+ Add_Sequence (FSM, ASCII.ESC & "[%d;%df", Move_Cursor);
+ Add_Sequence (FSM, ASCII.ESC & "[%dm", Set_Char_Attribute);
+ Add_Sequence (FSM, ASCII.ESC & "[%d;%dm", Set_Char_Attribute);
+ Add_Sequence (FSM, ASCII.ESC & "[%dD", Cursor_Left_Multiple);
+ Add_Sequence (FSM, ASCII.ESC & "[D", Cursor_Left);
+ Add_Sequence (FSM, ASCII.ESC & "[%dC", Cursor_Right_Multiple);
+ Add_Sequence (FSM, ASCII.ESC & "[C", Cursor_Right);
+ Add_Sequence (FSM, ASCII.ESC & "[%dA", Cursor_Up_Multiple);
+ Add_Sequence (FSM, ASCII.ESC & "[A", Cursor_Up);
+ Add_Sequence (FSM, ASCII.ESC & "[%dB", Cursor_Down_Multiple);
+ Add_Sequence (FSM, ASCII.ESC & "[B", Cursor_Down);
+ Add_Sequence (FSM, ASCII.ESC & "[2J", Clear_Screen_And_Home);
+ Add_Sequence (FSM, ASCII.ESC & "]0;%s" & ASCII.BEL,
+ Display_In_Status_Line);
+ Add_Sequence (FSM, ASCII.LF & "", Newline);
+ Add_Sequence (FSM, ASCII.CR & "", Beginning_Of_Line);
+ Add_Sequence (FSM, ASCII.BS & "", Cursor_Left);
+ Add_Sequence (FSM, ASCII.BEL & "", Do_Nothing);
+ Add_Sequence (FSM, ASCII.ESC & "[J", Clear_To_End_Of_Screen);
+ Add_Sequence (FSM, ASCII.ESC & "[K", Clear_To_End_Of_Line);
+ Add_Sequence (FSM, ASCII.ESC & "[27m", End_Standout_Mode);
+ Add_Sequence (FSM, ASCII.ESC & "[24m", End_Underlining);
+ Add_Sequence (FSM, ASCII.ESC & "[7h", Enable_Line_Wrap);
+ Add_Sequence (FSM, ASCII.ESC & "[7l", Disable_Line_Wrap);
+ Add_Sequence (FSM, ASCII.ESC & "[%d;%dr", Scroll_Region);
+
+ Add_Sequence (FSM, ASCII.ESC & "[?1h"
+ & ASCII.ESC & "=", Turn_Keypad_On);
+
+ -- These are sequences from termcap entries, but some of them seem
+ -- incorrect
+
+ Add_Sequence (FSM, ASCII.ESC & "(0", Start_Alternative_Charset);
+ Add_Sequence (FSM, ASCII.ESC & "(B", End_Alternative_Charset);
+
+ -- Sequences used by vi
+
+ Add_Sequence (FSM, ASCII.ESC & "[>c", Do_Nothing); -- ??? What is this
+ Add_Sequence (FSM, ASCII.ESC & "[?12l", Do_Nothing); -- ??? What is this
+ Add_Sequence (FSM, ASCII.ESC & "[?1h" & ASCII.ESC & "=", Turn_Keypad_On);
+ Add_Sequence (FSM, ASCII.ESC & "[?1049l", End_Program_Using_Cursor);
+ Add_Sequence (FSM, ASCII.ESC & "[?1049h", Begin_Program_Using_Cursor);
+ Add_Sequence (FSM, ASCII.ESC & "[?25h", Normal_Cursor_Visible);
+ Add_Sequence (FSM, ASCII.ESC & "[?25l", Cursor_Invisible);
+ Add_Sequence (FSM, ASCII.ESC & "[?12;25h", Standout_Cursor);
+ Add_Sequence (FSM, ASCII.ESC & "[?1034h", Meta_Mode_On);
+ Add_Sequence (FSM, ASCII.ESC & "[?1034l", Meta_Mode_Off);
+
+ Add_Sequence (FSM, ASCII.ESC & "[%dL", Insert_Lines);
+ Add_Sequence (FSM, ASCII.ESC & "[%dP", Delete_Chars);
+ Add_Sequence (FSM, ASCII.ESC & "[%dM", Delete_Lines);
+ Add_Sequence (FSM, ASCII.ESC & "[%d@", Insert_Chars);
+ Add_Sequence (FSM, ASCII.ESC & "OE", Keypad_Center_Key);
+ Add_Sequence (FSM, ASCII.ESC & "[%dS", Normal_Scroll);
+ Add_Sequence (FSM, ASCII.ESC & "[%dT", Scroll_Back);
+ Add_Sequence (FSM, ASCII.ESC & "[L", Insert_One_Line);
+ Add_Sequence (FSM, ASCII.BEL & "", Audio_Bell);
+ Add_Sequence (FSM, ASCII.ESC & "[Z", Move_To_Prev_Tab);
+ Add_Sequence (FSM, ASCII.ESC & "[3g", Clear_Tabs);
+ Add_Sequence (FSM, ASCII.ESC & "[P", Delete_One_Char);
+ Add_Sequence (FSM, ASCII.ESC & "[M", Delete_One_Line);
+ Add_Sequence (FSM, ASCII.ESC & "[%dX", Erase_Chars_At_Cursor);
+ Add_Sequence (FSM, ASCII.ESC & "[4l", End_Insert_Mode);
+ Add_Sequence (FSM, ASCII.ESC & "[4h", Begin_Insert_Mode);
+ Add_Sequence (FSM, ASCII.ESC & "OP", Function_1);
+ Add_Sequence (FSM, ASCII.ESC & "OQ", Function_2);
+ Add_Sequence (FSM, ASCII.ESC & "OR", Function_3);
+ Add_Sequence (FSM, ASCII.ESC & "OS", Function_4);
+ Add_Sequence (FSM, ASCII.ESC & "[15~", Function_5);
+ Add_Sequence (FSM, ASCII.ESC & "[17~", Function_6);
+ Add_Sequence (FSM, ASCII.ESC & "[18~", Function_7);
+ Add_Sequence (FSM, ASCII.ESC & "[19~", Function_8);
+ Add_Sequence (FSM, ASCII.ESC & "[20~", Function_9);
+ Add_Sequence (FSM, ASCII.ESC & "[3~", Key_For_Delete_Char);
+ Add_Sequence (FSM, ASCII.ESC & "[2~", Key_Insert_Mode);
+ Add_Sequence (FSM, ASCII.ESC & "[6~", Key_Next_Page);
+ Add_Sequence (FSM, ASCII.ESC & "[5~", Key_Prev_Page);
+ Add_Sequence (FSM, ASCII.ESC & "OB", Key_Cursor_Down);
+ Add_Sequence (FSM, ASCII.ESC & "[?1l"
+ & ASCII.ESC & ">", Turn_Keypad_Off);
+ Add_Sequence (FSM, ASCII.ESC & "OH", Key_Cursor_Home);
+ Add_Sequence (FSM, ASCII.ESC & "OD", Key_Cursor_Left);
+ Add_Sequence (FSM, ASCII.ESC & "OC", Key_Cursor_Right);
+ Add_Sequence (FSM, ASCII.ESC & "OA", Key_Cursor_Up);
+ Add_Sequence (FSM, ASCII.ESC & "[5m", Start_Blinking);
+ Add_Sequence (FSM, ASCII.ESC & "[1m", Start_Bold_Mode);
+ Add_Sequence (FSM, ASCII.ESC & "[0m", End_All_Modes);
+ Add_Sequence (FSM, ASCII.ESC & "[7m", Start_Reverse_Mode);
+ Add_Sequence (FSM, ASCII.ESC & "[C", Cursor_Right);
+ Add_Sequence (FSM, ASCII.ESC & "[7m", Start_Standout_Mode);
+ Add_Sequence (FSM, ASCII.ESC & "M", Reverse_Scroll);
+ Add_Sequence (FSM, ASCII.ESC & "H", Set_Tabulator_Stop);
+ Add_Sequence (FSM, ASCII.ESC & "[A", Cursor_Up);
+ Add_Sequence (FSM, ASCII.ESC & "[4m", Start_Underlining);
+ Add_Sequence (FSM, ASCII.ESC & "[?5h"
+ & ASCII.ESC & "[?51", Visible_Bell);
+
+ Add_Sequence (FSM, ASCII.ESC & "[l", Memory_Lock);
+ Add_Sequence (FSM, ASCII.ESC & "[m", Memory_Unlock);
+
+ -- No meaning in GUI mode (?)
+ -- do=^J Cursor down one line
+ -- sf=^J Normal scroll one line
+ -- ta=^I Move to next hardware tab
+
+ return FSM;
+ end Parse_Xterm_Termcap;
+
+ ------------------
+ -- On_Set_Title --
+ ------------------
+
+ procedure On_Set_Title
+ (Term : access Gtkada_Terminal_Record;
+ Title : String)
+ is
+ pragma Unreferenced (Term);
+ begin
+ Trace (Me, "Set_Title: " & Title);
+ end On_Set_Title;
+
+ ------------------
+ -- Place_Cursor --
+ ------------------
+
+ overriding procedure Place_Cursor
+ (Self : access Gtkada_Terminal_Record;
+ Where : Gtk.Text_Iter.Gtk_Text_Iter)
+ is
+ begin
+ if Self.Cursor_Mark /= null then
+ Move_Mark (Self, Self.Cursor_Mark, Where);
+ end if;
+
+ Gtk.Text_Buffer.Place_Cursor
+ (Gtk_Text_Buffer_Record (Self.all)'Access, Where);
+ end Place_Cursor;
+
+ -------------------------
+ -- On_Move_Cursor_Left --
+ -------------------------
+
+ procedure On_Move_Cursor_Left
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ Count : Positive)
+ is
+ Success : Boolean;
+ pragma Unreferenced (Success);
+ begin
+ Backward_Chars (Iter, Count => Gint (Count), Result => Success);
+ Place_Cursor (Term, Iter);
+ end On_Move_Cursor_Left;
+
+ ---------------------
+ -- Set_Col_In_Line --
+ ---------------------
+
+ procedure Set_Col_In_Line
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk_Text_Iter;
+ Col : Gint)
+ is
+ begin
+ if Get_Line_Offset (Iter) > Col then
+ On_Move_Cursor_Left
+ (Term, Iter, Integer (Get_Line_Offset (Iter) - Col));
+ elsif Get_Line_Offset (Iter) < Col then
+ On_Move_Cursor_Right
+ (Term, Iter, Integer (Col - Get_Line_Offset (Iter)));
+ else
+ Place_Cursor (Term, Iter);
+ end if;
+ end Set_Col_In_Line;
+
+ --------------------------
+ -- On_Move_Cursor_Right --
+ --------------------------
+
+ procedure On_Move_Cursor_Right
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ Count : Natural)
+ is
+ Line_Chars : Gint := Get_Chars_In_Line (Iter);
+ -- Number of chars in current line, including trailing '\n' if any
+
+ Offset : constant Gint := Get_Line_Offset (Iter);
+ -- Offset in current line, starting at 0
+
+ Iter2 : Gtk_Text_Iter;
+ Success : Boolean;
+
+ begin
+ -- One small difficulty here: if the line does not contain enough
+ -- characters, gtk+ will not move the cursor. But a terminal should
+ -- behave as if it always had a character at any of its position, so we
+ -- need to create them on the fly
+
+ if Count /= 0 then
+ Copy (Source => Iter, Dest => Iter2);
+ if not Ends_Line (Iter2) then
+ Forward_To_Line_End (Iter2, Success);
+ end if;
+
+ if Get_Offset (Iter) + Gint (Count) > Get_Offset (Iter2) then
+ if Line_Chars /= Offset then
+ Line_Chars := Line_Chars - 1;
+ end if;
+
+ declare
+ S : aliased constant
+ String (1 .. Integer
+ (Get_Offset (Iter) + Gint (Count)
+ - Get_Offset (Iter2)))
+ := (others => ' ');
+ begin
+ -- We must test whether we are already on line ends, since
+ -- otherwise the call to Forward_To_Line_End would jump to next
+ -- line.
+ if not Ends_Line (Iter) then
+ Forward_To_Line_End (Iter, Success);
+ end if;
+
+ Class.Default_Insert_Callback
+ (Get_Object (Term),
+ Iter'Unrestricted_Access, S'Address, S'Length);
+ end;
+
+ else
+ Forward_Chars (Iter, Count => Gint (Count), Result => Success);
+ end if;
+ end if;
+
+ Place_Cursor (Term, Iter);
+ end On_Move_Cursor_Right;
+
+ -------------------------
+ -- On_Move_Cursor_Down --
+ -------------------------
+
+ procedure On_Move_Cursor_Down
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ Count : Natural;
+ Preserve_Column : Boolean)
+ is
+ Start : constant Gint := Get_Line_Offset (Iter);
+ Success : Boolean;
+ Missing : Integer;
+ Eob : Gtk_Text_Iter;
+ begin
+ Get_End_Iter (Term, Eob);
+
+ if Count = 0 then
+ -- Already on the right line
+ null;
+
+ elsif Get_Line (Eob) + 1 < Get_Line (Iter) + Gint (Count) + 1 then
+ -- Lines missing in the buffer, add them
+ Missing := Integer (Get_Line (Iter)) + 1
+ + Count - Integer (Get_Line (Eob) + 1);
+ Default_Insert (Term, Eob, (1 .. Missing => ASCII.LF));
+ Copy (Source => Eob, Dest => Iter);
+
+ else
+ Forward_Lines (Iter, Gint (Count), Success);
+ if not Success then
+ Trace (Me,
+ "Error: could not move" & Integer'Image (Count) & " down");
+ end if;
+ end if;
+
+ if Preserve_Column then
+ Set_Col_In_Line (Term, Iter, Start);
+ else
+ Place_Cursor (Term, Iter);
+ end if;
+ end On_Move_Cursor_Down;
+
+ -----------------------
+ -- On_Move_Cursor_Up --
+ -----------------------
+
+ procedure On_Move_Cursor_Up
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ Count : Natural;
+ Preserve_Column : Boolean)
+ is
+ Start : constant Gint := Get_Line_Offset (Iter);
+ Success : Boolean;
+ begin
+ Backward_Lines (Iter, Gint (Count), Success);
+
+ if Preserve_Column then
+ Set_Col_In_Line (Term, Iter, Start);
+ else
+ Place_Cursor (Term, Iter);
+ end if;
+ end On_Move_Cursor_Up;
+
+ --------------------
+ -- On_Move_Cursor --
+ --------------------
+
+ procedure On_Move_Cursor
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ Line : Integer;
+ Column : Integer)
+ is
+ Success : Boolean;
+ Missing : Integer;
+ Eob : Gtk_Text_Iter;
+ begin
+ -- ??? Tricky here: the first line should be the first visible line, but
+ -- we do not have access to the view, so we don't know exactly which it
+ -- is. For now we'll assume the user did a Clear_Screen first and the
+ -- buffer only contains the visible part anyway
+
+ -- Move down, creating lines as needed
+ Get_Start_Iter (Term, Iter);
+ Get_End_Iter (Term, Eob);
+
+ if Get_Line (Iter) + 1 = Gint (Line) then
+ -- Already on the right line
+ null;
+
+ elsif Get_Line (Eob) + 1 < Gint (Line) then
+ -- Lines missing in the buffer, add them
+ Missing := Line - Integer (Get_Line (Eob) + 1);
+ Default_Insert (Term, Eob, (1 .. Missing => ASCII.LF));
+ Copy (Source => Eob, Dest => Iter);
+
+ else
+ Forward_Lines (Iter, Gint (Line - 1), Success);
+ if not Success then
+ Trace (Me,
+ "Error: could not move"
+ & Integer'Image (Line - 1) & " down");
+ end if;
+ end if;
+
+ Set_Col_In_Line (Term, Iter, Gint (Column - 1));
+ end On_Move_Cursor;
+
+ ----------------
+ -- On_Newline --
+ ----------------
+
+ procedure On_Newline
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk_Text_Iter)
+ is
+ begin
+ On_Move_Cursor_Down (Term, Iter, 1, Preserve_Column => False);
+ Set_Line_Index (Iter, 0);
+ Place_Cursor (Term, Iter);
+ end On_Newline;
+
+ ------------------------------
+ -- On_Clear_Screen_And_Home --
+ ------------------------------
+
+ procedure On_Clear_Screen_And_Home
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk_Text_Iter)
+ is
+ Frm : Gtk_Text_Iter;
+ begin
+ -- ??? Should we preserve the rest of the window before the visible part
+ -- Ideally yes, but hard to do since we have to know what is the
+ -- visible area and we don't have access to the view
+
+ Get_Start_Iter (Term, Frm);
+ Get_End_Iter (Term, Iter);
+ Delete (Term, Frm, Iter);
+ end On_Clear_Screen_And_Home;
+
+ -------------------------------
+ -- On_Clear_To_End_Of_Screen --
+ -------------------------------
+
+ procedure On_Clear_To_End_Of_Screen
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk_Text_Iter)
+ is
+ To : Gtk_Text_Iter;
+ begin
+ Get_End_Iter (Term, To);
+ Delete (Term, Iter, To);
+ end On_Clear_To_End_Of_Screen;
+
+ -----------------------------
+ -- On_Clear_To_End_Of_Line --
+ -----------------------------
+
+ procedure On_Clear_To_End_Of_Line
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk_Text_Iter)
+ is
+ To : Gtk_Text_Iter;
+ Success : Boolean;
+ begin
+ Copy (Source => Iter, Dest => To);
+ Forward_To_Line_End (To, Success);
+ Delete (Term, Iter, To);
+ end On_Clear_To_End_Of_Line;
+
+ -------------------
+ -- End_All_Modes --
+ -------------------
+
+ procedure End_All_Modes (Term : access Gtkada_Terminal_Record'Class) is
+ begin
+ Term.Bold := False;
+ Term.Standout := False;
+ Term.Current_Foreground := -1;
+ Term.Current_Background := -1;
+ end End_All_Modes;
+
+ ----------------------
+ -- On_Set_Attribute --
+ ----------------------
+
+ procedure On_Set_Attribute
+ (Term : access Gtkada_Terminal_Record'Class;
+ Ansi : Integer)
+ is
+ begin
+ case Ansi is
+ when 0 =>
+ End_All_Modes (Term);
+
+ when 30 => Term.Current_Foreground := Tag_Array'First;
+ when 31 => Term.Current_Foreground := Tag_Array'First + 1;
+ when 32 => Term.Current_Foreground := Tag_Array'First + 2;
+ when 33 => Term.Current_Foreground := Tag_Array'First + 3;
+ when 34 => Term.Current_Foreground := Tag_Array'First + 4;
+ when 35 => Term.Current_Foreground := Tag_Array'First + 5;
+ when 36 => Term.Current_Foreground := Tag_Array'First + 6;
+ when 37 => Term.Current_Foreground := Tag_Array'First + 7;
+
+ when 40 => Term.Current_Background := Tag_Array'First;
+ when 41 => Term.Current_Background := Tag_Array'First + 1;
+ when 42 => Term.Current_Background := Tag_Array'First + 2;
+ when 43 => Term.Current_Background := Tag_Array'First + 3;
+ when 44 => Term.Current_Background := Tag_Array'First + 4;
+ when 45 => Term.Current_Background := Tag_Array'First + 5;
+ when 46 => Term.Current_Background := Tag_Array'First + 6;
+ when 47 => Term.Current_Background := Tag_Array'First + 7;
+
+ when others =>
+ Trace (Me, "Set_Attribute:" & Ansi'Img);
+ end case;
+ end On_Set_Attribute;
+
+ --------------------
+ -- Default_Insert --
+ --------------------
+
+ procedure Default_Insert
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ S : System.Address;
+ Length : Gint;
+ Overwrite_Mode : Boolean := True)
+ is
+ Start_Offset : constant Gint := Get_Offset (Iter);
+ Off : Gint;
+ Iter2 : Gtk_Text_Iter;
+ Eol : Gtk_Text_Iter;
+ Success : Boolean;
+ begin
+ -- Simulate overwrite mode. Rather than computing how many UTF8 chars we
+ -- have inserted we rely on Offset for that. However, we must make sure
+ -- not to erase beyond the end of line
+
+ Class.Default_Insert_Callback
+ (Get_Object (Term), Iter'Unrestricted_Access, S, Length);
+
+ if Term.Bold then
+ Get_Iter_At_Offset (Term, Iter2, Start_Offset);
+ Apply_Tag (Term, Term.Bold_Tag, Iter2, Iter);
+ end if;
+
+ if Term.Standout then
+ Get_Iter_At_Offset (Term, Iter2, Start_Offset);
+ Apply_Tag (Term, Term.Standout_Tag, Iter2, Iter);
+ end if;
+
+ if Term.Current_Foreground in Tag_Array'Range then
+ Get_Iter_At_Offset (Term, Iter2, Start_Offset);
+ Apply_Tag
+ (Term, Term.Foreground_Tags (Term.Current_Foreground), Iter2, Iter);
+ end if;
+
+ if Term.Current_Background in Tag_Array'Range then
+ Get_Iter_At_Offset (Term, Iter2, Start_Offset);
+ Apply_Tag
+ (Term, Term.Background_Tags (Term.Current_Background), Iter2, Iter);
+ end if;
+
+ if Overwrite_Mode then
+ Off := Get_Offset (Iter) - Start_Offset;
+ Copy (Source => Iter, Dest => Iter2);
+ Forward_Chars (Iter2, Count => Off, Result => Success);
+
+ Copy (Source => Iter, Dest => Eol);
+ if not Ends_Line (Eol) then
+ Forward_To_Line_End (Eol, Success);
+ end if;
+
+ if Get_Offset (Eol) <= Get_Offset (Iter2) then
+ Delete (Term, Iter, Eol);
+ else
+ Delete (Term, Iter, Iter2);
+ end if;
+ end if;
+
+ Place_Cursor (Term, Iter);
+ end Default_Insert;
+
+ --------------------
+ -- Default_Insert --
+ --------------------
+
+ procedure Default_Insert
+ (Term : access Gtkada_Terminal_Record'Class;
+ Iter : in out Gtk.Text_Iter.Gtk_Text_Iter;
+ S : String;
+ Overwrite_Mode : Boolean := True) is
+ begin
+ Default_Insert (Term, Iter, S'Address, S'Length, Overwrite_Mode);
+ end Default_Insert;
+
+ --------------------
+ -- On_Insert_Text --
+ --------------------
+
+ procedure On_Insert_Text
+ (Widget : System.Address;
+ Iter : access Gtk.Text_Iter.Gtk_Text_Iter;
+ Text : System.Address;
+ Length : Gint)
+ is
+ Stub : Gtkada_Terminal_Record;
+ pragma Warnings (Off, Stub);
+ Term : constant Gtkada_Terminal :=
+ Gtkada_Terminal (Get_User_Data (Widget, Stub));
+ Txt : constant c_char_array_access := UC (Text);
+
+ Str_Arg_First, Str_Arg_Last : size_t;
+ -- Integer arguments
+
+ C : size_t := 0;
+ Stopper : char;
+
+ procedure Insert_Substr (Frm, To : size_t);
+ -- Write a specific substring to the buffer
+
+ function To_String (Frm, To : size_t) return String;
+ -- Return the specified substring of Text
+
+ procedure Perform (Func : Capability);
+ -- Perform an action requested by the user, and reset FSM
+
+ procedure Send_Current_Sequence;
+ -- Send the current sequence of characters to the screen, up to but not
+ -- including the character pointing by C. Reset the state machine
+
+ procedure Debug_Trace (Str : String);
+ -- Print Str on the debug log, quoting special characters
+
+ ---------------
+ -- To_String --
+ ---------------
+
+ function To_String (Frm, To : size_t) return String is
+ S : String (Integer (Frm + 1) .. Integer (To + 1));
+ begin
+ for C in S'Range loop
+ S (C) := Character (Txt (size_t (C) - 1));
+ if S (C) = ASCII.ESC then
+ S (C) := '^';
+ end if;
+ end loop;
+ return S;
+ end To_String;
+
+ -----------------
+ -- Debug_Trace --
+ -----------------
+
+ procedure Debug_Trace (Str : String) is
+ Last : Integer := Str'First;
+ begin
+ for S in Str'Range loop
+ if Str (S) < ' ' then
+ if Last < S then
+ Trace (Me, Str (Last .. S - 1));
+ end if;
+ Trace (Me, "ASCII." & Character'Image (Str (S)));
+ Last := S + 1;
+ end if;
+ end loop;
+
+ if Last <= Str'Last then
+ Trace (Me, Str (Last .. Str'Last));
+ end if;
+ end Debug_Trace;
+
+ -------------------
+ -- Insert_Substr --
+ -------------------
+
+ procedure Insert_Substr (Frm, To : size_t) is
+ begin
+ -- Insertion must be done in overwrite mode for a terminal, so we
+ -- need to delete chars before inserting some (or the opposite)
+
+ if Term.Alternate_Charset then
+ -- We need to translate the string into the alternate charset.
+ -- These might be unicode chars encoded into multiple bytes. We
+ -- therefore convert things into block (to try and reduce the
+ -- number of calls to gtk+'s insertion procedure while having
+ -- the capability to translate one incoming char into multiple
+ -- unicode bytes).
+ declare
+ S : aliased String (1 .. 1024);
+ Index : Natural := S'First;
+ Uni : Gunichar;
+ begin
+ for C in Frm .. To loop
+ Uni := Alternate_Charset (Character (Txt (C)));
+ if Uni < 127 then
+ S (Index) := Character'Val (Uni);
+ Index := Index + 1;
+ else
+ Unichar_To_UTF8 (Uni, S (Index .. S'Last), Index);
+ Index := Index + 1;
+ end if;
+
+ -- Is the block full ?
+ if Index >= S'Last - 4 then
+ if Active (Me) then
+ Debug_Trace (S (S'First .. Index - 1));
+ end if;
+ Default_Insert (Term, Iter.all, S (S'First .. Index - 1));
+ Index := S'First;
+ end if;
+ end loop;
+
+ if Index > S'First then
+ if Active (Me) then
+ Debug_Trace (S (S'First .. Index - 1));
+ end if;
+ Default_Insert (Term, Iter.all, S (S'First .. Index - 1));
+ end if;
+ end;
+
+ else
+ if Active (Me) then
+ Debug_Trace (To_String (Frm, To));
+ end if;
+ Default_Insert
+ (Term, Iter.all, Txt (Frm .. To)'Address, Gint (To - Frm + 1));
+ end if;
+ end Insert_Substr;
+
+ -------------
+ -- Perform --
+ -------------
+
+ procedure Perform (Func : Capability) is
+ begin
+ if Term.State.Current = Term.FSM then
+ Send_Current_Sequence;
+ end if;
+
+ if Active (Me) then
+ if Term.State.Current_Arg = 1 then
+ Trace (Me, Func'Img);
+ elsif Term.State.Current_Arg = 2 then
+ Trace (Me, Func'Img
+ & Term.State.Arg (Numerical_Arguments'First)'Img);
+ elsif Term.State.Current_Arg = 3 then
+ Trace (Me, Func'Img
+ & Term.State.Arg (Term.State.Arg'First)'Img
+ & Term.State.Arg (Term.State.Arg'First + 1)'Img);
+ else
+ Trace (Me, Func'Img & " ...");
+ end if;
+ end if;
+
+ -- The previous sequence of characters has already been emitted, no
+ -- need to redo that (for instance when changing the charset to make
+ -- sure the previous chars are displayed with the right set)
+
+ case Func is
+ when Do_Nothing =>
+ null;
+ when Display_In_Status_Line =>
+ On_Set_Title (Term, To_String (Str_Arg_First, Str_Arg_Last));
+ when Start_Alternative_Charset =>
+ Term.Alternate_Charset := True;
+ when End_Alternative_Charset =>
+ Term.Alternate_Charset := False;
+ End_All_Modes (Term); -- ??? Is this correct
+ when Start_Bold_Mode =>
+ End_All_Modes (Term);
+ Term.Bold := True;
+ when Start_Standout_Mode =>
+ End_All_Modes (Term);
+ Term.Standout := True;
+ when End_Standout_Mode =>
+ End_All_Modes (Term);
+ Term.Standout := False;
+ when End_All_Modes =>
+ End_All_Modes (Term);
+
+ when Beginning_Of_Line =>
+ Set_Line_Offset (Iter.all, 0);
+ Place_Cursor (Term, Iter.all);
+
+ when Cursor_Left_Multiple =>
+ On_Move_Cursor_Left (Term, Iter.all, Term.State.Arg (1));
+ when Cursor_Left =>
+ On_Move_Cursor_Left (Term, Iter.all, 1);
+
+ when Cursor_Right_Multiple =>
+ On_Move_Cursor_Right (Term, Iter.all, Term.State.Arg (1));
+ when Cursor_Right =>
+ On_Move_Cursor_Right (Term, Iter.all, 1);
+
+ when Cursor_Up_Multiple =>
+ On_Move_Cursor_Up
+ (Term, Iter.all, Term.State.Arg (1), Preserve_Column => True);
+ when Cursor_Up =>
+ On_Move_Cursor_Up
+ (Term, Iter.all, 1, Preserve_Column => True);
+
+ when Cursor_Down_Multiple =>
+ On_Move_Cursor_Down
+ (Term, Iter.all, Term.State.Arg (1), Preserve_Column => True);
+ when Cursor_Down =>
+ On_Move_Cursor_Down
+ (Term, Iter.all, 1, Preserve_Column => True);
+
+ when Clear_To_End_Of_Screen =>
+ On_Clear_To_End_Of_Screen (Term, Iter.all);
+
+ when Clear_To_End_Of_Line =>
+ On_Clear_To_End_Of_Line (Term, Iter.all);
+
+ when Newline =>
+ On_Newline (Term, Iter.all);
+ when Memory_Unlock | Memory_Lock =>
+ null;
+
+ when Clear_Screen_And_Home =>
+ On_Clear_Screen_And_Home (Term, Iter.all);
+
+ when Move_Cursor =>
+ On_Move_Cursor
+ (Term, Iter.all, Term.State.Arg (1), Term.State.Arg (2));
+ when Cursor_Home =>
+ On_Move_Cursor (Term, Iter.all, 1, 1);
+
+ when Set_Char_Attribute =>
+ for A in 1 .. Term.State.Current_Arg - 1 loop
+ On_Set_Attribute (Term, Term.State.Arg (A));
+ end loop;
+ when others =>
+ Trace (Me, "Unhandled capability: " & Func'Img);
+ end case;
+
+ Term.State.Current := Term.FSM;
+ Term.State.Start_Of_Sequence := C + 1;
+ end Perform;
+
+ ---------------------------
+ -- Send_Current_Sequence --
+ ---------------------------
+
+ procedure Send_Current_Sequence is
+ begin
+ if C > 0 and then Term.State.Start_Of_Sequence <= C - 1 then
+ Insert_Substr (Term.State.Start_Of_Sequence, C - 1);
+ end if;
+
+ Term.State.Start_Of_Sequence := C;
+ Term.State.Current_Arg := Numerical_Arguments'First;
+ Str_Arg_First := size_t (Length) - 1;
+ end Send_Current_Sequence;
+
+ Cursor : Gtk_Text_Iter;
+
+ begin
+ if Term.FSM = null then
+ -- No special terminal setup ? Send the string as is
+ Insert_Substr (Txt'First, Txt'First + size_t (Length) - 1);
+ return;
+ end if;
+
+ if Term.State.Current = null then
+ Term.State.Current := Term.FSM;
+ end if;
+
+ -- If we are not inserting at the cursor, all bets are off, and the
+ -- terminal might be corrupted. However, that's probably better than
+ -- forbidding a modification altogether
+
+ Get_Iter_At_Mark (Term, Cursor, Get_Insert (Term));
+ if Get_Offset (Cursor) /= Get_Offset (Iter.all) then
+ Default_Insert (Term, Iter.all, Text, Length);
+ return;
+
+ else
+ -- Make sure we move the cursor to its old position, if appropriate
+ if Term.Cursor_Mark /= null then
+ Get_Iter_At_Mark (Term, Cursor, Term.Cursor_Mark);
+ if Get_Offset (Cursor) /= Get_Offset (Iter.all) then
+ Place_Cursor (Term, Cursor);
+ Copy (Source => Cursor, Dest => Iter.all);
+ end if;
+ end if;
+ end if;
+
+ while C < size_t (Length) loop
+ if Txt (C) in Escape_Chars then
+ if Term.State.Parsing_Number then
+ if Txt (C) in '0' .. '9' then
+ Term.State.Arg (Term.State.Current_Arg) :=
+ Term.State.Arg (Term.State.Current_Arg) * 10
+ + char'Pos (Txt (C)) - char'Pos ('0');
+
+ if Term.State.Tmp /= null then
+ if Term.State.Tmp (Txt (C)) /= Null_State then
+ -- The following test is only needed if we assume that
+ -- the special command could end on a numeric
+ -- character, which I don't believe is possible yet
+ -- (and therefore we test again after the loop, ie
+ -- when we have encountered the first non-numerical
+ -- character
+ if Term.State.Tmp (Txt (C)).Callback /=
+ Self_Insert
+ then
+ Perform (Term.State.Tmp (Txt (C)).Callback);
+ Term.State.Current := Term.FSM;
+ Term.State.Start_Of_Sequence := C + 1;
+
+ else
+ Term.State.Tmp :=
+ Term.State.Tmp (Txt (C)).Transitions;
+ end if;
+
+ else
+ -- No need to check anymore, there are no transition
+ Term.State.Tmp := null;
+ end if;
+ end if;
+
+ else
+ -- No more digits to complete the argument
+ Term.State.Parsing_Number := False;
+
+ -- We look at Tmp only if we have transitioned, otherwise we
+ -- would be ignoring the numbers altogether
+ if Term.State.Tmp /= null
+ and then Term.State.Tmp (Txt (C)) /= Null_State
+ then
+ if Term.State.Tmp (Txt (C)).Callback /= Self_Insert then
+ Perform (Term.State.Tmp (Txt (C)).Callback);
+
+ elsif Term.State.Tmp (Txt (C)).Transitions /= null then
+ -- Seems like the state machine is still trying to
+ -- match, so this is the new current state and we
+ -- forget about the %d argument. Seems an unlikely
+ -- case though
+ Term.State.Current :=
+ Term.State.Tmp (Txt (C)).Transitions;
+ end if;
+ else
+ Term.State.Current_Arg := Term.State.Current_Arg + 1;
+ C := C - 1; -- So that we test the character after %d
+ end if;
+ end if;
+
+ elsif Term.State.Current (Txt (C)).String_Stopper /=
+ char'Val (127)
+ then
+ -- Read a string parameter. This is a relatively rare case, for
+ -- now we assume the string and the terminator come in the same
+ -- batch.
+
+ Str_Arg_First := C + 1;
+ Stopper := Term.State.Current (Txt (C)).String_Stopper;
+ while C < size_t (Length)
+ and then Txt (C) /= Stopper
+ loop
+ C := C + 1;
+ end loop;
+
+ -- A command with a string parameter
+ Str_Arg_Last := C - 1;
+ Perform (Term.State.Current (Txt (Str_Arg_First - 1)).Callback);
+
+ elsif Term.State.Current (Txt (C)).Callback /= Self_Insert then
+ -- A special command was found
+ Perform (Term.State.Current (Txt (C)).Callback);
+
+ elsif Term.State.Current (Txt (C)).Any_Number /= null
+ and then C < size_t (Length) - 1
+ and then Txt (C + 1) in '0' .. '9'
+ then
+ Term.State.Parsing_Number := True;
+
+ -- We have a command with one numerical parameter. The problem
+ -- is that this could also be part of a shorter command, as in:
+ -- ^[[%dm => set attribute
+ -- ^[[2J => Clear screen and home cursor
+ -- So after seeing "^[[" we need to test both the %d and the
+ -- standard transitions. So we use Tmp to follow the
+ -- potential states from here on.
+
+ Term.State.Tmp := Term.State.Current (Txt (C)).Transitions;
+ Term.State.Current := Term.State.Current (Txt (C)).Any_Number;
+ Term.State.Arg (Term.State.Current_Arg) := 0;
+
+ elsif Term.State.Current (Txt (C)).Transitions /= null then
+ -- Either starting a new special sequence (then emit current
+ -- chars) or in the middle of one
+
+ if Term.State.Current = Term.FSM then
+ Send_Current_Sequence;
+ end if;
+
+ Term.State.Current := Term.State.Current (Txt (C)).Transitions;
+
+ else
+ -- A self-insert character
+ Term.State.Current := Term.FSM;
+ end if;
+
+ else
+ -- Txt (C) not in Escape_Chars, ie > 127
+ -- We have some UTF8 encoding, and we need to send all the char
+ -- at once
+
+ if char'Pos (Txt (C)) < 16#800# then
+ C := C + 1; -- utf8 char encoded on 2 bytes
+ elsif char'Pos (Txt (C)) < 16#10000# then
+ C := C + 2; -- utf8 char encoded on 3 bytes
+ elsif char'Pos (Txt (C)) < 16#200000# then
+ C := C + 3; -- utf8 char encoded on 4 bytes
+ elsif char'Pos (Txt (C)) < 16#4000000# then
+ C := C + 4; -- utf8 char encoded on 5 bytes
+ else
+ C := C + 5; -- utf8 char encoded on 6 bytes
+ end if;
+ end if;
+
+ C := C + 1;
+ end loop;
+
+ if Term.State.Current = Term.FSM then
+ Send_Current_Sequence;
+ end if;
+
+ -- On exit, we might be in the middle of parsing an escape sequence,
+ -- in which case the start_of_sequence does not matter, or we have just
+ -- send a sequence, in which case Start_Of_Sequence is already null. But
+ -- we need to reset it since the next string will use a different
+ -- sequence anyway
+ Term.State.Start_Of_Sequence := 0;
+ end On_Insert_Text;
+
+ ----------------
+ -- On_Destroy --
+ ----------------
+
+ procedure On_Destroy (Data : System.Address; Self : System.Address) is
+ pragma Unreferenced (Data);
+ Stub : Gtkada_Terminal_Record;
+ pragma Warnings (Off, Stub);
+ Term : constant Gtkada_Terminal :=
+ Gtkada_Terminal (Get_User_Data (Self, Stub));
+
+ begin
+ Free (Term.FSM);
+ if Term.Cursor_Mark /= null then
+ Delete_Mark (Term, Term.Cursor_Mark);
+ end if;
+ end On_Destroy;
+
+ -------------
+ -- Gtk_New --
+ -------------
+
+ procedure Gtk_New
+ (Self : out Gtkada_Terminal;
+ Prevent_Cursor_Motion_With_Mouse : Boolean := False)
+ is
+ begin
+ Self := new Gtkada_Terminal_Record;
+ Gtkada.Terminal.Initialize (Self, Prevent_Cursor_Motion_With_Mouse);
+ end Gtk_New;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize
+ (Self : access Gtkada_Terminal_Record'Class;
+ Prevent_Cursor_Motion_With_Mouse : Boolean := False)
+ is
+ function Replace_Insert_Text
+ (Class : GObject_Class; Func : Insert_Callback)
+ return Insert_Callback;
+ pragma Import (C, Replace_Insert_Text, "replace_insert_text");
+
+ Iter : Gtk_Text_Iter;
+ begin
+ Gtk.Text_Buffer.Initialize (Self);
+ Initialize_Class_Record
+ (Object => Self,
+ Signals => (1 .. 0 => Null_Ptr),
+ Class_Record => Class.C_Class,
+ Type_Name => "GtkAdaTerminal",
+ Parameters => Null_Parameter_Types);
+
+ Self.Prevent_Cursor_Motion := Prevent_Cursor_Motion_With_Mouse;
+ if Self.Prevent_Cursor_Motion then
+ Get_Start_Iter (Self, Iter);
+ Self.Cursor_Mark := Create_Mark (Self, Where => Iter);
+ end if;
+
+ if Class.Default_Insert_Callback = null then
+ Class.Default_Insert_Callback := Replace_Insert_Text
+ (Class.C_Class, On_Insert_Text'Access);
+
+ -- Initialize charset tables
+ for C in Alternate_Charset'Range loop
+ if Alternate_Charset (C) = 0 then
+ Alternate_Charset (C) := Character'Pos (C);
+ end if;
+ end loop;
+ end if;
+
+ -- ??? We could cache the finite state machine for all terminals, but
+ -- we need to make this is properly freed on exit, and that also means
+ -- that all terminals have the same FSM (not true if we are emulating
+ -- various terminals)
+ Self.FSM := Parse_Xterm_Termcap;
+
+ Weak_Ref (Self, On_Destroy'Access);
+
+ Gtk_New (Self.Bold_Tag);
+ Set_Property
+ (Self.Bold_Tag, Gtk.Text_Tag.Weight_Property, Pango_Weight_Bold);
+ Add (Get_Tag_Table (Self), Self.Bold_Tag);
+ Unref (Self.Bold_Tag);
+
+ Gtk_New (Self.Standout_Tag);
+ Set_Property
+ (Self.Standout_Tag, Gtk.Text_Tag.Background_Property, "black");
+ Set_Property
+ (Self.Standout_Tag, Gtk.Text_Tag.Foreground_Property, "white");
+ Add (Get_Tag_Table (Self), Self.Standout_Tag);
+ Unref (Self.Standout_Tag);
+
+ for T in Tag_Array'Range loop
+ Gtk_New (Self.Foreground_Tags (T));
+ Gtk_New (Self.Background_Tags (T));
+
+ case T is
+ when 1 =>
+ Set_Property
+ (Self.Foreground_Tags (T),
+ Gtk.Text_Tag.Foreground_Property, "black");
+ Set_Property
+ (Self.Background_Tags (T),
+ Gtk.Text_Tag.Background_Property, "black");
+
+ when 2 =>
+ Set_Property
+ (Self.Foreground_Tags (T),
+ Gtk.Text_Tag.Foreground_Property, "red");
+ Set_Property
+ (Self.Background_Tags (T),
+ Gtk.Text_Tag.Background_Property, "red");
+
+ when 3 =>
+ Set_Property
+ (Self.Foreground_Tags (T),
+ Gtk.Text_Tag.Foreground_Property, "green");
+ Set_Property
+ (Self.Background_Tags (T),
+ Gtk.Text_Tag.Background_Property, "green");
+
+ when 4 =>
+ Set_Property
+ (Self.Foreground_Tags (T),
+ Gtk.Text_Tag.Foreground_Property, "yellow");
+ Set_Property
+ (Self.Background_Tags (T),
+ Gtk.Text_Tag.Background_Property, "yellow");
+
+ when 5 =>
+ Set_Property
+ (Self.Foreground_Tags (T),
+ Gtk.Text_Tag.Foreground_Property, "blue");
+ Set_Property
+ (Self.Background_Tags (T),
+ Gtk.Text_Tag.Background_Property, "blue");
+
+ when 6 =>
+ Set_Property
+ (Self.Foreground_Tags (T),
+ Gtk.Text_Tag.Foreground_Property, "magenta");
+ Set_Property
+ (Self.Background_Tags (T),
+ Gtk.Text_Tag.Background_Property, "magenta");
+
+ when 7 =>
+ Set_Property
+ (Self.Foreground_Tags (T),
+ Gtk.Text_Tag.Foreground_Property, "cyan");
+ Set_Property
+ (Self.Background_Tags (T),
+ Gtk.Text_Tag.Background_Property, "cyan");
+
+ when 8 =>
+ Set_Property
+ (Self.Foreground_Tags (T),
+ Gtk.Text_Tag.Foreground_Property, "white");
+ Set_Property
+ (Self.Background_Tags (T),
+ Gtk.Text_Tag.Background_Property, "white");
+ end case;
+
+ Add (Get_Tag_Table (Self), Self.Foreground_Tags (T));
+ Add (Get_Tag_Table (Self), Self.Background_Tags (T));
+
+ Unref (Self.Foreground_Tags (T));
+ Unref (Self.Background_Tags (T));
+ end loop;
+ end Initialize;
+end Gtkada.Terminal;
============================================================
--- widgets/src/gtkada-terminal.ads a39b83112a04905edb17ce0f980354bc073b6d0f
+++ widgets/src/gtkada-terminal.ads a39b83112a04905edb17ce0f980354bc073b6d0f
@@ -0,0 +1,136 @@
+-----------------------------------------------------------------------
+-- GtkAda - Ada95 binding for Gtk+/Gnome --
+-- --
+-- Copyright (C) 2008-2008, AdaCore --
+-- --
+-- This library 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 library 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. --
+-- --
+-- As a special exception, if other files instantiate generics from --
+-- this unit, or you link this unit with other files to produce an --
+-- executable, this unit does not by itself cause the resulting --
+-- executable to be covered by the GNU General Public License. This --
+-- exception does not however invalidate any other reasons why the --
+-- executable file might be covered by the GNU Public License. --
+-----------------------------------------------------------------------
+
+-- This widget is a Gtk_Text_Buffer that emulates a terminal, that is it
+-- understands ESCAPE sequences to move cursor, change color,...
+-- Currently, it knows how to emulate xterm.
+
+with Gtk.Text_Buffer;
+with Gtk.Text_Mark;
+with Gtk.Text_Iter;
+with Gtk.Text_Tag;
+with Interfaces.C;
+
+package Gtkada.Terminal is
+
+ type Gtkada_Terminal_Record is new Gtk.Text_Buffer.Gtk_Text_Buffer_Record
+ with private;
+ type Gtkada_Terminal is access all Gtkada_Terminal_Record'Class;
+
+ procedure Gtk_New
+ (Self : out Gtkada_Terminal;
+ Prevent_Cursor_Motion_With_Mouse : Boolean := False);
+ procedure Initialize
+ (Self : access Gtkada_Terminal_Record'Class;
+ Prevent_Cursor_Motion_With_Mouse : Boolean := False);
+ -- Creates or initializes a terminal.
+ -- Prevent_Cursor_Motion_With_Mouse should be true if the terminal should
+ -- manage its own insertion point, possibly different from the gtk+ cursor.
+ -- If it is true, the only way to move the cursor is through escape
+ -- sequences, not the mouse nor the arrow keys will work. This is only
+ -- suitable for those applications that use curses (like a Unix shell, vi
+ -- or other full-screen applications), not if you are using the terminal
+ -- just to be able to see colors for instance.
+
+ overriding procedure Place_Cursor
+ (Self : access Gtkada_Terminal_Record;
+ Where : Gtk.Text_Iter.Gtk_Text_Iter);
+ -- See inherited subprogram
+
+ procedure On_Set_Title
+ (Term : access Gtkada_Terminal_Record;
+ Title : String);
+ -- Called when the title of the terminal should be changed. Since the
+ -- terminal is not a widget in itself, you must override this subprogram to
+ -- make something useful with it
+
+private
+ type FSM_Transition;
+ type FSM_Transition_Access is access FSM_Transition;
+ -- A finite state machine used to parse the text written on the terminal,
+ -- and efficiently detect special escape sequences.
+
+ type Tag_Array is array (1 .. 8) of Gtk.Text_Tag.Gtk_Text_Tag;
+ type Numerical_Arguments is array (1 .. 9) of Integer;
+
+ type FSM_Current_State is record
+ Arg : Numerical_Arguments;
+ Current_Arg : Integer := Numerical_Arguments'First;
+ -- Numerical arguments to some of the commands
+
+ Current : FSM_Transition_Access;
+ Tmp : FSM_Transition_Access;
+ -- Current state of the finite-state machine. Tmp is used when we need
+ -- to follow two possible branches at once (eg when parsing numerical
+ -- arguments)
+
+ Start_Of_Sequence : Interfaces.C.size_t := 0;
+ -- The last char for which current was Class.FSM, ie the last
+ -- self-insert char. This is used to rollback when an escape sequence
+ -- could not be interpreted after all.
+
+ Parsing_Number : Boolean := False;
+ -- Whether we are parsing a digit argument
+ end record;
+ -- Describes the current state of the finite state machine
+
+ type Gtkada_Terminal_Record is new Gtk.Text_Buffer.Gtk_Text_Buffer_Record
+ with record
+ FSM : FSM_Transition_Access;
+ -- The finite state machine to find the special escape sequences. This
+ -- is null if the terminal should not try to find such sequences
+
+ Prevent_Cursor_Motion : Boolean := False;
+ -- If True, the terminal memorizes where the external application left
+ -- the cursor, and always inserts at that position, even if the cursor
+ -- was moved with the mouse to another location
+
+ Cursor_Mark : Gtk.Text_Mark.Gtk_Text_Mark;
+
+ Alternate_Charset : Boolean := False;
+ -- Whether we are in the alternate character set. This is a way for
+ -- applications to display height bit chars by sending only 7bits
+
+ Bold_Tag : Gtk.Text_Tag.Gtk_Text_Tag;
+ Bold : Boolean := False;
+ -- Whether text should be output in bold
+
+ Standout_Tag : Gtk.Text_Tag.Gtk_Text_Tag;
+ Standout : Boolean := False;
+ -- Whether text should be printed in reverse video
+
+ Foreground_Tags : Tag_Array;
+ Current_Foreground : Integer := -1;
+
+ Background_Tags : Tag_Array;
+ Current_Background : Integer := -1;
+
+ State : FSM_Current_State;
+ end record;
+
+end Gtkada.Terminal;
============================================================
--- widgets/src/gtkada_terminal.c 73d405501cad70418c4d824473f9c47eecb5b97e
+++ widgets/src/gtkada_terminal.c 73d405501cad70418c4d824473f9c47eecb5b97e
@@ -0,0 +1,28 @@
+/*********************************************************************
+ * 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. *
+ *********************************************************************/
+
+#include <gtk/gtktextbuffer.h>
+
+void* replace_insert_text
+ (struct _GtkTextBufferClass* class, void* insert_func)
+{
+ void* old = class->insert_text;
+ class->insert_text = insert_func;
+ return old;
+}
============================================================
--- Makefile.in b53cba3efe0609ecdcb2f17cc8900d8ea02ca3dd
+++ Makefile.in 926c975d51b595d7cc15faf69269dc5229c1e9cd
@@ -62,7 +62,7 @@ endif
$(RM) $(sharedir)/gps/plug-ins/emacs.xml
(cd share; tar cf - icons/) | (cd $(sharedir)/gps; tar xf -)
(cd share; tar cf - *.*) | (cd $(sharedir)/gps; tar xf -)
- (cd docgen2/resources; tar cf - *.tmpl support/*.css support/*.js support/images/*.png) \
+ (cd docgen2/resources; tar cf - *.tmpl custom/*.css support/*.css support/*.js support/images/*.png) \
| (cd $(sharedir)/gps/docgen2; tar xf -)
(cd aunit/templates; tar cf - *.tmpl) \
| (cd $(sharedir)/gps/aunit; tar xf -)
============================================================
--- builder/src/build_command_manager.adb 99ea69df1614ac0db1a54eb0d160d14d51cdd6be
+++ builder/src/build_command_manager.adb 18e5d0f9bf1607f6c29f646206cf5ee53156bb38
@@ -570,10 +570,17 @@ package body Build_Command_Manager is
return;
end if;
- Full := Expand_Command_Line
- (Kernel, Command_Line.all & All_Extra_Args.all,
- Server, Force_File, Main, Subdir);
- Free (Command_Line);
+ declare
+ CL_Mode : Argument_List_Access :=
+ Apply_Mode_Args
+ (Get_Model (T), Mode, Command_Line.all);
+ begin
+ Full := Expand_Command_Line
+ (Kernel, CL_Mode.all & All_Extra_Args.all,
+ Server, Force_File, Main, Subdir);
+ Free (Command_Line);
+ Free (CL_Mode);
+ end;
else
-- Get the unexpanded command line from the target
============================================================
--- builder/src/builder_facility_module-scripts.adb 245eb44c7cf2c99c440cce0847a232f6ab14f6db
+++ builder/src/builder_facility_module-scripts.adb 5baa80afbdbc4a59ed9540c4159fc511b589ab94
@@ -187,14 +187,14 @@ package body Builder_Facility_Module.Scr
Info := No_File;
end if;
- Extra_Args := GNAT.OS_Lib.Argument_String_To_List
- (Nth_Arg (Data, 5, ""));
-
if Name = "" then
Set_Error_Msg (Data, -"Invalid target");
return;
end if;
+ Extra_Args := GNAT.OS_Lib.Argument_String_To_List
+ (Nth_Arg (Data, 5, ""));
+
if Force then
Mode := Force_No_Dialog;
end if;
@@ -285,6 +285,12 @@ package body Builder_Facility_Module.Scr
Dialog => Default,
Main => "");
+ elsif Command = "get_build_mode" then
+ Set_Return_Value (Data, Get_Mode);
+
+ elsif Command = "set_build_mode" then
+ Set_Mode (Nth_Arg (Data, 1, ""));
+
end if;
end Shell_Handler;
@@ -341,6 +347,20 @@ package body Builder_Facility_Module.Scr
Bind_Default_Key (Kernel => Kernel,
Action => -"Compile File",
Default_Key => "shift-F4");
+
+ -- Global commands
+
+ Register_Command (Kernel => Kernel,
+ Command => "set_build_mode",
+ Minimum_Args => 1,
+ Maximum_Args => 1,
+ Handler => Shell_Handler'Access);
+
+ Register_Command (Kernel => Kernel,
+ Command => "get_build_mode",
+ Minimum_Args => 0,
+ Maximum_Args => 0,
+ Handler => Shell_Handler'Access);
end Register_Commands;
----------
============================================================
--- builder/src/builder_facility_module.adb 18507e087732b067880bb35d4f750855fc203009
+++ builder/src/builder_facility_module.adb 16822bf269d907a443b19f3cb122d46875b1f409
@@ -83,6 +83,9 @@ package body Builder_Facility_Module is
-- The maximum number of Mains that we accept to display in the Menus
-- and toolbar.
+ Max_Number_Of_Projects : constant := 128;
+ -- The maximum number of projects that we process when filling the Mains.
+
Me : constant Debug_Handle := Create ("Builder_Facility_Module");
Modes_Trace : constant Debug_Handle :=
Create ("Builder.Modes", GNATCOLL.Traces.Off);
@@ -465,14 +468,30 @@ package body Builder_Facility_Module is
Index : Natural := 1;
-- Index of the first free element in Result.
Iterator : Imported_Project_Iterator;
+
+ Projects : Project_Type_Array (1 .. Max_Number_Of_Projects);
+ Index_P : Natural := 1;
+ -- Index of the first free element in Projects.
begin
Iterator := Start (Root_Project);
while Current (Iterator) /= No_Project loop
+ Projects (Index_P) := Current (Iterator);
+ Index_P := Index_P + 1;
+ exit when Index_P > Projects'Last;
+ Next (Iterator);
+ end loop;
+
+ -- The project Iterator starts with the leaf projects and ends with
+ -- the root project. Reverse the order to be more user-friendly: in
+ -- the majority of cases, users will want to see the mains defined
+ -- in the root project first.
+
+ for J in reverse 1 .. Index_P - 1 loop
declare
Mains : Argument_List :=
Get_Attribute_Value
- (Current (Iterator), Attribute => Main_Attribute);
+ (Projects (J), Attribute => Main_Attribute);
begin
for J in Mains'Range loop
if Mains (J)'Length > 0 then
@@ -490,8 +509,6 @@ package body Builder_Facility_Module is
end;
exit when Index > Result'Last;
-
- Next (Iterator);
end loop;
return Result (1 .. Index - 1);
@@ -2200,4 +2217,43 @@ package body Builder_Facility_Module is
return Element_Mode (Builder_Module_ID.Registry, U).Server;
end Get_Mode_Server;
+ --------------
+ -- Get_Mode --
+ --------------
+
+ function Get_Mode return String is
+ begin
+ if Builder_Module_ID.Modes_Combo = null then
+ return "";
+ end if;
+
+ return (Get_Active_Text (Builder_Module_ID.Modes_Combo));
+ end Get_Mode;
+
+ --------------
+ -- Set_Mode --
+ --------------
+
+ procedure Set_Mode (Mode : String) is
+ Model : Gtk_Tree_Model;
+ Iter : Gtk_Tree_Iter;
+ begin
+ if Builder_Module_ID.Modes_Combo = null then
+ return;
+ end if;
+
+ Model := Builder_Module_ID.Modes_Combo.Get_Model;
+
+ Iter := Model.Get_Iter_First;
+
+ while Iter /= Null_Iter loop
+ if Get_String (Model, Iter, 0) = Mode then
+ Builder_Module_ID.Modes_Combo.Set_Active_Iter (Iter);
+ return;
+ end if;
+
+ Next (Model, Iter);
+ end loop;
+ end Set_Mode;
+
end Builder_Facility_Module;
============================================================
--- builder/src/builder_facility_module.ads c3f99e6fb9a08a5120fa1bdbc2e3dcf0deb2ab09
+++ builder/src/builder_facility_module.ads 18c359bbc67b371c2e247483f7656398fce347b6
@@ -170,4 +170,12 @@ package Builder_Facility_Module is
-- Recompute the menus and toolbar icons, based on the targets described
-- in the Registry.
+ function Get_Mode return String;
+ -- Return the current mode.
+ -- Return the empty string if no modes are registered.
+
+ procedure Set_Mode (Mode : String);
+ -- Set the mode to Mode. If Mode does not correspond to a registered mode,
+ -- do nothing.
+
end Builder_Facility_Module;
============================================================
--- builder/src/builder_module.adb 28dff7e565400acc916afde0cd3f1961d770784a
+++ builder/src/builder_module.adb eb06a97f3f2ffff95dfa394b9082a1dc4143402a
@@ -547,7 +547,6 @@ package body Builder_Module is
Loads_Xrefs_From_File'Access,
Sources_Load_Chunk,
Xrefs_Loading_Queue,
- True,
"load xrefs info");
end Load_Xref_In_Memory;
@@ -579,7 +578,8 @@ package body Builder_Module is
return;
end if;
- Console := Create_Interactive_Console (Kernel, Run.Title.all);
+ Console := Create_Interactive_Console
+ (Kernel, Run.Title.all, ANSI_Support => True);
Clear (Console);
Child := Find_MDI_Child (Get_MDI (Kernel), Console);
============================================================
--- code_analysis/src/code_analysis_module.adb 50afeb20706593d439c725257d8c28abb12fe36e
+++ code_analysis/src/code_analysis_module.adb 5b496a4dd378d95fdc76f16988e3baf9da62ee59
@@ -838,31 +838,38 @@ package body Code_Analysis_Module is
procedure Add_Gcov_File_Info_In_Callback
(Cont_N_Anal : Context_And_Analysis)
is
- Prj_Name : constant Project_Type :=
- Project_Information (Cont_N_Anal.Context);
- Prj_Node : Project_Access;
- Src_File : constant GNATCOLL.VFS.Virtual_File :=
- File_Information (Cont_N_Anal.Context);
- Cov_File : GNATCOLL.VFS.Virtual_File;
+ Kernel : constant Kernel_Handle :=
+ Get_Kernel (Cont_N_Anal.Context);
+ Prj_Name : constant Project_Type :=
+ Project_Information (Cont_N_Anal.Context);
+ Prj_Node : constant Code_Analysis.Project_Access :=
+ Get_Or_Create (Cont_N_Anal.Analysis.Projects, Prj_Name);
+ Src_File : constant GNATCOLL.VFS.Virtual_File :=
+ File_Information (Cont_N_Anal.Context);
+ File_Node : constant Code_Analysis.File_Access :=
+ Get_Or_Create (Prj_Node, Src_File);
+ Cov_File : GNATCOLL.VFS.Virtual_File;
begin
- Prj_Node := Get_Or_Create (Cont_N_Anal.Analysis.Projects, Prj_Name);
Cov_File := Find_Gcov_File (Get_Kernel (Cont_N_Anal.Context), Src_File);
if not Is_Regular_File (Cov_File) then
GPS.Kernel.Console.Insert
- (Get_Kernel (Cont_N_Anal.Context),
+ (Kernel,
-"Could not find coverage file " & Full_Name (Cov_File).all);
- declare
- File_Node : constant Code_Analysis.File_Access
- := Get_Or_Create (Prj_Node, Src_File);
- begin
- Set_Error (File_Node, File_Not_Found);
- end;
+ Set_Error (File_Node, File_Not_Found);
+
else
- Add_Gcov_File_Info
- (Get_Kernel (Cont_N_Anal.Context), Src_File, Cov_File, Prj_Node);
+ Add_Gcov_File_Info (Kernel, Src_File, Cov_File, Prj_Node);
Compute_Project_Coverage (Prj_Node);
+
+ -- Refresh source editor annotations and locations information.
+ Coverage_GUI.Clear_File_Locations (Kernel, File_Node);
+ Coverage_GUI.Remove_File_Coverage_Annotations (Kernel, File_Node);
+
+ Coverage_GUI.List_File_Uncovered_Lines (Kernel, File_Node);
+ Coverage_GUI.Add_File_Coverage_Annotations (Kernel, File_Node);
+
Refresh_Analysis_Report (Cont_N_Anal);
end if;
end Add_Gcov_File_Info_In_Callback;
============================================================
--- codefix/codefix.gpr 61159fe3cd9ac7516d56d61590fdab133dd25062
+++ codefix/codefix.gpr 0f14d955eca65c27776baa578a17e4e484a41bd7
@@ -8,8 +8,7 @@ project Codefix is
for Source_Dirs use ("src");
for Languages use ("Ada", "C");
- for Object_Dir use "obj/";
- for Exec_Dir use "obj/";
+ for Object_Dir use "obj";
package Binder is
for Default_Switches ("ada") use ("-static");
============================================================
--- codefix/src/codefix-error_lists.adb 54fae03b57ca907ad05c1a36424c76307eb64e84
+++ codefix/src/codefix-error_lists.adb c6bbf3214faa0034fbd559cff5e9344e0209292a
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2007-2008, AdaCore --
+-- Copyright (C) 2007-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 --
============================================================
--- common/common_no_xmlada.gpr.in 31d91273923875d497e3314a6d497e66f6f60349
+++ common/common_no_xmlada.gpr.in d6ca16289cd45c7bae3f3be870158f85404aac84
@@ -11,13 +11,18 @@ project Common is
package Compiler is
for Default_Switches ("Ada") use Shared.Compiler'Default_Switches ("Ada");
+ for Default_Switches ("C") use Shared.Compiler'Default_Switches ("C");
for Switches ("test_htables.adb") use ("-g", "-O2", "-gnatwue");
for Switches ("s-memory.adb") use ("-g", "-O2", "-gnatpg");
+ No_Checks := ("-g", "-O2", "-gnat05", "-gnatpn");
+
case Shared.Build is
when "Production" =>
- for Switches ("htables.adb") use ("-O2", "-gnatpn");
- for Switches ("dynamic_arrays.adb") use ("-O2", "-gnatpn");
+ for Switches ("htables.adb") use No_Checks;
+ for Switches ("dynamic_arrays.adb") use No_Checks;
+ for Switches ("c_analyzer.adb") use No_Checks;
+ for Switches ("ada_analyzer.adb") use No_Checks;
when "Debug" =>
end case;
end Compiler;
============================================================
--- common/common_with_xmlada.gpr.in 2abaa8e72f4bd1d57e2389a09f9cc1f2f4d624ab
+++ common/common_with_xmlada.gpr.in 39569dedb56fcd3f508d8cd4b8b3baf0738340b4
@@ -12,13 +12,18 @@ project Common is
package Compiler is
for Default_Switches ("Ada") use Shared.Compiler'Default_Switches ("Ada");
+ for Default_Switches ("C") use Shared.Compiler'Default_Switches ("C");
for Switches ("test_htables.adb") use ("-g", "-O2", "-gnatwue");
for Switches ("s-memory.adb") use ("-g", "-O2", "-gnatpg");
+ No_Checks := ("-g", "-O2", "-gnat05", "-gnatpn");
+
case Shared.Build is
when "Production" =>
- for Switches ("htables.adb") use ("-O2", "-gnatpn");
- for Switches ("dynamic_arrays.adb") use ("-O2", "-gnatpn");
+ for Switches ("htables.adb") use No_Checks;
+ for Switches ("dynamic_arrays.adb") use No_Checks;
+ for Switches ("c_analyzer.adb") use No_Checks;
+ for Switches ("ada_analyzer.adb") use No_Checks;
when "Debug" =>
end case;
end Compiler;
============================================================
--- common/expect/expWinSlaveDbg.c 3368e463b184640d331cf93d879395a51c23ef10
+++ common/expect/expWinSlaveDbg.c cdfe242c295eeb28a48adac463b50f2a51cf6330
@@ -223,8 +223,6 @@ static void OnBeep(ExpProcess *,
static void OnBeep(ExpProcess *,
ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
-static void OnFillConsoleOutputCharacter(ExpProcess *,
- ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
static void OnGetStdHandle(ExpProcess *,
ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
static void OnIsWindowVisible(ExpProcess *,
@@ -274,10 +272,6 @@ ExpBreakInfo BreakArrayKernel32[] = {
*/
ExpBreakInfo BreakArrayKernel32[] = {
- {"FillConsoleOutputCharacterA", 5,
- OnFillConsoleOutputCharacter, EXP_BREAK_OUT},
- {"FillConsoleOutputCharacterW", 5,
- OnFillConsoleOutputCharacter, EXP_BREAK_OUT},
{"SetConsoleMode", 2, OnSetConsoleMode, EXP_BREAK_OUT},
{"WriteConsoleA", 5, OnWriteConsoleA, EXP_BREAK_OUT},
{"WriteConsoleW", 5, OnWriteConsoleW, EXP_BREAK_OUT},
@@ -986,9 +980,6 @@ OnXFirstBreakpoint(ExpProcess *proc, LPD
DWORD base;
ExpThreadInfo *tinfo;
-#if 0
- fprintf(stderr, "OnXFirstBreakpoint: proc=0x%08x\n", proc);
-#endif
for (tinfo = proc->threadList; tinfo != NULL; tinfo = tinfo->nextPtr) {
if (pDebEvent->dwThreadId == tinfo->dwThreadId) {
break;
@@ -1889,164 +1880,6 @@ OnWriteConsoleW(ExpProcess *proc, ExpThr
/*
*----------------------------------------------------------------------
*
- * OnFillConsoleOutputCharacter --
- *
- * This function gets called when an FillConsoleOutputCharacterA
- * or FillConsoleOutputCharacterW breakpoint is hit.
- *
- * Results:
- * None
- *
- * Side Effects:
- * Prints some output.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-OnFillConsoleOutputCharacter(ExpProcess *proc, ExpThreadInfo *threadInfo,
- ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
-{
- CHAR buf[4096];
- int bufpos;
- UCHAR c;
- PVOID ptr;
- DWORD i;
- DWORD len;
- BOOL bRet;
- COORD coord;
- DWORD lines, preCols, postCols;
- BOOL eol, bol; /* Needs clearing to end, beginning of line */
- CONSOLE_SCREEN_BUFFER_INFO info;
-
- LOG_ENTRY("FillConsoleOutputCharacter");
-
- if (*returnValue == 0) {
- return;
- }
-
- c = (UCHAR) threadInfo->args[1];
- len = threadInfo->args[2];
- coord = *((PCOORD) &(threadInfo->args[3]));
- ptr = (PVOID) threadInfo->args[4];
- if (ptr) {
- ReadSubprocessMemory(proc, ptr, &len, sizeof(DWORD));
- }
-
- preCols = 0;
- bufpos = 0;
- eol = bol = FALSE;
- if (coord.X) {
- preCols = ConsoleSize.X - coord.X;
- if (len <= preCols) {
- preCols = len;
- len = 0;
- if (len == preCols) {
- eol = TRUE;
- }
- } else {
- eol = TRUE;
- len -= preCols;
- }
- } else if (len < (DWORD) ConsoleSize.X) {
- bol = TRUE;
- preCols = len;
- len = 0;
- }
-
- lines = len / ConsoleSize.X;
- postCols = len % ConsoleSize.X;
-
- if (preCols) {
- if (bol) {
- /* Beginning of line to before end of line */
- if (c == ' ') {
- wsprintfA(&buf[bufpos], "\033[%d;%dH\033[1K",
- coord.Y+1, preCols+coord.X);
- bufpos += strlen(&buf[bufpos]);
- } else {
- wsprintfA(&buf[bufpos], "\033[%d;%dH",
- coord.Y+1, coord.X+1);
- bufpos += strlen(&buf[bufpos]);
- memset(&buf[bufpos], c, preCols);
- bufpos += preCols;
- }
- } else {
- /* After beginning of line to end of line */
- wsprintfA(&buf[bufpos], "\033[%d;%dH", coord.Y+1, coord.X+1);
- bufpos += strlen(&buf[bufpos]);
- if (eol && c == ' ') {
- wsprintfA(&buf[bufpos], "\033[K");
- bufpos += strlen(&buf[bufpos]);
- } else {
- memset(&buf[bufpos], c, preCols);
- bufpos += preCols;
- }
- }
- coord.X = 0;
- coord.Y++;
- }
- if (lines) {
- if ((c == ' ') && ((lines + coord.Y) >= (DWORD) ConsoleSize.Y)) {
- /* Clear to end of screen */
- wsprintfA(&buf[bufpos], "\033[%d;%dH\033[J",
- coord.Y+1, coord.X+1);
- bufpos += strlen(&buf[bufpos]);
- } else if ((c == ' ') && (coord.Y == 0) && (lines > 0)) {
- /* Clear to top of screen */
- wsprintfA(&buf[bufpos], "\033[%d;%dH\033[1J", lines, 1);
- bufpos += strlen(&buf[bufpos]);
- } else {
- for (i = 0; i < lines; i++) {
- wsprintfA(&buf[bufpos], "\033[%d;%dH",
- coord.Y+i+1, coord.X+1);
- bufpos += strlen(&buf[bufpos]);
- if (c == ' ') {
- wsprintfA(&buf[bufpos], "\033[2K");
- bufpos += strlen(&buf[bufpos]);
- } else {
- memset(&buf[bufpos], c, ConsoleSize.X);
- bufpos += ConsoleSize.X;
- }
- }
- }
- coord.Y += (SHORT) lines;
- }
-
- if (postCols) {
- if (c == ' ') {
- /* Clear to beginning of line */
- wsprintfA(&buf[bufpos], "\033[%d;%dH\033[1K",
- coord.Y+1, postCols+coord.X);
- bufpos += strlen(&buf[bufpos]);
- } else {
- wsprintfA(&buf[bufpos], "\033[%d;%dH", coord.X+1, coord.Y+1);
- bufpos += strlen(&buf[bufpos]);
- memset(&buf[bufpos], c, postCols);
- bufpos += postCols;
- }
- }
- if (GetConsoleScreenBufferInfo(HConsole, &info) == FALSE) {
- char errbuf[200];
- wsprintfA
- (errbuf,
- "Call to GetConsoleScreenBufferInfo failed: handle=0x%08x, err=0x%08x",
- HConsole, GetLastError());
- EXP_LOG("%s\n", errbuf);
- } else {
- CursorPosition = info.dwCursorPosition;
- wsprintfA(&buf[bufpos], "\033[%d;%dH",
- CursorPosition.Y+1, CursorPosition.X+1);
- bufpos += strlen(&buf[bufpos]);
- CursorKnown = TRUE;
- }
-
- bRet = ExpWriteMaster(HMaster, buf, bufpos);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* CreateVtSequence --
*
* When moving the cursor to a new location, this will create
============================================================
--- common/expect/expWinSlaveDrv.c 8083f91b61158ba8c933bb467c874f9e898f0392
+++ common/expect/expWinSlaveDrv.c 8154f89fb947a84240273726cd8bfc281dd560bb
@@ -7,7 +7,7 @@
* to a single console, we need to have a separate executable
* driving the slave process. Hence, a slave driver.
*
- * Copyright (c) 2006 AdaCore
+ * Copyright (c) 2006-2008 AdaCore
* Copyright (c) 1997 by Mitel Corporation
* Copyright (c) 1997-1998 by Gordon Chaffee
*
@@ -604,7 +604,7 @@ ExpWriteMaster(HANDLE hFile, LPCVOID buf
if (!bRet) EXP_LOG ("Error writing to master %8x\n", GetLastError());
return bRet;
}
- return 0;
+ return 0;
}
/*
@@ -731,33 +731,6 @@ ConvertAsciiToKeyEvents(UCHAR c, KEY_EVE
lc = c < 128 ? c : c - 128;
mods = ExpAsciiToKeyArray[lc].dwControlKeyState;
-#if 0
- if (mods & RIGHT_CTRL_PRESSED) {
- /* First, generate a control key press */
- keyRecord->bKeyDown = TRUE;
- keyRecord->wRepeatCount = 1;
- keyRecord->wVirtualKeyCode =
- ExpModifierKeyArray[EXP_KEY_CONTROL].wVirtualKeyCode;
- keyRecord->wVirtualScanCode =
- ExpModifierKeyArray[EXP_KEY_CONTROL].wVirtualScanCode;
- keyRecord->uChar.AsciiChar = 0;
- keyRecord->dwControlKeyState = RIGHT_CTRL_PRESSED;
- keyRecord++; n++;
- }
- if (mods & SHIFT_PRESSED) {
- /* First, generate a control key press */
- keyRecord->bKeyDown = TRUE;
- keyRecord->wRepeatCount = 1;
- keyRecord->wVirtualKeyCode =
- ExpModifierKeyArray[EXP_KEY_SHIFT].wVirtualKeyCode;
- keyRecord->wVirtualScanCode =
- ExpModifierKeyArray[EXP_KEY_SHIFT].wVirtualScanCode;
- keyRecord->uChar.AsciiChar = 0;
- keyRecord->dwControlKeyState = mods;
- keyRecord++; n++;
- }
-#endif
-
keyRecord->bKeyDown = TRUE;
keyRecord->wRepeatCount = 1;
keyRecord->wVirtualKeyCode = ExpAsciiToKeyArray[lc].wVirtualKeyCode;
@@ -774,32 +747,6 @@ ConvertAsciiToKeyEvents(UCHAR c, KEY_EVE
keyRecord->uChar.AsciiChar = c;
keyRecord++; n++;
-#if 0
- if (mods & SHIFT_PRESSED) {
- /* First, generate a control key press */
- keyRecord->bKeyDown = FALSE;
- keyRecord->wRepeatCount = 1;
- keyRecord->wVirtualKeyCode =
- ExpModifierKeyArray[EXP_KEY_SHIFT].wVirtualKeyCode;
- keyRecord->wVirtualScanCode =
- ExpModifierKeyArray[EXP_KEY_SHIFT].wVirtualScanCode;
- keyRecord->uChar.AsciiChar = 0;
- keyRecord->dwControlKeyState = mods & ~SHIFT_PRESSED;
- keyRecord++; n++;
- }
- if (mods & RIGHT_CTRL_PRESSED) {
- /* First, generate a control key press */
- keyRecord->bKeyDown = FALSE;
- keyRecord->wRepeatCount = 1;
- keyRecord->wVirtualKeyCode =
- ExpModifierKeyArray[EXP_KEY_CONTROL].wVirtualKeyCode;
- keyRecord->wVirtualScanCode =
- ExpModifierKeyArray[EXP_KEY_CONTROL].wVirtualScanCode;
- keyRecord->uChar.AsciiChar = 0;
- keyRecord->dwControlKeyState = 0;
- keyRecord++; n++;
- }
-#endif
return n;
}
============================================================
--- common/expect/expWinSlaveKey.c 7806192da61fff13bae9dd2db05d5a17e0bfda96
+++ common/expect/expWinSlaveKey.c b0092b57e4f632093e04558fdf23af74dfe48fcc
@@ -1,10 +1,11 @@
/*
* expWinSlaveKey.c --
*
- * This has tables to do conversions from ASCII characters to
+ * This has tables to do conversions from ASCII characters to
* console keyboard input records. Using them, a slave process
* can be driven as if someone was typing at the keyboard.
*
+ * Copyright (c) 2006-2008 AdaCore
* Copyright (c) 1997 by Mitel Corporation
*
* See the file "license.terms" for information on usage and redistribution
@@ -34,7 +35,7 @@ EXP_KEY ExpAsciiToKeyArray[256] = {
/* 7 */ { 71, 34, RIGHT_CTRL_PRESSED},
/* 8 */ { 72, 35, RIGHT_CTRL_PRESSED},
/* 9 */ { 9, 15, RIGHT_CTRL_PRESSED},
-/* 10 */ { 74, 36, RIGHT_CTRL_PRESSED},
+/* 10 */ { 13, 28, 0},
/* 11 */ { 75, 37, RIGHT_CTRL_PRESSED},
/* 12 */ { 76, 38, RIGHT_CTRL_PRESSED},
/* 13 */ { 13, 28, 0},
============================================================
--- common/src/ada_analyzer.adb e48fb046e6b60294b04084bdce94fe35b28db207
+++ common/src/ada_analyzer.adb 1110a7630da54fcbc4519f3d16419a1569d9ca7b
@@ -29,9 +29,6 @@ package body Ada_Analyzer is
use Indent_Stack.Stack;
- pragma Suppress (All_Checks);
- -- For efficiency
-
-----------------
-- Local types --
-----------------
============================================================
--- common/src/c_analyzer.adb c214a4c0d36664b9e129b21119abc556a922f59b
+++ common/src/c_analyzer.adb 28d7e6646cded8ee40f9b0a09c5955d4373eeece
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2001-2007, AdaCore --
+-- Copyright (C) 2001-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 --
@@ -252,9 +252,6 @@ package body C_Analyzer is
---------------
function Get_Token (S : String) return Token_Type is
- pragma Suppress (All_Checks);
- -- For efficiency
-
Second : Integer;
begin
if S'Length = 1 then
@@ -504,9 +501,6 @@ package body C_Analyzer is
Indent_Offset : Natural := 0;
Enable_Cpp : Boolean := False)
is
- pragma Suppress (All_Checks);
- -- For efficiency
-
None : constant := -1;
Default_Extended : Extended_Token;
@@ -559,7 +553,8 @@ package body C_Analyzer is
function Preprocessor_Directive return Boolean;
-- Handle preprocessor directive.
-- Assume that Buffer (Index) = '#'
- -- For now, only handle #if 0 as a multiple-line comment
+ -- For now, handle #if 0 as a multiple-line comment, and recognize
+ -- #include directives.
-- Return whether processing should be stopped.
procedure Replace_Text
@@ -712,7 +707,9 @@ package body C_Analyzer is
when Tok_Void =>
-- Tok_Void is used for blocks: {}
- if Value.Curly_Level = 0 then
+ if Value.Curly_Level = 0
+ and then Value.Name_Start /= 0
+ then
-- ??? Would be nice to be able to find the parameters
-- of this function
@@ -1042,11 +1039,18 @@ package body C_Analyzer is
end if;
end if;
- -- Skip line
+ -- Skip line and possible continuation lines (when using
+ -- backslash before and end-of-line char)
- while Index < Buffer'Last
- and then Buffer (Index) /= ASCII.LF
- loop
+ while Index < Buffer'Last loop
+ if Buffer (Index) = ASCII.LF then
+ if Buffer (Index - 1) = '\' then
+ New_Line;
+ else
+ exit;
+ end if;
+ end if;
+
Index := Index + 1;
end loop;
============================================================
--- common/src/gui_utils.adb aa2c4530bdbb2c9a6b343a0546c6f64effbd99c4
+++ common/src/gui_utils.adb da1b7624b0f09aa2848462d64714f6443a2198f1
@@ -1452,8 +1452,9 @@ package body GUI_Utils is
Use_Mnemonics : Boolean := True)
is
use type Widget_List.Glist;
- Children, Tmp : Widget_List.Glist;
+ Children, Tmp : Widget_List.Glist;
Label : Gtk_Label;
+ Box : Gtk_Box;
New_Name : String (Name'Range);
Last : Integer := New_Name'First;
@@ -1498,6 +1499,28 @@ package body GUI_Utils is
exit when Equal
(Get_Text (Label), New_Name (New_Name'First .. Last - 1),
Case_Sensitive => False);
+
+ elsif Get_Child (Menu_Item) /= null
+ and then Get_Child (Menu_Item).all in Gtk_Box_Record'Class
+ then
+ -- Support for radio menu items created by Gtkada.MDI
+ Box := Gtk_Box (Get_Child (Menu_Item));
+ if Get_Child (Box, 0) /= null
+ and then Get_Child (Box, 0).all in Gtk_Label_Record'Class
+ then
+ Label := Gtk_Label (Get_Child (Box, 0));
+ exit when Equal
+ (Get_Text (Label), New_Name (New_Name'First .. Last - 1),
+ Case_Sensitive => False);
+
+ elsif Get_Child (Box, 1) /= null
+ and then Get_Child (Box, 1).all in Gtk_Label_Record'Class
+ then
+ Label := Gtk_Label (Get_Child (Box, 1));
+ exit when Equal
+ (Get_Text (Label), New_Name (New_Name'First .. Last - 1),
+ Case_Sensitive => False);
+ end if;
end if;
Index := Index + 1;
============================================================
--- common/src/remote_descriptors.adb 16e78978059a5d6dba0940c99efd84d3fca0c499
+++ common/src/remote_descriptors.adb 69621d757d0ca95484c9009c7b0d382efb51ee54
@@ -17,11 +17,13 @@
-- Place - Suite 330, Boston, MA 02111-1307, USA. --
-----------------------------------------------------------------------
-with Password_Manager; use Password_Manager;
+with Password_Manager; use Password_Manager;
+with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Unchecked_Deallocation;
-with Basic_Types; use Basic_Types;
+with Ada.Strings.Fixed; use Ada.Strings.Fixed;
+with Basic_Types; use Basic_Types;
with Toolchains;
-with GNAT.Regpat; use GNAT.Regpat;
+with GNAT.Regpat; use GNAT.Regpat;
package body Remote_Descriptors is
@@ -183,7 +185,13 @@ package body Remote_Descriptors is
-- free the memory. Otherwise we would have to duplicate the code for
-- Free here to be sure we free all the fields.
- if Full_Exec = null then
+ -- We do not authorize Microsoft telnet here, as it is badly handled
+ -- by the GNAT.Expect.TTY.Remote package.
+
+ if Full_Exec = null
+ or else Index (To_Lower (Full_Exec.all), "system32\telnet") >=
+ Full_Exec'First
+ then
Free (Remote);
return;
end if;
============================================================
--- common/src/string_utils.adb c1cd13817cd5fc953da9d86b87921da12aead858
+++ common/src/string_utils.adb 018418c716cf44b345ba75fbe32ba882dc131588
@@ -757,6 +757,7 @@ package body String_Utils is
Char : Natural := S'First;
Next : Natural := Char;
begin
+
if Max_Length = Positive'Last then
Max := Positive'Last;
else
@@ -903,6 +904,68 @@ package body String_Utils is
end loop;
end Strip_CR;
+ ----------------------
+ -- Strip_CR_And_NUL --
+ ----------------------
+
+ procedure Strip_CR_And_NUL
+ (Text : in out String;
+ Last : out Integer;
+ CR_Found : out Boolean;
+ NUL_Found : out Boolean)
+ is
+ pragma Suppress (All_Checks);
+
+ J : Natural := Text'First;
+ begin
+ CR_Found := False;
+ NUL_Found := False;
+
+ if Text'Length = 0 then
+ Last := 0;
+ return;
+ end if;
+
+ loop
+ -- Manual unrolling for efficiency
+
+ exit when Text (J) = ASCII.CR
+ or else Text (J) = ASCII.NUL
+ or else J = Text'Last;
+ J := J + 1;
+
+ exit when Text (J) = ASCII.CR
+ or else Text (J) = ASCII.NUL
+ or else J = Text'Last;
+ J := J + 1;
+
+ exit when Text (J) = ASCII.CR
+ or else Text (J) = ASCII.NUL
+ or else J = Text'Last;
+ J := J + 1;
+ end loop;
+
+ case Text (J) is
+ when ASCII.NUL | ASCII.CR =>
+ Last := J - 1;
+ when others =>
+ Last := J;
+ return;
+ end case;
+
+ for Index in J + 1 .. Text'Last loop
+ case Text (Index) is
+ when ASCII.NUL =>
+ NUL_Found := True;
+ when ASCII.CR =>
+ CR_Found := True;
+ when others =>
+ Last := Last + 1;
+ Text (Last) := Text (Index);
+ end case;
+ end loop;
+ end Strip_CR_And_NUL;
+
-----------------------------
-- Strip_Ending_Linebreaks --
-----------------------------
@@ -1314,58 +1377,6 @@ package body String_Utils is
return Res (1 .. K);
end URL_Decode;
- -----------------
- -- XML_Protect --
- -----------------
-
- function XML_Protect (S : String) return String is
- function Count (S : String; C : Character) return Natural;
- -- Return the number of occurences of C in S
-
- -----------
- -- Count --
- -----------
-
- function Count (S : String; C : Character) return Natural is
- Res : Natural := 0;
- begin
- for J in S'Range loop
- if S (J) = C then
- Res := Res + 1;
- end if;
- end loop;
-
- return Res;
- end Count;
-
- Cnt : constant Natural :=
- 3 * Count (S, '<') + 3 * Count (S, '>') + 4 * Count (S, '&');
-
- Res : String (1 .. S'Length + Cnt);
- Idx : Natural := 0;
-
- begin
-
- for J in S'Range loop
- case S (J) is
- when '<' =>
- Res (Idx + 1 .. Idx + 4) := "<";
- Idx := Idx + 4;
- when '>' =>
- Res (Idx + 1 .. Idx + 4) := ">";
- Idx := Idx + 4;
- when '&' =>
- Res (Idx + 1 .. Idx + 5) := "&";
- Idx := Idx + 5;
- when others =>
- Res (Idx + 1) := S (J);
- Idx := Idx + 1;
- end case;
- end loop;
-
- return Res (Res'First .. Idx);
- end XML_Protect;
-
------------
-- Revert --
------------
============================================================
--- common/src/string_utils.ads 95c04b650c4852f43b9cd90c139a4340cb9358d3
+++ common/src/string_utils.ads bc0a8037f9a1ad28a01bb0e22fc98b0db8073c79
@@ -226,6 +226,13 @@ package String_Utils is
-- Text (Text'First .. Last) contains the new result.
-- CR_Found is set to True if a CR was found in Text.
+ procedure Strip_CR_And_NUL
+ (Text : in out String;
+ Last : out Integer;
+ CR_Found : out Boolean;
+ NUL_Found : out Boolean);
+ -- Same as Strip_CR, and strip also ASCII.NUL characters
+
function Strip_Ending_Linebreaks (Text : String) return String;
-- Return a version of Text after stripping all ending CR and LF
-- characters.
@@ -367,9 +374,6 @@ package String_Utils is
-- the character's ASCII hexadecimal code. For example a space is encoded
-- as %20.
- function XML_Protect (S : String) return String;
- -- Protect <, > and & to convert as < > and &
-
private
pragma Inline (Is_Blank);
pragma Inline (Looking_At);
============================================================
--- common/tty/terminals.c 432b6d80f244362e914ccaac82b1f1ac951709ad
+++ common/tty/terminals.c 24c96c580f380eaca06e33c3d7a8ccbbaa673950
@@ -865,7 +865,7 @@ nt_spawnve (char *exe, char **argv, char
targ = argv;
while (*targ)
{
- char * p = *targ;
+ char *p = *targ;
int need_quotes = 0;
int escape_char_run = 0;
@@ -905,7 +905,8 @@ nt_spawnve (char *exe, char **argv, char
if (escape_char_run > 0)
arglen += escape_char_run;
}
- arglen += strlen (*targ++) + 1;
+ arglen += strlen (*targ) + 1;
+ targ++;
}
is_gui = is_gui_app (argv[0]);
@@ -1095,6 +1096,8 @@ gvd_setup_child_communication (struct GV
char **nargv;
int argc;
int i;
+ char pipeNameIn[100];
+ char pipeNameOut[100];
HANDLE hSlaveOutDrv = NULL; /* Handle to communicate with slave driver */
HANDLE hSlaveInDrv = NULL;
@@ -1121,16 +1124,14 @@ gvd_setup_child_communication (struct GV
process->usePipe = TRUE;
} else {
- char pipeNameIn[100];
- char pipeNameOut[100];
static int pipeNameId = 0;
process->w_infd = NULL;
process->w_outfd = NULL;
- sprintf(pipeNameIn, "%sIn%08x%08x", EXP_PIPE_BASENAME,
+ sprintf(pipeNameIn, "%sIn%08x_%08x", EXP_PIPE_BASENAME,
GetCurrentProcessId(), pipeNameId);
- sprintf(pipeNameOut, "%sOut%08x%08x", EXP_PIPE_BASENAME,
+ sprintf(pipeNameOut, "%sOut%08x_%08x", EXP_PIPE_BASENAME,
GetCurrentProcessId(), pipeNameId);
pipeNameId++;
@@ -1155,13 +1156,12 @@ gvd_setup_child_communication (struct GV
goto end;
}
for (argc=0; argv[argc] != NULL; argc++) ;
- argc += 1;
nargv = (char **) malloc (sizeof (char*) * (argc + 4));
nargv[0] = slavePath;
nargv[1] = pipeNameIn;
nargv[2] = pipeNameOut;
- for (i = 0; i < argc; i++) nargv[i + 3] = argv[i];
+ for (i = 0; i <= argc; i++) nargv[i + 3] = argv[i];
process->usePipe = FALSE;
}
============================================================
--- custom/src/expect_interface.adb e2ea51e89ba08a4e0bd7191c4002329bfc2e4a59
+++ custom/src/expect_interface.adb 986689b8618ae7dffa267cc673725f3611a2a781
@@ -68,6 +68,7 @@ package body Expect_Interface is
Case_Sensitive_Cst : aliased constant String := "case_sensitive_regexp";
Rows_Cst : aliased constant String := "rows";
Columns_Cst : aliased constant String := "columns";
+ Strip_CR_Cst : aliased constant String := "strip_cr";
Constructor_Args : constant Cst_Argument_List :=
(2 => Command_Cst'Access,
@@ -82,7 +83,8 @@ package body Expect_Interface is
11 => Remote_Server_Cst'Access,
12 => Show_Command_Cst'Access,
13 => Single_Line_Cst'Access,
- 14 => Case_Sensitive_Cst'Access);
+ 14 => Case_Sensitive_Cst'Access,
+ 15 => Strip_CR_Cst'Access);
Send_Args : constant Cst_Argument_List :=
(Command_Cst'Access, Add_Lf_Cst'Access);
@@ -106,6 +108,13 @@ package body Expect_Interface is
Progress_Current : Natural := 1; -- Parenthesis within the regexp
Progress_Final : Natural := 2; -- Parenthesis within the regexp
+ Strip_CR : Boolean := True;
+ -- Whether ASCII.CR characters should be stripped from the output of
+ -- the process before passing the string on to GPS. This is in general
+ -- suitable especially on Windows, but should be set to False if the
+ -- program is carefully outputing escape sequences to manage the screen,
+ -- as unix shells do for instance
+
In_Expect : Boolean := False;
-- True if we are processing the 'GPS.Process.expect' function. This
-- temporarily disables periodically checking for matching output for
@@ -308,8 +317,13 @@ package body Expect_Interface is
if not Command.In_Expect then
Expect (Command.Pd.all, Result, All_Match, Timeout => 1);
if Result /= Expect_Timeout then
- Output_Cb (Custom_Action_Access (Command),
- Strip_CR (Expect_Out (Command.Pd.all)));
+ if Command.Strip_CR then
+ Output_Cb (Custom_Action_Access (Command),
+ Strip_CR (Expect_Out (Command.Pd.all)));
+ else
+ Output_Cb (Custom_Action_Access (Command),
+ Expect_Out (Command.Pd.all));
+ end if;
end if;
end if;
@@ -322,8 +336,13 @@ package body Expect_Interface is
when Process_Died =>
if not Command.In_Expect and then Command.Pd /= null then
- Output_Cb (Custom_Action_Access (Command),
- Strip_CR (Expect_Out (Command.Pd.all)));
+ if Command.Strip_CR then
+ Output_Cb (Custom_Action_Access (Command),
+ Strip_CR (Expect_Out (Command.Pd.all)));
+ else
+ Output_Cb (Custom_Action_Access (Command),
+ Expect_Out (Command.Pd.all));
+ end if;
end if;
Close (Command.Pd.all, Command.Status);
@@ -676,12 +695,21 @@ package body Expect_Interface is
-- Let the On_Match callback know about the output
- declare
- Str : constant String := Strip_CR (Expect_Out (Action.Pd.all));
- begin
- Output_Cb (Action, Str);
- Concat (Output, Str);
- end;
+ if Action.Strip_CR then
+ declare
+ Str : constant String := Strip_CR (Expect_Out (Action.Pd.all));
+ begin
+ Output_Cb (Action, Str);
+ Concat (Output, Str);
+ end;
+ else
+ declare
+ Str : constant String := Expect_Out (Action.Pd.all);
+ begin
+ Output_Cb (Action, Str);
+ Concat (Output, Str);
+ end;
+ end if;
if Pattern /= "" and then Result = 1 then
Trace (Me, "Interactive_Expect: Matched");
@@ -735,8 +763,21 @@ package body Expect_Interface is
User_Data : System.Address)
is
pragma Unreferenced (Description, User_Data);
+ Last : Integer := Str'First;
begin
- Trace (Me, "Receiving: " & Str);
+ for S in Str'Range loop
+ if Str (S) < ' ' then
+ if Last < S then
+ Trace (Me, "Receiving: " & Str (Last .. S - 1));
+ end if;
+ Trace (Me, "Receiving< ASCII." & Character'Image (Str (S)));
+ Last := S + 1;
+ end if;
+ end loop;
+
+ if Last <= Str'Last then
+ Trace (Me, "Receiving: " & Str (Last .. Str'Last));
+ end if;
end Out_Trace_Filter;
-----------------------
@@ -802,6 +843,7 @@ package body Expect_Interface is
Remote_Server : constant String := Nth_Arg (Data, 11, "");
Single_Line : constant Boolean := Nth_Arg (Data, 13, False);
Case_Sensitive : constant Boolean := Nth_Arg (Data, 14, True);
+ Strip_CR : constant Boolean := Nth_Arg (Data, 15, True);
Success : Boolean;
Flags : Regexp_Flags := Multiple_Lines;
@@ -822,6 +864,7 @@ package body Expect_Interface is
D.Before_Kill := Nth_Arg (Data, 10, null);
D.Show_Command := Nth_Arg (Data, 12, False);
D.Inst := Inst;
+ D.Strip_CR := Strip_CR;
if Progress_Regexp /= "" then
D.Progress_Regexp := new Pattern_Matcher'
@@ -1049,7 +1092,7 @@ package body Expect_Interface is
Register_Command
(Kernel, Constructor_Method,
Minimum_Args => 1,
- Maximum_Args => 14,
+ Maximum_Args => 15,
Class => Process_Class,
Handler => Custom_Spawn_Handler'Access);
Register_Command
============================================================
--- distrib/.gps_wrapper 6de489133800c2f03d20eecea997fcbfc0f31362
+++ distrib/.gps_wrapper 310897dc0ed9109095fb7b819b4be212be10cefa
@@ -37,6 +37,13 @@ fi
export FONTCONFIG_FILE
fi
+if [ -f /etc/fonts/fonts.conf ]; then
+ if grep -q '<cachedir>' /etc/fonts/fonts.conf; then
+ FONTCONFIG_FILE=/etc/fonts/fonts.conf
+ export FONTCONFIG_FILE
+ fi
+fi
+
if [ -f $root/etc/pango/pangorc ]; then
PANGO_RC_FILE=$root/etc/pango/pangorc
export PANGO_RC_FILE
============================================================
--- distrib/features 955c2600ffb1adf38f2d1d50a1030210e110eab4
+++ distrib/features fed18c7ae439ae2f39933a0d060618822c36435d
@@ -1,5 +1,5 @@
====================================================
-GPS 4.4 NEW FEATURES LIST Current as of Nov 03, 2008
+GPS 4.4 NEW FEATURES LIST Current as of Nov 24, 2008
====================================================
Copyright (c) 2007-2008, AdaCore
@@ -15,6 +15,13 @@ New features on 4.4.0
New features on 4.4.0
---------------------
+NF-44-HB21-028 GPS.execute_action now works for /Window menu (2008-11-24)
+
+ The python command GPS.execute_action can now be used for the items in
+ the /Window menu. Previously, you could not access these items and had
+ to use the (still recommended) approach of using GPS.MDI.get to raise
+ a window.
+
NF-44-HA23-007 New menus in Edit->Selection (2008-10-23)
The following new menus are available under Edit->Selection:
@@ -43,6 +50,12 @@ NF-44-H927-002 Speed up update VCS actio
At the same time GPS has been enhanced to parse the update output
to update file status accordingly.
+NF-44-H908-010 shell.py supports colors and completion (2008-11-14)
+
+ The shell.py plugin allows you to open a window with a system shell.
+ It now supports completion (if your shell does) and colors, as well
+ as being able to run more complex applications like vi
+
NF-44-GB03-007 Export debugger data window to png (2008-10-01)
The debugger Data window can now be exported to png like all
============================================================
--- distrib/known-problems 7ba5937d702b36c642620b7bdcc8e50822ff3c12
+++ distrib/known-problems 3beace0c2593a1bd42fb299aa4695fc326f142bf
@@ -1,5 +1,25 @@ Known Problems fixed in GPS 4.4.0
Known Problems fixed in GPS 4.4.0
+- HB21-038: Cannot use native Win32 aspell program with ispell plug-in
+ Problem: If you enable the ispell.py plug-in, GPS appears to hang when
+ using the native Win32 aspell program and will never report any
+ spelling errors.
+ Workaround: Use a Cygwin version of aspell.
+
+- HB17-006: Wrong coverage highlighting
+ Problem: GPS doesn't update the list of uncovered lines in the locations
+ window after reloading coverage information for a single file.
+ As a side effect covered lines may be highlighted as uncovered
+ lines.
+ Workaround: Hide and show coverage information for the file using the source
+ editor's contextual menu after reloading coverage information.
+
+- HB13-014: Cannot load files with NUL characters
+ Problem: GPS ignores characters beyond a NUL character when loading
+ a source file in an editor. It will now strip the NUL character
+ and take into account the reamining file contents.
+ Workaround: Remove the NUL characters before loading the file in GPS.
+
- 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
============================================================
--- distrib.gpr a5e5483531e18c52aa68803aa5f790d983cc436c
+++ distrib.gpr 1c4f55d50b5e853ef35cfebdb97fe92a7e7e8205
@@ -6,8 +6,17 @@ project Distrib is
for Languages use ("text");
- for Source_Files use ("features", "known-problems", "COPYING", "README", "doinstall");
+ package Naming is
+ for Implementation_Suffix ("text") use ".txt";
+ for Implementation_Exceptions ("text") use
+ ("features", "known-problems", "COPYING", "README", "doinstall");
+ end Naming;
+
+ package Compiler is
+ for Driver ("text") use "";
+ end Compiler;
+
package IDE renames Shared.IDE;
end Distrib;
============================================================
--- docgen2/resources/html.tmpl 598511d24a2befc57b1658ac2796d4ea4e84d7ab
+++ docgen2/resources/html.tmpl 6ce4eb875323c71d55cfee366c8cfdafdf904776
@@ -11,8 +11,9 @@
Package: @_PACKAGE_NAME_@
@@END_IF@@
</title>
- <link rel='stylesheet' href='support/docgen.css' type='text/css'/>
- <link rel='stylesheet' href='support/tags.css' type='text/css'/>
+ @@TABLE@@
+ <link rel='stylesheet' href='support/@_CSSFILES_@' type='text/css'/>
+ @@END_TABLE@@
<script src='support/docgen.js' type='text/javascript' charset='utf-8'></script>
</head>
<body onload="onloadDoc();">
============================================================
--- docgen2/src/docgen2-scripts.adb 1485b25d4a6dd76b2afdb4300a8e7a8839bae511
+++ docgen2/src/docgen2-scripts.adb 8af6e3a38748a5291d5f2bc8eb652f8f75c5265f
@@ -17,13 +17,11 @@
-- Place - Suite 330, Boston, MA 02111-1307, USA. --
-----------------------------------------------------------------------
-with Ada.Containers.Vectors;
with System.OS_Lib; use System.OS_Lib;
with GPS.Kernel; use GPS.Kernel;
with GNATCOLL.Scripts; use GNATCOLL.Scripts;
with GNATCOLL.Traces; use GNATCOLL.Traces;
with GPS.Kernel.Scripts; use GPS.Kernel.Scripts;
--- with GPS.Kernel.Standard_Hooks; use GPS.Kernel.Standard_Hooks;
with GPS.Intl; use GPS.Intl;
package body Docgen2.Scripts is
@@ -51,6 +49,8 @@ package body Docgen2.Scripts is
(Natural, Custom_Tag_Property);
Custom_Tags : Custom_Tag_Vectors.Vector;
+ Custom_CSS_Files : Custom_CSS_File_Vectors.Vector;
+
Tag_Cst : aliased constant String := "tag";
On_Start_Cst : aliased constant String := "on_start";
On_Match_Cst : aliased constant String := "on_match";
@@ -183,7 +183,22 @@ package body Docgen2.Scripts is
is
Prop : Custom_Tag_Property_Access;
begin
- if Command = "register_tag_handler" then
+ if Command = "register_css" then
+ declare
+ Filename : constant String := Nth_Arg (Data, 1);
+ File : constant GNATCOLL.VFS.Virtual_File :=
+ GNATCOLL.VFS.Create (Filename);
+ begin
+ if not Is_Regular_File (File) then
+ Set_Error_Msg
+ (Data, -"Could not find file " & File.Full_Name.all);
+ return;
+ end if;
+
+ Custom_CSS_Files.Append (File);
+ end;
+
+ elsif Command = "register_tag_handler" then
Name_Parameters (Data, Register_Args);
declare
Inst : constant Class_Instance :=
@@ -266,6 +281,13 @@ package body Docgen2.Scripts is
(Get_Scripts (Kernel));
begin
Register_Command
+ (Kernel, "register_css",
+ Minimum_Args => 1,
+ Maximum_Args => 1,
+ Class => Docgen_Class,
+ Handler => Docgen_Handler'Access,
+ Static_Method => True);
+ Register_Command
(Kernel, "register_tag_handler",
Minimum_Args => 1,
Maximum_Args => 1,
@@ -292,6 +314,15 @@ package body Docgen2.Scripts is
Handler => Custom_Tag_Handler'Access);
end Register_Commands;
+ --------------------------
+ -- Get_Custom_CSS_Files --
+ --------------------------
+
+ function Get_Custom_CSS_Files return Custom_CSS_File_Vectors.Vector is
+ begin
+ return Custom_CSS_Files;
+ end Get_Custom_CSS_Files;
+
-------------------
-- Is_Custom_Tag --
-------------------
============================================================
--- docgen2/src/docgen2-scripts.ads b3cd97b3587f8483b61deb316ca20aa0b645d7f2
+++ docgen2/src/docgen2-scripts.ads f907b6422660660e2304f3b0a45849715750f609
@@ -17,14 +17,21 @@
-- Place - Suite 330, Boston, MA 02111-1307, USA. --
-----------------------------------------------------------------------
+with Ada.Containers.Vectors;
+with GNATCOLL.VFS; use GNATCOLL.VFS;
with GPS.Kernel;
package Docgen2.Scripts is
+ package Custom_CSS_File_Vectors is new Ada.Containers.Vectors
+ (Natural, GNATCOLL.VFS.Virtual_File);
+
procedure Register_Commands
(Kernel : access GPS.Kernel.Kernel_Handle_Record'Class);
-- Register script commands and hooks
+ function Get_Custom_CSS_Files return Custom_CSS_File_Vectors.Vector;
+
function Is_Custom_Tag (Tag : String) return Boolean;
-- Tell if Tag is a user-defined custom tag
============================================================
--- docgen2/src/docgen2.adb e83c0fb526eca842ba8891ceed0337f53e60eb76
+++ docgen2/src/docgen2.adb 89cb09f74074dd20093ea905450cc256d7f84e24
@@ -2803,11 +2803,29 @@ package body Docgen2 is
is
Names_Tag : Tag;
Files_Tag : Tag;
+ CSS_Tag : Tag;
+ Cursor : Docgen2.Scripts.Custom_CSS_File_Vectors.Cursor;
+ List : constant Docgen2.Scripts.Custom_CSS_File_Vectors.Vector :=
+ Docgen2.Scripts.Get_Custom_CSS_Files;
+ File : GNATCOLL.VFS.Virtual_File;
+
begin
+ -- First set the base docgen2 css file.
+ Append (CSS_Tag, "docgen.css");
+ -- Now add custom ones
+ Cursor := List.First;
+ while Docgen2.Scripts.Custom_CSS_File_Vectors.Has_Element (Cursor) loop
+ File := Docgen2.Scripts.Custom_CSS_File_Vectors.Element (Cursor);
+ Append (CSS_Tag, File.Base_Name);
+ Docgen2.Scripts.Custom_CSS_File_Vectors.Next (Cursor);
+ end loop;
+
+ -- And generate tags for custom indexes
for J in Cmd.Custom_Files.First_Index .. Cmd.Custom_Files.Last_Index loop
Append (Names_Tag, To_String (Cmd.Custom_Files.Element (J).Name));
Append (Files_Tag, To_String (Cmd.Custom_Files.Element (J).Filename));
end loop;
+ Insert (Trans, Assoc ("CSSFILES", CSS_Tag));
Insert (Trans, Assoc ("USER_DEFINED_NAMES", Names_Tag));
Insert (Trans, Assoc ("USER_DEFINED_FILES", Files_Tag));
end Add_Custom_Index;
@@ -3001,10 +3019,10 @@ package body Docgen2 is
then
declare
Child : constant String :=
- Print_Tree
- (Xref.Name.all,
- Xref.Xref,
- Depth + 1);
+ Print_Tree
+ (Xref.Name.all,
+ Xref.Xref,
+ Depth + 1);
begin
if Child /= "" then
Append (Tree_Children_Tag, Child);
@@ -3055,7 +3073,7 @@ package body Docgen2 is
Ada.Text_IO.Create
(File_Handle,
Name => Get_Doc_Directory (Cmd) &
- Cmd.Backend.To_Destination_Name ("tree"));
+ Cmd.Backend.To_Destination_Name ("tree"));
Ada.Text_IO.Put (File_Handle, Parse (Tmpl, Translation, Cached => True));
Ada.Text_IO.Close (File_Handle);
end Generate_Trees;
@@ -3080,7 +3098,7 @@ package body Docgen2 is
Kind_Tag : Tag;
File_Handle : File_Type;
- type Index_Type is new Natural range 1 .. 2*27;
+ type Index_Type is new Natural range 1 .. 2 * 27;
Local_List : array (Index_Type) of Entity_Info_List.Vector;
List_Index : Index_Type;
First_List : Boolean;
@@ -3299,7 +3317,7 @@ package body Docgen2 is
Ada.Text_IO.Create
(File_Handle,
Name => Get_Doc_Directory (Cmd) &
- Cmd.Backend.To_Destination_Name ("index"));
+ Cmd.Backend.To_Destination_Name ("index"));
Ada.Text_IO.Put
(File_Handle, Parse (Tmpl, Translation, Cached => True));
Ada.Text_IO.Close (File_Handle);
@@ -3379,7 +3397,18 @@ package body Docgen2 is
Dst_Dir : constant String :=
Get_Doc_Directory (Cmd);
Success : Boolean;
+ Cursor : Docgen2.Scripts.Custom_CSS_File_Vectors.Cursor;
+ List : constant Docgen2.Scripts.Custom_CSS_File_Vectors.Vector :=
+ Docgen2.Scripts.Get_Custom_CSS_Files;
+ File : GNATCOLL.VFS.Virtual_File;
begin
+ Cursor := List.First;
+ while Docgen2.Scripts.Custom_CSS_File_Vectors.Has_Element (Cursor) loop
+ File := Docgen2.Scripts.Custom_CSS_File_Vectors.Element (Cursor);
+ File.Copy (Dst_Dir & Base_Name (File), Success);
+ Docgen2.Scripts.Custom_CSS_File_Vectors.Next (Cursor);
+ end loop;
+
Src_Dir.Copy (Dst_Dir & Base_Dir_Name (Src_Dir), Success);
pragma Assert (Success);
end Generate_Support_Files;
============================================================
--- docgen2/src/docgen2_backend-html.adb dc423c28d3b91f7d617eb94d86701bd34e6cb30b
+++ docgen2/src/docgen2_backend-html.adb 60b1acaac089ddd5535b5870406cdf9c4e927f02
@@ -19,7 +19,7 @@ with Ada.Strings.Maps; use Ada.Stri
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps; use Ada.Strings.Maps;
-with String_Utils; use String_Utils;
+with Glib.Xml_Int; use Glib.Xml_Int;
package body Docgen2_Backend.HTML is
@@ -168,7 +168,7 @@ package body Docgen2_Backend.HTML is
is
pragma Unreferenced (Backend);
begin
- return XML_Protect (S);
+ return Glib.Xml_Int.Protect (S);
end Filter;
-------------
============================================================
--- docs/docs.gpr 7387a9bd2ae78409e99e0dad2ba3bf14dd9a9a72
+++ docs/docs.gpr efd9e7770f76d7a01be0ec21a19d4e16d2176dd3
@@ -9,6 +9,10 @@ project Docs is
for Specification_Suffix ("texinfo") use ".texi";
end Naming;
+ package Compiler is
+ for Driver ("Texinfo") use "";
+ end Compiler;
+
package IDE renames Shared.IDE;
end Docs;
============================================================
--- docs/gps.texi 26da3e6ae8c6041bc584d4d861f322b26e45e402
+++ docs/gps.texi 1554dec52b7bd9a3fbedd69d91f0f18bd00912e0
@@ -29,8 +29,8 @@
@end flushright
@sp 2
@subtitle Version @value{GPSVersion}
-@subtitle Document revision level $Revision: 132094 $
-@subtitle Date: $Date: 2008-11-07 02:21:51 +0100 (Fri, 07 Nov 2008) $
+@subtitle Document revision level $Revision: 132507 $
+@subtitle Date: $Date: 2008-11-19 14:08:20 +0100 (Wed, 19 Nov 2008) $
@author AdaCore
@page
@@ -57,7 +57,7 @@ @top Using the GNAT Programming Studio
Version @value{GPSVersion}
-Date: $Date: 2008-11-07 02:21:51 +0100 (Fri, 07 Nov 2008) $
+Date: $Date: 2008-11-19 14:08:20 +0100 (Wed, 19 Nov 2008) $
Copyright @copyright{} 2001-2008, AdaCore
This document may be copied, in whole or in part, in any form or by any
@@ -8325,6 +8325,67 @@ @section Documentation Generation
you should refer to the GPS python extension documentation (from GPS Help menu,
choose 'Python extensions').
+Some default tags have been already defined by GPS in
+@file{<install_dir>/share/gps/plug-ins/docgen_base_tags.py}. The tags handled
+are:
+
+@table @code
+@item summary
+Short summary of what a package or method is doing.
+@item description
+Full description of what a package or method is doing.
+@item parameter (attribute "name" is expected)
+Description of the parameter named "name".
+@item exception
+Description of possible exceptions raised by the method.
+@item seealso
+Reference to another package, method, type, etc.
+@item c_version
+For bindings, the version of the C file.
+@item group
+For packages, this builds an index of all packages in the project grouped by
+categories.
+@end table
+
+The following sample shows how those tags are translated:
+@smallexample
+-- <description>
+-- This is the main description for this package. It can contain a complete
+-- desciription with some xml characters as < or >.
+-- </description>
+-- <group>Group1</group>
+-- <c_version>1.0.0</c_version>
+package Pkg is
+
+ procedure Test (Param : Integer);
+ -- <summary>Test procedure with a single parameter</summary>
+ -- <parameter name="Param">An Integer</parameter>
+ -- <exception>No exception</exception>
+ -- <seealso>Test2</seealso>
+
+ procedure Test2 (Param1 : Integer; Param2 : Natural);
+ -- <summary>Test procedure with two parameters</summary>
+ -- <parameter name="Param1">An Integer</parameter>
+ -- <parameter name="Param2">A Natural</parameter>
+ -- <exception>System.Assertions.Assert_Failure if Param1 < 0</exception>
+ -- <seealso>Test</seealso>
+
+end Pkg;
+@end smallexample
+
+Its documentation will be:
+
+@iftex
+@cindex screen shot
+@image{docgen, 17cm}
+@end iftex
+
+@ifhtml
+@cindex screen shot
+@image{docgen}
+@end ifhtml
+
+
@c For a description of the
@c documentation generator renderer @pxref{Defining a documentation format}.
@@ -8838,7 +8899,8 @@ @subsection Connection settings
@xref{Defining a remote connection tool}, if you need to add a
specific tool.
Note also that if one of those tools is not installed (e.g. is not in
-your path), then it won't appear in the tools list.
+your path), then it won't appear in the tools list. Some tools incompatible
+with GPS will not be displayed either, such as the Microsoft telnet client.
@item
The shell tells GPS what shell runs on the remote server. The following unix
shells are supported by GPS: sh, bash, csh and tcsh. Windows' shell is also
============================================================
--- examples/python/doc.py e2ca4257668571dbc1fb5aff448662a21b74021c
+++ examples/python/doc.py 02a750afc5a4e2ed87e7edb15441f319744c7ef6
@@ -7,14 +7,17 @@ from pygps import delayed_exit
from GPS import *
from pygps import delayed_exit
-# Set the preferences. You can adjust them at your convenience.
-Preference ("Doc-Process-Body").set (True)
-Preference ("Doc-Show-Private").set (True)
-Preference ("Doc-References").set (True)
-Preference ("Doc-Up-To-Date-Only").set (False)
+def on_gps_started (hook):
+ # Set the preferences. You can adjust them at your convenience.
+ Preference ("Doc-Process-Body").set (True)
+ Preference ("Doc-Show-Private").set (True)
+ Preference ("Doc-References").set (True)
+ Preference ("Doc-Up-To-Date-Only").set (False)
-# Generate documentation for the root projects and all subprojects.
-Project.root().generate_doc (recursive=True)
+ # Generate documentation for the root projects and all subprojects.
+ Project.root().generate_doc (recursive=True)
-# Try to exit every 10 seconds.
-delayed_exit (10000)
+ # Try to exit every 10 seconds.
+ delayed_exit (10000)
+
+GPS.Hook ("gps_started").add (on_gps_started)
============================================================
--- gnatlib/Makefile 34afe312b8c27be06ca8c3d4d2fbdb407b2301c5
+++ gnatlib/Makefile 598d5ec26f6b261e8c000eb281fe4df44c01fe59
@@ -22,12 +22,16 @@ build_library_type:
build_library_type:
${MAKE} -C src -f Makefile.gnatcoll
+ifeq (${WITH_PYTHON},yes)
${MAKE} -C src -f Makefile.python
+endif
ifeq (${WITH_GTK},yes)
${MAKE} -C src -f Makefile.gtk
endif
+ifeq (${WITH_POSTGRES},yes)
${MAKE} -C src -f Makefile.postgres
$(MAKE) -C src -f Makefile.tools
+endif
examples:
${MAKE} -C examples
@@ -53,13 +57,17 @@ install_library_type:
${MKDIR} ${includedir}/${TARNAME}
${MKDIR} ${datadir}/gps/plug-ins
${MAKE} -C src -f Makefile.gnatcoll install
+ifeq (${WITH_PYTHON},yes)
${MAKE} -C src -f Makefile.python install
+endif
${MAKE} -C docs install
ifeq (${WITH_GTK},yes)
${MAKE} -C src -f Makefile.gtk install
endif
+ifeq (${WITH_POSTGRES},yes)
${MAKE} -C src -f Makefile.postgres install
${MAKE} -C src -f Makefile.tools install
+endif
${CP} distrib/gnatcoll_gps.xml ${datadir}/gps/plug-ins
${CP} distrib/*.gpr ${libdir}/gnat
============================================================
--- gnatlib/docs/gnatcoll.texi eb8a3ed4a77c455dc2c85e534a5f560971839b11
+++ gnatlib/docs/gnatcoll.texi 422b53945eaf614a48ad68e75da3c7087408ebf7
@@ -616,11 +616,11 @@ @subsection The Python language
}
@noindent
-@cindex GNAT.Python
-@cindex gnat-python.ads
+@cindex GNATCOLL.Python
+@cindex gnatcoll-python.ads
In addition to the API common to all languages (@pxref{Scripts API}),
@value{gnatcoll} also comes with a low-level interface to the python
-library. This interface is available in the @file{GNAT.Python} package.
+library. This interface is available in the @file{GNATCOLL.Python} package.
In general, it is much simpler to use the common API rather than this
specialized one, though, since otherwise you will need to take care of lots
of details like memory management, conversion to and from python types,@dots{}
@@ -707,7 +707,7 @@ @subsection Classes exported to all lang
In addition to the functions exported by each specific scripting language,
as described above, @value{gnatcoll} exports the following to all the
scripting languages. These are exported when your Ada code calls the
-Ada procedure @code{GNAT.Scripts.Register_Standard_Classes}, which should
+Ada procedure @code{GNATCOLL.Scripts.Register_Standard_Classes}, which should
done after you have loaded all the scripting languages.
@deftp Class Console
@@ -722,7 +722,8 @@ @subsection Classes exported to all lang
and @code{sys.stderr} are redirected to an instance of that class. If you
want to see python's error messages or usual output in your application,
you must register that class, and define a default console for your
-scripting language through calls to @code{GNAT.Scripts.Set_Default_Console}.
+scripting language through calls to
+@code{GNATCOLL.Scripts.Set_Default_Console}.
You can later add new methods to this class, which would be specific to your
application. Or you can derive this class into a new class to achieve a similar
@@ -771,7 +772,7 @@ @section Scripts API
As described above, @value{gnatcoll} contains several levels of API. In
particular, it provides a low-level interface to python, in the packages
-@code{GNAT.Python}. This interface is used by the rest of @value{gnatcoll},
+@code{GNATCOLL.Python}. This interface is used by the rest of @value{gnatcoll},
but is likely too low-level to really be convenient in your applications,
since you need to take care of memory management and type conversions by
yourself.
@@ -853,7 +854,7 @@ @subsubsection Create the scripts reposi
@subsubsection Create the scripts repository
@c -----------------------------------------------------------------------
@noindent
-The type @code{GNAT.Scripts.Scripts_Repository} will contain various
+The type @code{GNATCOLL.Scripts.Scripts_Repository} will contain various
variables common to all the scripting languages, as well as a list of the
languages that were activated. This is the starting point for all other
types, since from there you have access to everything. You will have only
@@ -872,7 +873,7 @@ @subsubsection Create the scripts reposi
As a result, the code would look like
-@CODESAMPLE{@b{with} GNAT.Scripts;@NL{}
+@CODESAMPLE{@b{with} GNATCOLL.Scripts;@NL{}
Repo : Scripts_Repository := @b{new} Scripts_Repository_Data;}
@noindent
@@ -902,8 +903,8 @@ @subsubsection Loading the scripting lan
This is done through a simple call to one or more subprograms. The following
example registers both the shell and python languages
-@CODESAMPLE{@b{with} GNAT.Scripts.Python;@NL{}
-@b{with} GNAT.Scripts.Shell;@NL{}
+@CODESAMPLE{@b{with} GNATCOLL.Scripts.Python;@NL{}
+@b{with} GNATCOLL.Scripts.Shell;@NL{}
Register_Shell_Scripting (Repo);@NL{}
Register_Python_Scripting (Repo, "MyModule");}
@@ -955,8 +956,8 @@ @subsection Creating interactive console
for such input.
@value{gnatcoll} solved this problem by using an abstract class
-@code{GNAT.Scripts.Virtual_Console_Record} that defines an API for these
-consoles. This API is used throughout @code{GNAT.Scripts} whenever input or
+@code{GNATCOLL.Scripts.Virtual_Console_Record} that defines an API for these
+consoles. This API is used throughout @code{GNATCOLL.Scripts} whenever input or
output has to be performed.
@TIP{The @file{scripts/examples} directory in the @value{gnatcoll} package
@@ -966,7 +967,7 @@ @subsection Creating interactive console
provide an actual implementation for these @code{Virtual_Console}, specific
to your application. This could be a graphical text window, or based on
@code{Ada.Text_IO}. The full API is fully documented in
-@file{gnat-scripts.ads}, but here is a list of the main subprograms that
+@file{gnatcoll-scripts.ads}, but here is a list of the main subprograms that
need to be overriden.
@defmethod Virtual_Console Insert_Text Txt
@@ -999,14 +1000,16 @@ @subsection Creating interactive console
@defmethod Virtual_Console Set_Data_Primitive Instance
@defmethodx Virtual_Console Get_Instance Console
These two methods are responsible for storing an instance of @var{Console}
-into a @code{GNAT.Scripts.Class_Instance}. Such an instance is what the user
+into a @code{GNATCOLL.Scripts.Class_Instance}. Such an instance is
+what the user
manipulates from his scripting language. But when he executes a method, the
Ada callback must know how to get the associated @code{Virtual_Console}
back to perform actual operations on it.
-These methods are implemented using one of the @code{GNAT.Scripts.Set_Data}
-and @code{GNAT.Scripts.Get_Data} operations when in text mode, or possibly
-@code{GNAT.Scripts.Gtkada.Set_Data} and @code{GNAT.Scripts.Gtkada.Get_Data}
+These methods are implemented using one of the @code{GNATCOLL.Scripts.Set_Data}
+and @code{GNATCOLL.Scripts.Get_Data} operations when in text mode, or possibly
+@code{GNATCOLL.Scripts.Gtkada.Set_Data} and
+@code{GNATCOLL.Scripts.Gtkada.Get_Data}
when manipulating graphical GtkAda objects.
@end defmethod
@@ -1042,7 +1045,7 @@ @subsubsection Classes diagram
@noindent
The following diagram shows the dependencies between the major data types
-defined in @file{GNAT.Scripts}. Most of these are abstract classes that
+defined in @file{GNATCOLL.Scripts}. Most of these are abstract classes that
are implemented by the various scripting languages. Here is a brief description
of the role of each type:
@@ -1264,7 +1267,7 @@ @subsubsection Exporting classes
in the example below.
@CODESAMPLE{MyClass : Class_Type;@NL{}
-MyClass := GNAT.Scripts.New_Class (Repo, "MyClass");}
+MyClass := GNATCOLL.Scripts.New_Class (Repo, "MyClass");}
At this stage, nothing is visible in the scripting language, but all the
required setup has been done internally so that you can now add methods to
@@ -1302,7 +1305,7 @@ @subsubsection Exporting classes
Here is the corresponding Ada code.
-@CODESAMPLE{@b{with} GNAT.Scripts.Impl;@NL{}
+@CODESAMPLE{@b{with} GNATCOLL.Scripts.Impl;@NL{}
@b{procedure} Handler@NL{}
(Data : @b{in out} Callback_Data'Class; Command : String)@NL{}
@b{is}@NL{}
@@ -1357,7 +1360,7 @@ @subsubsection Exporting classes
@b{end record};}
As you can see, this is not a tagged type, but could certainly be. There is
-of course no procedure @code{Set_Data} in @file{GNAT.Scripts} that enables
+of course no procedure @code{Set_Data} in @file{GNATCOLL.Scripts} that enables
us to store @code{MyType} in a @code{Class_Instance}. This example shows how
to write such a procedure. The rest of the code would be similar to the
first example, with a constructor that calls @code{Set_Data}, and methods
@@ -1414,7 +1417,7 @@ @subsubsection Reusing class instances
@itemize @bullet
@item The Ada object derives from a GtkAda object
-In such a case, the package @file{GNAT.Scripts.GtkAda} provides three
+In such a case, the package @file{GNATCOLL.Scripts.GtkAda} provides three
procedures that automatically associate the instance with the object,
and can return the class instance associated with any given GtkAda
object, or can return the GtkAda object stored in the instance. There is
@@ -1431,7 +1434,7 @@ @subsubsection Reusing class instances
@item The Ada object does not derive from a GtkAda object
In such a case, you should store the list of associated instances with
-your object. The type @code{GNAT.Scripts.Instance_List_Access} is meant for
+your object. The type @code{GNATCOLL.Scripts.Instance_List_Access} is meant for
that purpose, and provides two @code{Set} and @code{Get} primitives
to retrieve existing instances.
@@ -1549,7 +1552,7 @@ @subsection Executing startup scripts
plug-ins written in one of the scripting languages.
There is not much to be said here, except that you should use the
-@code{GNAT.Scripts.Execute_File} procedure to do so.
+@code{GNATCOLL.Scripts.Execute_File} procedure to do so.
@@ -1564,7 +1567,7 @@ @chapter Logging information
displayed and stored in a number of places: standard output, a file, the
system logger, an application-specific database table,@dots{}
-The package @file{GNAT.Traces} addresses the various needs, except for the
+The package @file{GNATCOLL.Traces} addresses the various needs, except for the
application-specific database, which of course is specific to your business
and needs various custom fields in any case, which cannot be easily provided
through a general interface.
@@ -1610,7 +1613,7 @@ @section Configuring traces
might output a lot of information, thus confusing the logs; this also does
not help debugging.
-The @code{GNAT.Traces} package allows the user to configure which handles
+The @code{GNATCOLL.Traces} package allows the user to configure which handles
should actually generate logs, and which should just be silent and not
generate anything. Depending on the part of the application that needs to
be investigated, one can therefore enable a set of handles or another, to
@@ -1729,12 +1732,12 @@ @section Using the traces module
If you need or want to parse an external configuration file as described
in the first section, the code that initializes your application should
-contain a call to @code{GNAT.Traces.Parse_Config_File}. As documented,
+contain a call to @code{GNATCOLL.Traces.Parse_Config_File}. As documented,
this takes in parameter the name of the configuration file to parse. When
none is specified, the algorithm specified in the previous section will be
used to find an appropriate configuration.
-@CODESAMPLE{GNAT.Traces.Parse_Config_File;}
+@CODESAMPLE{GNATCOLL.Traces.Parse_Config_File;}
The code, as written, will end up looking for a file @file{.gnatdebug} in
the current directory.
@@ -1778,7 +1781,7 @@ @section Using the traces module
@b{end} Pkg2;@NL{}}
Once the handles have been declared, output is a matter of calling the
-@code{GNAT.Traces.Trace} procedure, as in the following sample:
+@code{GNATCOLL.Traces.Trace} procedure, as in the following sample:
@CODESAMPLE{
Trace (Me, "I am here");
@@ -1817,7 +1820,7 @@ @section Log decorators
@noindent
Speaking of color, a number of decorators are defined by
-@code{GNAT.Traces}. Their goal is not to be used for outputting information,
+@code{GNATCOLL.Traces}. Their goal is not to be used for outputting information,
but to configure what extra information should be output with all log
messages. They are activated through the same configuration file as the
traces, with the same syntax (i.e either @code{"=yes"} or @code{"=no"}).
@@ -1865,7 +1868,7 @@ @section Log decorators
@item DEBUG.FINALIZE_TRACES
This handle is activated by default, and indicates whether
-@code{GNAT.Traces.Finalize} should have any effect. This can be set to False
+@code{GNATCOLL.Traces.Finalize} should have any effect. This can be set to False
when debugging, to ensure that traces are available during the finalization
of your application.
@end table
@@ -1876,19 +1879,19 @@ @section Log decorators
@CODESAMPLE{
[MODULE] 6/247 User Message (2007-07-03 13:12:53.46)@NL{}
- (elapsed: 2ms)(loc: gnat-traces.adb:224)@NL{}
- (entity:GNAT.Traces.Log)@NL{}
+ (elapsed: 2ms)(loc: gnatcoll-traces.adb:224)@NL{}
+ (entity:GNATCOLL.Traces.Log)@NL{}
(callstack: 40FD9902 082FCFDD 082FE8DF )
}
Depending on your application, there are lots of other possible decorators
that could be useful (for instance the current thread, or the name of the
-executable when you have several of them,@dots{}). Since @code{GNAT.Traces}
+executable when you have several of them,@dots{}). Since @code{GNATCOLL.Traces}
cannot provide all possible decorators, it provides support, through tagged
types, so that you can create your own decorators.
This needs you to override the @code{Trace_Handle_Record} tagged type. Since
-this type is created through calls to @code{GNAT.Traces.Create}. This is done
+this type is created through calls to @code{GNATCOLL.Traces.Create}. This is done
by providing an additional @var{Factory} parameter to @code{Create}; this is
a function that allocates and returns the new handle.
@@ -1935,7 +1938,7 @@ @section Defining custom trace streams
write to a socket (or even a CORBA ORB) to communicate with another
application which is charge of monitoring your application.
-@code{GNAT.Traces} provides the type @code{Trace_Stream_Record}, which can
+@code{GNATCOLL.Traces} provides the type @code{Trace_Stream_Record}, which can
be overridden to redirect the traces to your own streams.
Let's assume for now that you have defined a new type of stream (called
@@ -1955,12 +1958,12 @@ @section Defining custom trace streams
You need of course to do a bit of coding in Ada to create the stream. This
is done by creating a new child of @code{Trace_Stream_Record}, and override
the two primitive operations @code{Put} and @code{Newline} (at least).
-In this implementation, and because @code{GNAT.Traces.Trace} takes care of
+In this implementation, and because @code{GNATCOLL.Traces.Trace} takes care of
not outputting two messages at the same time, we can just output to the
file as characters are made available. In some other cases, however,
the implementation will need to buffer the characters until the end of
line is seen, and output the line with a single call. See for instance
-the implementation of @code{GNAT.Traces.Syslog}, which needs to do
+the implementation of @code{GNATCOLL.Traces.Syslog}, which needs to do
exactly that.
@CODESAMPLE{
@@ -1984,7 +1987,7 @@ @section Defining custom trace streams
in parameter the argument specified by the user in the configuration file
(after the @code{":"} character, if any), and must return a newly
allocated stream. This function is also never called twice with the
-same argument, since @code{GNAT.Traces} automatically reuses an existing
+same argument, since @code{GNATCOLL.Traces} automatically reuses an existing
stream when one with the same name and arguments already exists.
@CODESAMPLE{
@@ -2012,14 +2015,14 @@ @section Logging to syslog
specify the switch @code{--enable-syslog} to configure to activate the
support. If either this switch wasn't specified, or configure could not find
the relevant header files anyway, then support for @code{syslog} will not
-be available. In this case, the package @code{GNAT.Traces.Syslog} is still
+be available. In this case, the package @code{GNATCOLL.Traces.Syslog} is still
available, but contains a single function that does nothing. If your
configuration files redirect some trace handles to @code{"syslog"}, they will
instead be redirect to the default stream or to standard output.
Activating support for syslog requires the following call in your application:
-@CODESAMPLE{GNAT.Traces.Syslog.Register_Syslog_Stream;}
+@CODESAMPLE{GNATCOLL.Traces.Syslog.Register_Syslog_Stream;}
This procedure is always available, whether your system supports or not
syslog, and will simply do nothing if it doesn't support syslog. This means
@@ -2029,7 +2032,7 @@ @section Logging to syslog
After the above call, trace handles can be redirected to a stream named
@code{"syslog"}.
-The package @code{GNAT.Traces.Syslog} also contains a low-level interface
+The package @code{GNATCOLL.Traces.Syslog} also contains a low-level interface
to syslog, which, although fully functional, you should probably not use,
since that would make your code system-dependent.
@@ -2037,7 +2040,7 @@ @section Logging to syslog
@code{facility}, which indicates what application emitted the message,
and where it should be filed, and the @code{level} which indicates the
urgency level of the message. Both of these criteria can be specified in
-the @code{GNAT.Traces} configuration file, as follows:
+the @code{GNATCOLL.Traces} configuration file, as follows:
@CODESAMPLE{
MODULE=yes >&syslog:user:error
@@ -2045,7 +2048,7 @@ @section Logging to syslog
The above configuration will redirect to a facility called @code{user},
with an urgency level @code{error}. See the enumeration types in
-@file{gnat-traces-syslog.ads} for more information on valid facilities
+@file{gnatcoll-traces-syslog.ads} for more information on valid facilities
and levels.
@c ------------------------------------------------------------------------
@@ -2119,7 +2122,7 @@ @chapter Reading and Writing Files
still two or three times faster, which is especially interesting on big
files.
-@value{gnatcoll}'s @code{GNAT.Mmap} package provides a high-level abstraction
+@value{gnatcoll}'s @code{GNATCOLL.Mmap} package provides a high-level abstraction
on top of the @code{mmap} system call. As for most other packages in
@value{gnatcoll}, it also nicely handles the case where your system does not
actually support @code{mmap}, and will in that case fallback on using
@@ -2139,7 +2142,7 @@ @chapter Reading and Writing Files
bytes long. In such cases you need to read chunks of the file separately.
The @code{mmap} system call is such that its performance does not depend on
the size of the file your are mapping. Of course, this could be a problem if
-@code{GNAT.Mmap} falls back on calling @code{read}, since in that case it
+@code{GNATCOLL.Mmap} falls back on calling @code{read}, since in that case it
needs to allocate as much memory as your file. Therefore in some cases you
will also want to only read chunks of the file at once.
@@ -2160,7 +2163,7 @@ @chapter Reading and Writing Files
To read only a chunk of the file, your code would look like the following.
At the low-level, the system call will always read chunks multiple of a
-size called the page_size. Although @code{GNAT.Mmap} takes care of rounding
+size called the page_size. Although @code{GNATCOLL.Mmap} takes care of rounding
the numbers appropriately, it is recommended that you pass parameters that
are multiples of that size. That optimizes the number of system calls you
will need to do, and therefore speeds up your application somewhat.
@@ -2201,7 +2204,7 @@ @chapter Reading and Writing Files
@b{for} S @b{in} 1 .. Last (File) @b{loop} @NL{}
}
-If you intend to modify the contents of the file, not that @code{GNAT.Mmap}
+If you intend to modify the contents of the file, not that @code{GNATCOLL.Mmap}
currently gives you no way to change the size of the file. The only difference
compared to the code used for reading the file is the call to open the file,
which should be
@@ -2213,7 +2216,7 @@ @chapter Reading and Writing Files
Modifications to Str are automatically reflected in the file. However, there
is no guarantee this saving is done immediately. It could be done only when
you call @code{Close}. This is in particular always the case when your system
-does not support @code{mmap} and @code{GNAT.Mmap} had to fallback on calls to
+does not support @code{mmap} and @code{GNATCOLL.Mmap} had to fallback on calls to
@code{read}.
@c -----------------------------------------------------------------------
@@ -2230,7 +2233,7 @@ @chapter Searching strings
these subprograms do not in general provide the most efficient algorithms
for searching strings.
-The package @code{GNAT.Boyer_Moore} provides one such optimize algorithm,
+The package @code{GNATCOLL.Boyer_Moore} provides one such optimize algorithm,
although there exists several others which might be more efficient depending
on the pattern.
@@ -2385,7 +2388,7 @@ @section Message formats
@c -----------------------------------------------------------------------
@node Message formats
@section Message formats
-@cindex GNAT.Email.Utils
+@cindex GNATCOLL.Email.Utils
@c -----------------------------------------------------------------------
@noindent
@@ -2414,7 +2417,7 @@ @section Message formats
@cindex MIME
@cindex encoding
-The package @file{GNAT.Email.Utils} contains various subprograms to decode
+The package @file{GNATCOLL.Email.Utils} contains various subprograms to decode
MIME-encoded streams, which you can use independently from the rest of the
packages in the email module.
@@ -2429,14 +2432,14 @@ @section Message formats
The @code{From}, @code{TO} or @code{CC} fields, among others, contain
list of recipients. These recipients are the usual email addresses. However,
the format is quite complex, because the full name of the recipient can also
-be specified, along with comments. The package @file{GNAT.Email.Utils}
+be specified, along with comments. The package @file{GNATCOLL.Email.Utils}
provides various subprograms for parsing email addresses and list of
recipients.
@item Dates
The @code{Date} header indicates when the message was sent. The format of the
date is also precisely defined in the RFC, and the package
-@file{GNAT.Email.Utils} provides subprograms for parsing this date (or,
+@file{GNATCOLL.Email.Utils} provides subprograms for parsing this date (or,
on the contrary, to create a string from an existing time).
@item Text
@@ -2444,7 +2447,7 @@ @section Message formats
a simple text header. However, one complication comes from the fact that the
user might want to use extended characters not in the ASCII subset. In such
cases, the Subject (or part of it) will be MIME-encoded. The package
-@file{GNAT.Email.Utils} provides subprograms to decode MIME-encoded strings,
+@file{GNATCOLL.Email.Utils} provides subprograms to decode MIME-encoded strings,
with the various charsets.
@end table
@@ -2464,8 +2467,8 @@ @section Parsing messages
This type is controlled, which means that the memory will be freed
automatically when the message is no longer needed.
-@cindex GNAT.Email.Parser
-The package @file{GNAT.Email.Parser} provides various subprograms that
+@cindex GNATCOLL.Email.Parser
+The package @file{GNATCOLL.Email.Parser} provides various subprograms that
parse a message (passed as a string), and create a @code{Message} out of it.
Parsing a message might be costly in some cases, for instance if a big
attachment needs to be decoded first. In some cases, your application will
@@ -2474,11 +2477,12 @@ @section Parsing messages
This efficiency concern is why there are multiple parsers. Some of them will
ignore parts of the message, and thus be more efficient if you can use them.
-@cindex GNAT.Email
-Once a @code{Message} has been created, the subprograms in @code{GNAT.Email}
+@cindex GNATCOLL.Email
+Once a @code{Message} has been created, the subprograms in
+@code{GNATCOLL.Email}
can be used to access its various parts.
The documentation for these subprograms is found in the file
-@code{gnat-email.ads} directly, and is not duplicated here.
+@code{gnatcoll-email.ads} directly, and is not duplicated here.
@c -----------------------------------------------------------------------
@node Parsing mailboxes
@@ -2496,8 +2500,9 @@ @section Parsing mailboxes
format. In this format, the messages are concatenated in a single file,
and separated by a newline.
-@cindex GNAT.Email.Mailboxes
-The package @code{GNAT.Email.Mailboxes} provides all the types and subprograms
+@cindex GNATCOLL.Email.Mailboxes
+The package @code{GNATCOLL.Email.Mailboxes} provides all the types and
+subprograms
to manipulate mailboxes.
Tagged types are used, so that new formats of mailboxes can relatively easily
be added later on, or in your own application.
@@ -2537,7 +2542,7 @@ @section Creating messages
@c -----------------------------------------------------------------------
@noindent
-The subprograms in @code{GNAT.Email} can also be used to create a message
+The subprograms in @code{GNATCOLL.Email} can also be used to create a message
from scratch. Alternatively, if you have already parsed a message, you
can alter it, or easily generate a reply to it (using the @code{Reply_To}
subprogram. The latter will preset some headers, so that message threading
@@ -2551,12 +2556,12 @@ @chapter Ravenscar Patterns
@noindent
@value{gnatcoll} provides a set of patterns for concurrent programming using
-Ravenscar-compliant semantics only. The core goal of the GNAT.Ravenscar (sub)
-packages is to ease the development of high-integrity multitasking applications
-by factorizing common behavior into instantiable, Ravenscar-compliant, generic
-packages. Instances of such generic packages guarantee predictable
-timing behavior and thus permit the application of most common timing analysis
-techniques.
+Ravenscar-compliant semantics only. The core goal of the GNATCOLL.Ravenscar
+(sub) packages is to ease the development of high-integrity multitasking
+applications by factorizing common behavior into instantiable,
+Ravenscar-compliant, generic packages. Instances of such generic packages
+guarantee predictable timing behavior and thus permit the application of most
+common timing analysis techniques.
@menu
* Tasks::
@@ -2566,10 +2571,11 @@ @section Tasks
@node Tasks
@section Tasks
-The @code{GNAT.Ravenscar.Simple_Cyclic_Task} generic package lets instantiate a
-cyclic tasks executing the same operation at regular time intervals; on the other
-side, the @code{GNAT.Ravenscar.Simple_Sporadic_Task} task lets instantiate
-sporadic tasks enforcing a minimum inter-release time.
+The @code{GNATCOLL.Ravenscar.Simple_Cyclic_Task} generic package lets
+instantiate a cyclic tasks executing the same operation at regular time
+intervals; on the other side, the
+@code{GNATCOLL.Ravenscar.Simple_Sporadic_Task} task lets instantiate sporadic
+tasks enforcing a minimum inter-release time.
@node Servers
@@ -2625,7 +2631,7 @@ @chapter Managing Memory: The storage po
In @value{gnatcoll}, you will find the following storage pools:
@table @bullet
-@item @code{GNAT.Storage_Pools.Alignment}
+@item @code{GNATCOLL.Storage_Pools.Alignment}
This pool gives you full control over the alignment of your data. In
general, Ada will only allow you to specify alignments up to a limited
============================================================
--- gnatlib/src/gnatcoll-filesystem-unix-remote.adb a5e52d2ba799b9a1363fd2b280345bfd43d21798
+++ gnatlib/src/gnatcoll-filesystem-unix-remote.adb 5a2e1b0f29b9b99a465cde3caf96d21fc23527ca
@@ -61,6 +61,15 @@ package body GNATCOLL.Filesystem.Unix.Re
end Setup;
--------------
+ -- Is_Local --
+ --------------
+
+ function Is_Local (FS : Remote_Unix_Filesystem_Record) return Boolean is
+ begin
+ return False;
+ end Is_Local;
+
+ --------------
-- Home_Dir --
--------------
============================================================
--- gnatlib/src/gnatcoll-filesystem-unix-remote.ads 89e7a748f80b98056ae0c9ef339de6be83d2a031
+++ gnatlib/src/gnatcoll-filesystem-unix-remote.ads e92c839e1a120205b736f36154a3e3cd82ea3926
@@ -39,6 +39,8 @@ package GNATCOLL.Filesystem.Unix.Remote
function Get_Host (FS : Remote_Unix_Filesystem_Record) return String;
-- Return the host on which the filesystem is running
+ overriding function Is_Local
+ (FS : Remote_Unix_Filesystem_Record) return Boolean;
overriding function Home_Dir
(FS : Remote_Unix_Filesystem_Record) return String;
overriding function Is_Regular_File
============================================================
--- gnatlib/src/gnatcoll-filesystem-unix.adb bb844f3bdfd66fd1dca88ce6b2e9b16cdfb58f85
+++ gnatlib/src/gnatcoll-filesystem-unix.adb b472cbf158f534be0eebcc3d4d3e9bd2b1de7264
@@ -19,6 +19,16 @@ package body GNATCOLL.Filesystem.Unix is
package body GNATCOLL.Filesystem.Unix is
+ --------------
+ -- Is_Local --
+ --------------
+
+ function Is_Local (FS : Unix_Filesystem_Record) return Boolean is
+ pragma Unreferenced (FS);
+ begin
+ return True;
+ end Is_Local;
+
-------------------------
-- Directory_Separator --
-------------------------
============================================================
--- gnatlib/src/gnatcoll-filesystem-unix.ads ac588d4d4d82f08e0bcf063bc65f2ac5adbd7380
+++ gnatlib/src/gnatcoll-filesystem-unix.ads 0295bf56eb941fc0b565e64bb7ac8eba1208a72e
@@ -24,6 +24,7 @@ package GNATCOLL.Filesystem.Unix is
type Unix_Filesystem_Record is new Filesystem_Record with null record;
+ overriding function Is_Local (FS : Unix_Filesystem_Record) return Boolean;
overriding function Dir_Sep (FS : Unix_Filesystem_Record) return Character;
overriding function To_Unix
(FS : Unix_Filesystem_Record;
============================================================
--- gnatlib/src/gnatcoll-filesystem-windows-remote.adb d9a9a66e8d710466fbc80f2fef78db0a71ad9961
+++ gnatlib/src/gnatcoll-filesystem-windows-remote.adb 6a69f842f493751a6623c5c6cbb1006295b63bd0
@@ -25,6 +25,16 @@ package body GNATCOLL.Filesystem.Windows
package body GNATCOLL.Filesystem.Windows.Remote is
--------------
+ -- Is_Local --
+ --------------
+
+ function Is_Local (FS : Remote_Windows_Filesystem_Record) return Boolean is
+ pragma Unreferenced (FS);
+ begin
+ return False;
+ end Is_Local;
+
+ --------------
-- Get_Host --
--------------
============================================================
--- gnatlib/src/gnatcoll-filesystem-windows-remote.ads d019b0cf109ff74bbef162940441716ebb1395fc
+++ gnatlib/src/gnatcoll-filesystem-windows-remote.ads f5a252d9c27023daa3f7d897836229988e534c8f
@@ -38,6 +38,8 @@ package GNATCOLL.Filesystem.Windows.Remo
function Get_Host (FS : Remote_Windows_Filesystem_Record) return String;
-- Return the host on which the filesystem is running
+ overriding function Is_Local
+ (FS : Remote_Windows_Filesystem_Record) return Boolean;
overriding function Home_Dir
(FS : Remote_Windows_Filesystem_Record) return String;
overriding function Is_Regular_File
============================================================
--- gnatlib/src/gnatcoll-filesystem-windows.adb dcb71cbe96193bfd4b41bead7519156c4d1425a3
+++ gnatlib/src/gnatcoll-filesystem-windows.adb 59c0949da57ba62d103635a93f7afd0184567e0b
@@ -42,6 +42,16 @@ package body GNATCOLL.Filesystem.Windows
and then Path (Path'First + Cygdrive'Length + 1) = '/';
end Is_Cygdrive;
+ --------------
+ -- Is_Local --
+ --------------
+
+ function Is_Local (FS : Windows_Filesystem_Record) return Boolean is
+ pragma Unreferenced (FS);
+ begin
+ return True;
+ end Is_Local;
+
-------------------------
-- Directory_Separator --
-------------------------
============================================================
--- gnatlib/src/gnatcoll-filesystem-windows.ads 78b9e7f4f1a5318841a66b622f1407ba0b5ac087
+++ gnatlib/src/gnatcoll-filesystem-windows.ads d3b8167eb5356c9d0b68ec36fae3678b7b1fd473
@@ -24,6 +24,8 @@ package GNATCOLL.Filesystem.Windows is
type Windows_Filesystem_Record is new Filesystem_Record with null record;
+ overriding function Is_Local
+ (FS : Windows_Filesystem_Record) return Boolean;
overriding function Dir_Sep
(FS : Windows_Filesystem_Record) return Character;
overriding function To_Unix
============================================================
--- gnatlib/src/gnatcoll-filesystem.adb bb459f22f09330beba8528c5a953463e0e0ae215
+++ gnatlib/src/gnatcoll-filesystem.adb a2ff624e99969931610a736eab1aeb0e7eb7d231
@@ -234,29 +234,36 @@ package body GNATCOLL.Filesystem is
Dir_Separator : constant Character :=
Dir_Sep (Filesystem_Record'Class (FS));
begin
- Last_Dir := Path'First;
+ if Is_Local (Filesystem_Record'Class (FS)) then
+ return Normalize_Pathname (Path, Case_Sensitive => False);
+ else
+ Last_Dir := Path'First;
- for J in Path'Range loop
- if Path (J) = Dir_Separator then
- if J < Path'Last - 3
- and then Path (J .. J + 3) = Dir_Separator & ".." & Dir_Separator
- then
- return Normalize
- (FS,
- Path (Path'First .. Last_Dir) & Path (J + 4 .. Path'Last));
+ for J in Path'Range loop
+ if Path (J) = Dir_Separator then
+ if J < Path'Last - 3
+ and then Path (J .. J + 3) =
+ Dir_Separator & ".." & Dir_Separator
+ then
+ return Normalize
+ (FS,
+ Path
+ (Path'First .. Last_Dir) & Path (J + 4 .. Path'Last));
- elsif J < Path'Last - 2
- and then Path (J .. J + 2) = Dir_Separator & '.' & Dir_Separator
- then
- return Normalize
- (FS, Path (Path'First .. J) & Path (J + 3 .. Path'Last));
- end if;
+ elsif J < Path'Last - 2
+ and then Path (J .. J + 2) =
+ Dir_Separator & '.' & Dir_Separator
+ then
+ return Normalize
+ (FS, Path (Path'First .. J) & Path (J + 3 .. Path'Last));
+ end if;
- Last_Dir := J;
- end if;
- end loop;
+ Last_Dir := J;
+ end if;
+ end loop;
- return Normalize_Pathname (Path, Case_Sensitive => False);
+ return Path;
+ end if;
end Normalize;
--------------
============================================================
--- gnatlib/src/gnatcoll-filesystem.ads e2b0258cd89436015a75866a23d2bb268903c422
+++ gnatlib/src/gnatcoll-filesystem.ads 3419b3c38c3ad6f8b80f12ac3d317f12f0a5bbf2
@@ -46,6 +46,9 @@ package GNATCOLL.Filesystem is
procedure Free (FS : in out Filesystem_Access);
-- Free the memory allocated for FS
+ function Is_Local (FS : Filesystem_Record) return Boolean is abstract;
+ -- Tell if FS is a local or remote filesystem.
+
function Dir_Sep (FS : Filesystem_Record) return Character is abstract;
-- Return the filesystem's directory separator
============================================================
--- gnatlib/src/python/gnatcoll-python.adb eb9e220f2b0cc73d2ee62fc994f7658e859884b5
+++ gnatlib/src/python/gnatcoll-python.adb 7b06e9c358dea1730fb8b002c62c76afb9430c91
@@ -218,6 +218,17 @@ package body GNATCOLL.Python is
end PyInt_Check;
-------------------
+ -- PyFloat_Check --
+ -------------------
+
+ function PyFloat_Check (Obj : PyObject) return Boolean is
+ function Internal (Obj : PyObject) return Integer;
+ pragma Import (C, Internal, "ada_pyfloat_check");
+ begin
+ return Internal (Obj) = 1;
+ end PyFloat_Check;
+
+ -------------------
-- PyTuple_Check --
-------------------
@@ -733,6 +744,17 @@ package body GNATCOLL.Python is
return PyDict_GetItemString (Dict, Name);
end Lookup_Class_Object;
+ -------------
+ -- Py_Main --
+ -------------
+
+ function Py_Main return Integer is
+ function Internal return Integer;
+ pragma Import (C, Internal, "ada_py_main");
+ begin
+ return Internal;
+ end Py_Main;
+
---------------------
-- PyCObject_Check --
---------------------
============================================================
--- gnatlib/src/python/gnatcoll-python.ads 46e371f1eb490324cdfee52fbfcc8d06a476afb5
+++ gnatlib/src/python/gnatcoll-python.ads 631c2291d6ef2b788f10ecb0d37f42c3150fff9d
@@ -167,6 +167,16 @@ package GNATCOLL.Python is
-- Returns true if the Obj is an integer object.
------------
+ -- Floats --
+ ------------
+
+ function PyFloat_AsDouble (Float : PyObject) return Interfaces.C.Double;
+ -- Return the value of Float.
+
+ function PyFloat_Check (Obj : PyObject) return Boolean;
+ -- Returns true if the Obj is a float object.
+
+ ------------
-- Tuples --
------------
-- The following subprograms are in fact simple examples of importing the C
@@ -779,6 +789,9 @@ package GNATCOLL.Python is
-- function (get its code with PyFunction_Get_Code), specifying some of
-- the parameters
+ function Py_Main return Integer;
+ -- Run the python interpreter main program
+
--------------------------------------
-- Evaluating and Tracing execution --
--------------------------------------
@@ -896,6 +909,7 @@ private
pragma Inline (PyArg_ParseTuple);
pragma Inline (PyString_Check);
pragma Inline (PyInt_Check);
+ pragma Inline (PyFloat_Check);
pragma Import (C, Py_Initialize, "Py_Initialize");
pragma Import (C, Py_Finalize, "Py_Finalize");
pragma Import (C, PyModule_GetDict, "PyModule_GetDict");
@@ -918,6 +932,7 @@ private
pragma Import (C, PyTuple_Size, "PyTuple_Size");
pragma Import (C, PyInt_FromLong, "PyInt_FromLong");
pragma Import (C, PyInt_AsLong, "PyInt_AsLong");
+ pragma Import (C, PyFloat_AsDouble, "PyFloat_AsDouble");
pragma Import (C, PyInt_GetMax, "PyInt_GetMax");
pragma Import (C, PyErr_Occurred, "PyErr_Occurred");
pragma Import (C, PyList_New, "PyList_New");
============================================================
--- gnatlib/src/python/python_support.c f8f879897df530a28d05c4d2f3a10b71542d6be2
+++ gnatlib/src/python/python_support.c fcfa934fb3ca87eb24f68b70a3fb6c86c7d02ba8
@@ -123,6 +123,12 @@ int
}
int
+ada_pyfloat_check (PyObject* obj)
+{
+ return PyFloat_Check (obj);
+}
+
+int
ada_pyfunction_check (PyObject* obj)
{
return PyFunction_Check (obj);
@@ -343,3 +349,12 @@ ada_py_arg_parsetuple_ptr5
PyArg_ParseTuple (o, fmt, arg1, arg2, arg3, arg4, arg5);
}
+extern int gnat_argc;
+extern char **gnat_argv;
+
+int
+ada_py_main ()
+{
+ return Py_Main (gnat_argc, gnat_argv);
+}
+
============================================================
--- gps/.gnatdebug 9cedc4ddb69ae73825ca36e7923032129593bbd6
+++ gps/.gnatdebug feef714b94330a9926323d1efc8e1901c388ec2d
@@ -77,6 +77,7 @@ EXPECT=no
COMMANDS.CUSTOM=no
HOOKS=no
EXPECT=no
+TERM=no
-- Debug handles related to the debugger
GVD.OUT=no
============================================================
--- gps/src/gps-main.adb b3b788653e6ad03ae412f361374978eba6b5b0cb
+++ gps/src/gps-main.adb 4d84efad3c2c1244bd97ee6d8389959cae1759ca
@@ -77,6 +77,7 @@ with OS_Utils; use OS_U
with GPS.Main_Window;
with GPS.Menu;
with OS_Utils; use OS_Utils;
+with Prj_Output;
with Projects.Editor; use Projects.Editor;
with Projects.Registry; use Projects;
with Remote; use Remote;
@@ -281,6 +282,9 @@ procedure GPS.Main is
-- Execute a batch command (either loading the file Batch if As_File is
-- true, or as a standard command otherwise).
+ procedure Display_Prj_Messages (S : String);
+ -- Display messages coming from the Prj packages.
+
---------------------
-- Clean_Parameter --
---------------------
@@ -971,6 +975,19 @@ procedure GPS.Main is
Trace (Exception_Handle, E);
end Execute_Batch;
+ --------------------------
+ -- Display_Prj_Messages --
+ --------------------------
+
+ procedure Display_Prj_Messages (S : String) is
+ begin
+ GPS.Kernel.Console.Insert
+ (GPS_Main.Kernel, S,
+ Mode => GPS.Kernel.Console.Error,
+ Add_LF => False);
+ GPS.Location_View.Parse_File_Locations (GPS_Main.Kernel, S, -"Project");
+ end Display_Prj_Messages;
+
------------------
-- Finish_Setup --
------------------
@@ -1234,6 +1251,8 @@ procedure GPS.Main is
-- in the console right away
GPS.Kernel.Console.Register_Module (GPS_Main.Kernel);
+ Prj_Output.Set_Default_Output_Handler
+ (Display_Prj_Messages'Unrestricted_Access);
-- Register this very early so that other modules can access remote
-- files
@@ -1696,6 +1715,8 @@ procedure GPS.Main is
Save_Desktop (Kernel);
end if;
+ Prj_Output.Set_Default_Output_Handler (null);
+
if Status (Project) = Default then
Trace (Me, "Remove default project on disk, no longer used");
Delete (Project_Path (Project), Success);
============================================================
--- gvd/gvd/gvd-consoles.adb a95c215f613f48967337308cadd4522aad0d57ff
+++ gvd/gvd/gvd-consoles.adb afe11fc3c49a9038dfac53790e1ee726d60aae5c
@@ -527,6 +527,7 @@ package body GVD.Consoles is
Font => Default_Style.Get_Pref_Font,
History_List => null,
Key => "gvd_tty_console",
+ ANSI_Support => True,
Wrap_Mode => Wrap_Char);
Widget_Callback.Connect
(Console, Signal_Destroy, On_Debuggee_Destroy'Access);
============================================================
--- gvd/gvd/gvd-process.adb 054d31ca82ce38fd7ab6f6ded94c6212df2abe5c
+++ gvd/gvd/gvd-process.adb 3c228d619c188199ea5b31f485bbf045141eeaa2
@@ -1239,7 +1239,7 @@ package body GVD.Process is
-- through the console, when the breakpoints window is not shown.
Update_Breakpoints (Process, Force => True);
- Property := new Breakpoint_Property_Record;
+ Property := new Breakpoint_Property_Record;
Save_Breakpoints_In_Properties (Process, Property);
else
Remove_Property
============================================================
--- gvd/gvd/gvd-trace.adb 05bba057843039117d2460a2069e126070046fa8
+++ gvd/gvd/gvd-trace.adb 6246e13e0fb7904e3c79831a792e18925eca1eff
@@ -28,8 +28,8 @@ package body GVD.Trace is
package body GVD.Trace is
-- Internally, we only handle two different handles, since it makes things
- -- much simpler to activate, and anyway we either want the minimal or all
- -- of it anyway
+ -- much simpler to activate, and we either want the minimal or all
+ -- of it anyway.
Me : constant array (Command_Type) of Trace_Handle :=
(Internal => GNATCOLL.Traces.Create ("GVD.Out", Off),
Hidden => GNATCOLL.Traces.Create ("GVD.Out", Off),
============================================================
--- help/src/help_module-display_help_unix.adb 6329ae015712981de9430a5c4d0c35a0bc2d7696
+++ help/src/help_module-display_help_unix.adb bca2bc766da3838f1edd8286a9420b5a9cc8a267
@@ -19,6 +19,7 @@ with GNATCOLL.Templates; use GNATCOL
with GPS.Kernel.Preferences; use GPS.Kernel.Preferences;
with GNATCOLL.Templates; use GNATCOLL.Templates;
+with String_Utils; use String_Utils;
separate (Help_Module)
procedure Display_Help
============================================================
--- help/src/help_module.adb d3cb8a8a4cf8842b888b1135555930e7affb5f5f
+++ help/src/help_module.adb d27d961f4f6ec2117211ca7709b51b50c8196ddf
@@ -56,7 +56,6 @@ with Generic_List;
with File_Utils; use File_Utils;
with Filesystems; use Filesystems;
with Generic_List;
-with String_Utils; use String_Utils;
with Welcome_Page; use Welcome_Page;
with XML_Parsers;
with Config;
@@ -370,7 +369,7 @@ package body Help_Module is
if Child.Tag.all = "description" then
if HTML_Format then
Descr := Descr & "<tr><td colspan='3'>"
- & XML_Protect (Child.Value.all) & "</td></tr>";
+ & Glib.Xml_Int.Protect (Child.Value.all) & "</td></tr>";
else
Descr := Descr & Child.Value.all;
end if;
@@ -386,7 +385,8 @@ package body Help_Module is
if HTML_Format then
Params := Params
& "<tr><td class=""name"">"
- & XML_Protect (Get_Attribute (Child, "name")) & "</td>";
+ & Glib.Xml_Int.Protect
+ (Get_Attribute (Child, "name")) & "</td>";
else
if Params /= Null_Unbounded_String then
Params := Params & ASCII.LF;
@@ -403,7 +403,7 @@ package body Help_Module is
if HTML_Format then
Params := Params
& "<td class='default'>(default="""
- & XML_Protect (Default) & """)</td>";
+ & Glib.Xml_Int.Protect (Default) & """)</td>";
else
Params := Params & Default & ASCII.HT;
end if;
@@ -415,7 +415,7 @@ package body Help_Module is
if HTML_Format then
Params :=
- Params & "<td>" & XML_Protect (Child.Value.all)
+ Params & "<td>" & Glib.Xml_Int.Protect (Child.Value.all)
& "</td></tr>";
else
Params := Params & Child.Value.all;
@@ -426,7 +426,7 @@ package body Help_Module is
Returns := To_Unbounded_String
("</tr><td class=""return"">Returns</td>"
& "<td colspan='2' class=""descr"">"
- & XML_Protect (Child.Value.all)
+ & Glib.Xml_Int.Protect (Child.Value.all)
& "</td></tr>");
else
Returns :=
@@ -438,7 +438,8 @@ package body Help_Module is
See_Also := See_Also
& "<tr><td class='header'>See also</td>"
& "<td class='seeAlso' colspan='2'>"
- & XML_Protect (Get_Attribute (Child, "name", ""))
+ & Glib.Xml_Int.Protect
+ (Get_Attribute (Child, "name", ""))
& "</td></tr>";
end if;
@@ -450,7 +451,8 @@ package body Help_Module is
if HTML_Format then
Descr := Descr
& "<tr><td colspan='3' class='example'>"
- & XML_Protect (Child.Value.all) & "</td></tr>";
+ & Glib.Xml_Int.Protect (Child.Value.all)
+ & "</td></tr>";
else
Example := Example & ASCII.LF & Child.Value.all;
end if;
============================================================
--- kernel/src/default_preferences-enums.adb 262141c3bae291072714788814a1cb12316ad1be
+++ kernel/src/default_preferences-enums.adb 7ebf60d83bd0196a113c944585a43e8c8a30907a
@@ -78,7 +78,7 @@ package body Default_Preferences.Enums i
Result : constant Choice_Preference := new Choice_Preference_Record;
begin
Result.Choices := Choices;
- Result.Enum_Value := Default - Choices'First;
+ Result.Enum_Value := Default;
Register (Manager, Name, Label, Page, Doc, Result);
return Result;
end Create;
@@ -148,6 +148,9 @@ package body Default_Preferences.Enums i
(Pref : access Choice_Preference_Record) return String is
begin
return Pref.Choices (Pref.Enum_Value + Pref.Choices'First).all;
+ exception
+ when Constraint_Error =>
+ return Pref.Choices (Pref.Choices'First).all;
end Get_Pref;
--------------
============================================================
--- kernel/src/gps-kernel-commands.adb 6e6b88f814f8036be51af27dc56f8ee85d7952f3
+++ kernel/src/gps-kernel-commands.adb 7bfd437bf976537160ff21758f30e6f31740225b
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2006-2007, AdaCore --
+-- Copyright (C) 2006-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 --
@@ -24,7 +24,7 @@ with Traces; use Traces;
with Projects.Registry; use Projects.Registry;
with Task_Manager; use Task_Manager;
with Traces; use Traces;
-with GNATCOLL.VFS; use GNATCOLL.VFS;
+with GNATCOLL.VFS; use GNATCOLL.VFS;
with Commands.Generic_Asynchronous;
@@ -169,12 +169,11 @@ package body GPS.Kernel.Commands is
---------------------
procedure Do_On_Each_File
- (Handle : access Kernel_Handle_Record'Class;
- Callback : File_Callback;
- Chunk_Size : Positive := 1;
- Queue_Base_Name : String := "";
- Kill_Existing_Queue : Boolean := False;
- Operation_Name : String := "")
+ (Handle : access Kernel_Handle_Record'Class;
+ Callback : File_Callback;
+ Chunk_Size : Positive := 1;
+ Queue_Name : String := "";
+ Operation_Name : String := "")
is
use File_Iterate_Commands;
@@ -183,29 +182,13 @@ package body GPS.Kernel.Commands is
Iter : Imported_Project_Iterator :=
Start (Get_Project (Handle));
- Queue_Name : String := Queue_Base_Name & "_0";
-
Std_Files : File_Array_Access;
Project_Files : File_Array_Access;
Total_Progress : Natural;
- begin
- if Kill_Existing_Queue then
- if Kill_File_Queue (Handle, Queue_Name) then
- -- If there is already something on queue 0, then kill it and load
- -- queue 1.
- Queue_Name := Queue_Base_Name & "_1";
- else
- declare
- Dummy : constant Boolean :=
- Kill_File_Queue (Handle, Queue_Base_Name & "_1");
- pragma Unreferenced (Dummy);
- -- Just in case there is something on queue 1
- begin
- null;
- end;
- end if;
- end if;
+ Old_Command : Scheduled_Command_Access;
+ Command_Data : File_Iterate_Data_Access;
+ begin
while Current (Iter) /= No_Project loop
Projects_Count := Projects_Count + 1;
Next (Iter);
@@ -226,22 +209,32 @@ package body GPS.Kernel.Commands is
Total_Progress := Total_Progress + 1;
end if;
- File_Iterate_Commands.Create
- (C, Operation_Name,
- new File_Iterate_Data'
- (Kernel_Handle (Handle),
- Current_Progress => 0,
- Total_Progress => Total_Progress,
- Std_Files => Std_Files,
- Project_Files => Project_Files,
- Index_In_Std => 1,
- Index_In_Project => 1,
- Stop => False,
- Chunk_Size => Chunk_Size,
- Callback => Callback),
- File_Iterate'Access);
+ Old_Command := Scheduled_Command_Access
+ (Head (Get_Task_Manager (Handle), Queue_Name));
- if Queue_Base_Name /= "" then
+ Command_Data := new File_Iterate_Data'
+ (Kernel_Handle (Handle),
+ Current_Progress => 0,
+ Total_Progress => Total_Progress,
+ Std_Files => Std_Files,
+ Project_Files => Project_Files,
+ Index_In_Std => 1,
+ Index_In_Project => 1,
+ Stop => False,
+ Chunk_Size => Chunk_Size,
+ Callback => Callback);
+
+ if Old_Command /= null then
+ Set_Data
+ (File_Iterate_Commands.Generic_Asynchronous_Command_Access
+ (Get_Command (Old_Command)),
+ Command_Data);
+ else
+ File_Iterate_Commands.Create
+ (C, Operation_Name,
+ Command_Data,
+ File_Iterate'Access);
+
Launch_Background_Command
(Handle,
Command_Access (C),
@@ -249,14 +242,6 @@ package body GPS.Kernel.Commands is
True,
Queue_Name,
Block_Exit => False);
- else
- Launch_Background_Command
- (Handle,
- Command_Access (C),
- True,
- True,
- "",
- Block_Exit => False);
end if;
exception
@@ -281,13 +266,12 @@ package body GPS.Kernel.Commands is
-------------------------
procedure Kill_File_Iteration
- (Kernel : access Kernel_Handle_Record'Class; Queue_Base_Name : String)
+ (Kernel : access Kernel_Handle_Record'Class; Queue_Name : String)
is
Dummy : Boolean;
pragma Unreferenced (Dummy);
begin
- Dummy := Kill_File_Queue (Kernel, Queue_Base_Name & "_0");
- Dummy := Kill_File_Queue (Kernel, Queue_Base_Name & "_1");
+ Dummy := Kill_File_Queue (Kernel, Queue_Name);
end Kill_File_Iteration;
end GPS.Kernel.Commands;
============================================================
--- kernel/src/gps-kernel-commands.ads 4de1f1a81f9ec6ca52691df39dc8bb61bc195c1c
+++ kernel/src/gps-kernel-commands.ads 703d5959b9351bffa457893f9a5e30f58e5b03da
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2006 --
+-- Copyright (C) 2006-2008, AdaCore --
-- AdaCore --
-- --
-- GPS is free software; you can redistribute it and/or modify it --
@@ -27,12 +27,11 @@ package GPS.Kernel.Commands is
File : GNATCOLL.VFS.Virtual_File);
procedure Do_On_Each_File
- (Handle : access Kernel_Handle_Record'Class;
- Callback : File_Callback;
- Chunk_Size : Positive := 1;
- Queue_Base_Name : String := "";
- Kill_Existing_Queue : Boolean := False;
- Operation_Name : String := "");
+ (Handle : access Kernel_Handle_Record'Class;
+ Callback : File_Callback;
+ Chunk_Size : Positive := 1;
+ Queue_Name : String := "";
+ Operation_Name : String := "");
-- This procedure will launch a GPS command wich will call the given
-- callback sequentially on each file of the project, including the files
-- found from the ada library. It's possible to change the number of files
@@ -42,7 +41,7 @@ package GPS.Kernel.Commands is
-- of a previous queue if Kill_Existing_Queue is true.
procedure Kill_File_Iteration
- (Kernel : access Kernel_Handle_Record'Class; Queue_Base_Name : String);
+ (Kernel : access Kernel_Handle_Record'Class; Queue_Name : String);
-- Kills the queue deduced from the base name given in parameter, assuming
-- that these queues have been made for a file iteration from
-- Do_On_Each_File.
============================================================
--- kernel/src/gps-kernel-console.adb 338be9aa173827fadeebb07f44fda6796102f1e3
+++ kernel/src/gps-kernel-console.adb a39f76b97d81073600c1eee5a4294ac8962f4136
@@ -421,7 +421,9 @@ package body GPS.Kernel.Console is
Create_If_Not_Exist : Boolean := True;
Module : GPS.Kernel.Abstract_Module_ID := null;
Force_Create : Boolean := False;
- Accept_Input : Boolean := True) return Interactive_Console
+ Accept_Input : Boolean := True;
+ ANSI_Support : Boolean := False;
+ Manage_Prompt : Boolean := True) return Interactive_Console
is
Console : Interactive_Console;
Child : MDI_Child;
@@ -445,6 +447,8 @@ package body GPS.Kernel.Console is
History_List => Get_History (Kernel),
Key => History,
Wrap_Mode => Wrap_Char,
+ Manage_Prompt => Manage_Prompt,
+ ANSI_Support => ANSI_Support,
Highlight => Message_Highlight.Get_Pref);
Set_Max_Length (Get_History (Kernel).all, 100, History);
Allow_Duplicates (Get_History (Kernel).all, History, True, True);
============================================================
--- kernel/src/gps-kernel-console.ads 66e32655c79fb2db4a9ba1bc253d7d2f0a91d1eb
+++ kernel/src/gps-kernel-console.ads cd361109f6ce0b002d0d38f4bac3f8852b689f81
@@ -1,8 +1,7 @@
-----------------------------------------------------------------------
-- G P S --
-- --
--- Copyright (C) 2001-2006 --
--- AdaCore --
+-- Copyright (C) 2001-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 --
@@ -60,7 +59,9 @@ package GPS.Kernel.Console is
Create_If_Not_Exist : Boolean := True;
Module : GPS.Kernel.Abstract_Module_ID := null;
Force_Create : Boolean := False;
- Accept_Input : Boolean := True) return Interactive_Console;
+ Accept_Input : Boolean := True;
+ ANSI_Support : Boolean := False;
+ Manage_Prompt : Boolean := True) return Interactive_Console;
-- Return a new interactive console (or an existing one if there is already
-- one with the given Title). Any existing console is not cleared.
-- If the title is the empty stirng, the GPS console is returned.
@@ -69,6 +70,7 @@ package GPS.Kernel.Console is
-- Module is used to associate the console with a specific module.
-- If Accept_Input is True, the console will be editable. This is ignored
-- if the console already exists.
+ -- See Interactive_Consoles.Gtk_New for more info on the parameters
function Get_Console
(Kernel : access Kernel_Handle_Record'Class) return Interactive_Console;
============================================================
--- kernel/src/gps-kernel-mdi.adb 26d9ffc4e4f1a8c4b48bed8409584d15a7370a09
+++ kernel/src/gps-kernel-mdi.adb 27f5da70c66b0d80426cb59d0673d327c76c9726
@@ -170,10 +170,10 @@ package body GPS.Kernel.MDI is
begin
-- ??? the following implementation assumes that the file editors
-- are MDI children that have corresponding file names for title, and
- -- that they are the only MDI childs that do so.
+ -- that they are the only MDI children that do so.
-- ??? We might improve a little by checking the Tag of the child
-- against that of the source editor module. The ID for that module
- -- needs to be moved to gps.kernel.ads.
+ -- needs to be moved to gps-kernel.ads.
-- First, try to find the editor using the normalized name of File
Child := Find_MDI_Child_By_Name
============================================================
--- kernel/src/gps-kernel-remote.adb aecccf075179014d9e73c0756b9c08d4e2a31dd9
+++ kernel/src/gps-kernel-remote.adb 82ded91952d6d30b71040a8dd7b8c5984de20405
@@ -1534,6 +1534,26 @@ package body GPS.Kernel.Remote is
Add (Get_List (Dialog.Remote_Access_Combo), Item);
end loop;
+ if Get_Nb_Remote_Access_Descriptor = 0 then
+ declare
+ Button : Gtkada.Dialogs.Message_Dialog_Buttons;
+ pragma Unreferenced (Button);
+ begin
+ Button := Gtkada.Dialogs.Message_Dialog
+ (-("No suitable remote access tool could be found on your " &
+ "system." & ASCII.LF &
+ "A remote access tool is required to be able to use the " &
+ "GPS remote features. Please install one of the following " &
+ "tools (see the documentation for more details):" & ASCII.LF &
+ " - rlogin" & ASCII.LF &
+ " - ssh" & ASCII.LF &
+ " - telnet"),
+ Dialog_Type => Gtkada.Dialogs.Error,
+ Buttons => Gtkada.Dialogs.Button_OK,
+ Justification => Gtk.Enums.Justify_Left);
+ end;
+ end if;
+
Show_All (Get_List (Dialog.Remote_Access_Combo));
Line_Nb := Line_Nb + 1;
@@ -2987,7 +3007,7 @@ package body GPS.Kernel.Remote is
:= Get_Attribute (Node, "name", "");
Shell_Cmd : Glib.String_Ptr;
Default_Generic_Prompt : aliased String
- := "^[^\n]*[#$%>\]})] *$";
+ := "^[^\n]*[#$%>\]})\\] *$";
Generic_Prompt : Glib.String_Ptr;
GPS_Prompt : Glib.String_Ptr;
FS_Str : Glib.String_Ptr;
============================================================
--- kernel/src/gps-kernel-scripts.adb 54725edc030ea815b804a622c3843430d6523555
+++ kernel/src/gps-kernel-scripts.adb 00e69ae417f64650636dd19e9ed1bd84aaebfc72
@@ -27,8 +27,10 @@ with GNATCOLL.Utils; use GNATCO
with GNATCOLL.Traces; use GNATCOLL.Traces;
with GNATCOLL.Utils; use GNATCOLL.Utils;
+with Gdk.Types; use Gdk.Types;
with Glib.Object; use Glib.Object;
with Glib.Values; use Glib.Values;
+with Gtk.Accel_Group;
with Gtk.Arguments; use Gtk.Arguments;
with Gtk.Label; use Gtk.Label;
with Gtk.Menu; use Gtk.Menu;
@@ -185,6 +187,14 @@ package body GPS.Kernel.Scripts is
Input : String; User_Data : System.Address) return String;
-- Called when input is available on a console
+ function On_Console_Key
+ (Console : access Interactive_Console_Record'Class;
+ Modifier : Gdk.Types.Gdk_Modifier_Type;
+ Key : Gdk.Types.Gdk_Key_Type := 0;
+ Uni : Glib.Gunichar := 0;
+ User_Data : System.Address) return Boolean;
+ -- Called when a key was pressed by the user in the console
+
function On_Console_Interrupt
(Console : access Interactive_Console_Record'Class;
Data : System.Address) return Boolean;
@@ -291,12 +301,16 @@ package body GPS.Kernel.Scripts is
On_Resize_Cst : aliased constant String := "on_resize";
On_Interrupt_Cst : aliased constant String := "on_interrupt";
On_Completion_Cst : aliased constant String := "on_completion";
+ On_Key_Cst : aliased constant String := "on_key";
+ Manage_Prompt_Cst : aliased constant String := "manage_prompt";
+ ANSI_Cst : aliased constant String := "ansi";
Console_Constructor_Args : constant Cst_Argument_List :=
(Name_Cst'Access, Force_Cst'Access,
On_Input_Cst'Access, On_Destroy_Cst'Access, Accept_Input_Cst'Access,
On_Resize_Cst'Access, On_Interrupt_Cst'Access,
- On_Completion_Cst'Access);
+ On_Completion_Cst'Access, On_Key_Cst'Access,
+ Manage_Prompt_Cst'Access, ANSI_Cst'Access);
Enable_Cst : aliased constant String := "enable";
@@ -1412,6 +1426,37 @@ package body GPS.Kernel.Scripts is
return ""; -- ??? Should this be the output of the command
end On_Console_Input;
+ --------------------
+ -- On_Console_Key --
+ --------------------
+
+ function On_Console_Key
+ (Console : access Interactive_Console_Record'Class;
+ Modifier : Gdk.Types.Gdk_Modifier_Type;
+ Key : Gdk.Types.Gdk_Key_Type := 0;
+ Uni : Glib.Gunichar := 0;
+ User_Data : System.Address) return Boolean
+ is
+ On_Key : constant Subprogram_Type := Convert (User_Data);
+ Instance : constant Class_Instance :=
+ Get_Instance (Get_Script (On_Key.all), Console);
+ C : Callback_Data'Class := Create (Get_Script (On_Key.all), 4);
+ Tmp : Boolean;
+
+ -- Remove any num-lock and caps-lock modifiers
+ M : constant Gdk_Modifier_Type :=
+ Modifier and Gtk.Accel_Group.Get_Default_Mod_Mask;
+
+ begin
+ Set_Nth_Arg (C, 1, Instance);
+ Set_Nth_Arg (C, 2, Integer (Key));
+ Set_Nth_Arg (C, 3, Integer (Uni));
+ Set_Nth_Arg (C, 4, Gdk_Modifier_Type'Pos (M));
+ Tmp := Execute (On_Key, C);
+ Free (C);
+ return Tmp;
+ end On_Console_Key;
+
------------------------
-- On_Console_Destroy --
------------------------
@@ -1525,6 +1570,9 @@ package body GPS.Kernel.Scripts is
On_Interrupt : constant Subprogram_Type := Nth_Arg (Data, 8, null);
On_Completion : constant Subprogram_Type :=
Nth_Arg (Data, 9, null);
+ On_Key : constant Subprogram_Type := Nth_Arg (Data, 10, null);
+ Manage_Prompt : constant Boolean := Nth_Arg (Data, 11, True);
+ ANSI_Support : constant Boolean := Nth_Arg (Data, 12, False);
begin
Console := Create_Interactive_Console
(Kernel => Get_Kernel (Data),
@@ -1533,6 +1581,8 @@ package body GPS.Kernel.Scripts is
Create_If_Not_Exist => Title /= "Python"
and then Title /= "Shell",
Force_Create => Force,
+ Manage_Prompt => Manage_Prompt,
+ ANSI_Support => ANSI_Support,
Accept_Input => Accept_Input);
-- ??? If the console was already associated with an instance,
-- we would lose that original instance and all data the user
@@ -1586,6 +1636,12 @@ package body GPS.Kernel.Scripts is
(Console, On_Console_Completion'Access,
User_Data => On_Completion.all'Address);
end if;
+
+ if Console /= null and then On_Key /= null then
+ Set_Key_Handler
+ (Console, On_Console_Key'Access,
+ User_Data => On_Key.all'Address);
+ end if;
end;
elsif Command = "accept_input" then
@@ -1796,7 +1852,7 @@ package body GPS.Kernel.Scripts is
Register_Command
(Kernel, Constructor_Method,
Minimum_Args => 0,
- Maximum_Args => 8,
+ Maximum_Args => 11,
Class => Console_Class,
Handler => Console_Command_Handler'Access);
Register_Command
============================================================
--- kernel/src/gps-kernel-timeout.adb 33eeafd41825cf13583a1cd97c2b875451b9a584
+++ kernel/src/gps-kernel-timeout.adb dabeb91a59860c9e51eeff9ba3c81b4078189593
@@ -109,8 +109,8 @@ package body GPS.Kernel.Timeout is
-- Callback for the "delete_event" event
procedure Cleanup (Data : Console_Process);
- -- Close the process descriptor and free its associated memory.
- -- Free memory used by Data itself.
+ -- Close the process descriptor and mark the process as terminated in the
+ -- task manager.
function Data_Handler
(Console : access Interactive_Console_Record'Class;
@@ -152,15 +152,12 @@ package body GPS.Kernel.Timeout is
C : constant Monitor_Command_Access :=
Monitor_Command_Access (Command);
Result : Command_Return_Type;
+ Dummy : Boolean;
+ pragma Unreferenced (Dummy);
begin
Result := Execute (Command);
- if not Process_Cb (C.Data) then
- -- Process_Cb detected that the process has ended, so we should not
- -- retry later on
- return Success;
- else
- return Result;
- end if;
+ Dummy := Process_Cb (C.Data);
+ return Result;
end Execute_Monitor;
procedure Launch_Monitor_Command_Synchronous is new
@@ -192,15 +189,29 @@ package body GPS.Kernel.Timeout is
if PID /= Null_Pid and then PID /= GNAT.Expect.Invalid_Pid then
Interrupt (D.Data.D.Descriptor.all);
Close (D.Data.D.Descriptor.all);
+ D.Data.Interrupted := True;
end if;
end if;
+ Cleanup (D.Data);
+
+ -- Free memory
+
+ Free (D.Name);
D.Data.D.Command := null;
- D.Data.Interrupted := True;
- Free (D.Name);
- Cleanup (D.Data);
- D.Data := null;
+ Free (D.Data.Args);
+ Free (D.Data.Directory);
+ Pop_State (D.Data.D.Kernel);
+
+ Unchecked_Free (D.Data.Expect_Regexp);
+
+ if D.Data.D.Callback_Data /= null then
+ Destroy (D.Data.D.Callback_Data.all);
+ Unchecked_Free (D.Data.D.Callback_Data);
+ end if;
+
+ Unref (D.Data);
end Free;
-------------
@@ -256,6 +267,12 @@ package body GPS.Kernel.Timeout is
else
Trace (Me, "Failure when spawning the process");
+
+ -- We could not launch the process: call the Exit_Cb nonetheless,
+ -- as it may be used to keep count of executions, or to free
+ -- memory, for instance.
+ Command.Data.D.Exit_Cb (Command.Data.D, -1);
+
Free (Command.Data.D.Descriptor);
Command.Data.Died := True;
return Failure;
@@ -303,7 +320,6 @@ package body GPS.Kernel.Timeout is
end if;
if Data.D.Descriptor = null then
- Unref (Data);
return;
end if;
@@ -357,24 +373,12 @@ package body GPS.Kernel.Timeout is
end if;
end;
- Free (Data.Args);
- Free (Data.Directory);
-
if Data.D.Exit_Cb /= null then
Data.D.Exit_Cb (Data.D, Status);
end if;
+ -- So that next call to Cleanup does nothing
Free (Data.D.Descriptor);
- Pop_State (Data.D.Kernel);
-
- Unchecked_Free (Data.Expect_Regexp);
-
- if Data.D.Callback_Data /= null then
- Destroy (Data.D.Callback_Data.all);
- Unchecked_Free (Data.D.Callback_Data);
- end if;
-
- Unref (Data);
end Cleanup;
----------------
@@ -459,7 +463,8 @@ package body GPS.Kernel.Timeout is
when Process_Died =>
if Fd /= null then
declare
- Output : constant String := Strip_CR (Expect_Out (Fd.all));
+ Output : constant String :=
+ Conditional_Strip_CR (Expect_Out (Fd.all));
begin
if Data.D.Callback /= null then
Data.D.Process_Died := True;
@@ -487,10 +492,12 @@ package body GPS.Kernel.Timeout is
end if;
Data.Died := True;
+ Cleanup (Data);
return False;
when E : others =>
Trace (Exception_Handle, E);
+ Cleanup (Data);
return False;
end Process_Cb;
@@ -519,6 +526,7 @@ package body GPS.Kernel.Timeout is
exception
when E : others =>
Trace (Exception_Handle, E);
+ Cleanup (Process);
return "";
end Data_Handler;
@@ -813,6 +821,7 @@ package body GPS.Kernel.Timeout is
Button : Message_Dialog_Buttons;
begin
if Console.Died then
+ Cleanup (Console);
return False;
end if;
============================================================
--- kernel/src/gps-kernel-timeout.ads 9c047242a7031f4e61e9e327ff65d3d960728d0d
+++ kernel/src/gps-kernel-timeout.ads 208a4f81b729125ec6d396518855deeb24d335ba
@@ -41,6 +41,8 @@ package GPS.Kernel.Timeout is
access procedure (Data : Process_Data; Status : Integer);
-- Callback called when an underlying process launched by Launch_Process
-- terminates.
+ -- Status is the exit status of the process. If the process could not
+ -- be launched, status is set to -1.
type Callback_Data_Record is abstract tagged null record;
type Callback_Data_Access is access all Callback_Data_Record'Class;
============================================================
--- kernel/src/gps-location_view.adb 1821403354f5f8a5b840c6ce69b9783cdc89da60
+++ kernel/src/gps-location_view.adb aa05f430ccf8e3c2682753d8f876a772dd5493b6
@@ -1354,9 +1354,8 @@ package body GPS.Location_View is
if Enable_Counter then
Set (Model, File_Iter, Number_Of_Items_Column,
Get_Int (Model, File_Iter, Number_Of_Items_Column) + 1);
- Set
- (Model, Category_Iter, Number_Of_Items_Column,
- Get_Int (Model, Category_Iter, Number_Of_Items_Column) + 1);
+ Set (Model, Category_Iter, Number_Of_Items_Column,
+ Get_Int (Model, Category_Iter, Number_Of_Items_Column) + 1);
Redraw_Totals (View);
end if;
@@ -1969,17 +1968,17 @@ package body GPS.Location_View is
Iter : Gtk_Tree_Iter;
begin
Get_Tree_Iter (Nth (Params, 1), Iter);
- if Iter /= Null_Iter then
+ if Iter /= Null_Iter
+ and then View.Idle_Row_Handler = Glib.Main.No_Source_Id
+ then
if View.Row /= null then
Path_Free (View.Row);
end if;
View.Row := Get_Path (Get_Model (View.Tree), Iter);
- if View.Idle_Row_Handler = Glib.Main.No_Source_Id then
- View.Idle_Row_Handler := View_Idle.Idle_Add
- (Idle_Show_Row'Access, View);
- end if;
+ View.Idle_Row_Handler := View_Idle.Idle_Add
+ (Idle_Show_Row'Access, View);
end if;
exception
when E : others => Trace (Exception_Handle, E);
============================================================
--- kernel/src/gps-main_window.adb 7e4e390f7eae936722737be186baf69e0b6ae1f2
+++ kernel/src/gps-main_window.adb f0741a6347678dadd834fc26fa5f2c966907df85
@@ -341,9 +341,9 @@ package body GPS.Main_Window is
GPS.Main_Window.Initialize (Main_Window, Home_Dir, Prefix_Directory);
end Gtk_New;
- ----------------------
- -- Confirm_And_Quit --
- ----------------------
+ ----------
+ -- Quit --
+ ----------
procedure Quit
(Main_Window : access GPS_Window_Record'Class;
============================================================
--- kernel/src_info/projects-editor.adb 5c9fa67023cac9450b9fa73960752c66f545383f
+++ kernel/src_info/projects-editor.adb 9f90555b666f34ac2b1368037e78aa6c2a4f9216
@@ -30,6 +30,7 @@ with Prj.Util; use Prj.
with Prj.Ext; use Prj.Ext;
with Prj.Part; use Prj.Part;
with Prj.Util; use Prj.Util;
+with Prj_Output;
with Projects.Editor.Normalize; use Projects.Editor.Normalize;
with Projects.Graphs; use Projects.Graphs;
with Projects.Registry; use Projects.Registry;
@@ -3188,7 +3189,7 @@ package body Projects.Editor is
Tmp_Prj : Project_Type;
begin
- Output.Set_Special_Output (Report_Errors);
+ Prj_Output.Set_Special_Output (Report_Errors);
Prj.Com.Fail := Fail'Unrestricted_Access;
-- Make sure we are not trying to import ourselves, since otherwise it
@@ -3219,7 +3220,7 @@ package body Projects.Editor is
(-"There is already a dependency on "
& Get_String (Prj.Tree.Name_Of (Imported_Project, Tree)));
end if;
- Output.Set_Special_Output (null);
+ Prj_Output.Cancel_Special_Output;
Prj.Com.Fail := null;
return Dependency_Already_Exists;
end if;
@@ -3250,12 +3251,12 @@ package body Projects.Editor is
(-"Circular dependency detected in the project hierarchy");
end if;
Trace (Me, "Circular dependency detected in the project hierarchy");
- Output.Set_Special_Output (null);
+ Prj_Output.Cancel_Special_Output;
Prj.Com.Fail := null;
return Circular_Dependency;
end if;
- Output.Set_Special_Output (null);
+ Prj_Output.Cancel_Special_Output;
Prj.Com.Fail := null;
Set_Project_Modified (Project, True);
@@ -3350,7 +3351,7 @@ package body Projects.Editor is
Dep_Name : Prj.Tree.Tree_Private_Part.Project_Name_And_Node;
begin
- Output.Set_Special_Output (Report_Errors);
+ Prj_Output.Set_Special_Output (Report_Errors);
Prj.Com.Fail := Fail'Unrestricted_Access;
Dep_ID := Get_String (Basename);
@@ -3370,7 +3371,7 @@ package body Projects.Editor is
(-"A different project with the same name"
& " already exists in the project tree.");
end if;
- Output.Set_Special_Output (null);
+ Prj_Output.Cancel_Special_Output;
Prj.Com.Fail := null;
return Project_Already_Exists;
else
@@ -3388,7 +3389,7 @@ package body Projects.Editor is
if Imported_Project = Empty_Node then
Trace (Me, "Add_Imported_Project: imported project not found ("
& Full_Name (Imported_Project_Location).all & ")");
- Output.Set_Special_Output (null);
+ Prj_Output.Cancel_Special_Output;
Prj.Com.Fail := null;
return Imported_Project_Not_Found;
end if;
============================================================
--- kernel/src_info/projects-registry.adb cf68abd7cfc2c0eda82604216c3c3f6c805724e7
+++ kernel/src_info/projects-registry.adb a30cd2e99f63aa8343a548d6f218c878d728099e
@@ -34,8 +34,9 @@ with Opt; use Opt;
with ALI;
with Namet; use Namet;
with Opt; use Opt;
-with Output; use Output;
+with Output;
with Osint; use Osint;
+with Prj_Output; use Prj_Output;
with Scans; use Scans;
with Snames; use Snames;
with Stringt;
@@ -614,7 +615,7 @@ package body Projects.Registry is
-- view.
Opt.Full_Path_Name_For_Brief_Errors := True;
- Output.Set_Special_Output (Output.Output_Proc (Errors));
+ Prj_Output.Set_Special_Output (Output.Output_Proc (Errors));
Reset (Registry, View_Only => False);
Prj.Com.Fail := Fail'Unrestricted_Access;
@@ -643,7 +644,7 @@ package body Projects.Registry is
Unchecked_Free (Registry.Data.Scenario_Variables);
Set_Status (Registry.Data.Root, From_File);
- Output.Set_Special_Output (null);
+ Prj_Output.Cancel_Special_Output;
-- We cannot simply use Clock here, since this returns local time,
-- and the file timestamps will be returned in GMT, therefore we
@@ -672,7 +673,7 @@ package body Projects.Registry is
exception
when E : others =>
Trace (Exception_Handle, E);
- Output.Set_Special_Output (null);
+ Prj_Output.Cancel_Special_Output;
raise;
end Internal_Load;
============================================================
--- plugins.gpr 6df1e78475f8d6ffdd5de8e5035d2eda9ccfbd89
+++ plugins.gpr f32dca1280563c9fc411bb539bce9d6339c406a9
@@ -3,8 +3,20 @@ project Plugins is
project Plugins is
for Languages use ("XML", "Python");
- for Source_Dirs use ("share", "share/plug-ins", "share/library");
+ for Source_Dirs use
+ ("share", "share/plug-ins", "share/plug-ins/gps_utils",
+ "share/library", "share/library/pygps");
+ package Naming is
+ for Implementation_Suffix ("Python") use ".py";
+ for Implementation_Suffix ("XML") use ".xml";
+ end Naming;
+
+ package Compiler is
+ for Driver ("Python") use "";
+ for Driver ("XML") use "";
+ end Compiler;
+
package IDE renames Shared.IDE;
end Plugins;
============================================================
--- share/default.gpr 18e238c51de9d4000f4574c9c94c2db474d045f2
+++ share/default.gpr 7acb233996eceaa9449a092cc60c0a49c170c0ff
@@ -1,16 +1,7 @@ project Default is
project Default is
- type Mode_Type is ("Production", "Debug");
- Mode : Mode_Type := external ("BUILD", "Debug");
-
package Compiler is
- case Mode is
- when "Debug" =>
- for Default_Switches ("Ada") use
- ("-g", "-gnato", "-fstack-check", "-gnatVa");
- when "Production" =>
- for Default_Switches ("Ada") use ("-gnatp", "-O2");
- end case;
+ for Default_Switches ("Ada") use ("-g", "-O2");
end Compiler;
package IDE is
============================================================
--- share/library/ispell.py 9b42dda01bce94d8ff864ba0150c924351a5b7a3
+++ share/library/ispell.py 190234fb463c6af995513916d9bd3aa14491cba4
@@ -204,14 +204,14 @@ class Ispell:
# output of aspell ends with an empty line, but includes
# multiple blank lines
- result = self.proc.expect ("^\\n", timeout=2000)
+ result = self.proc.expect ("^[\\r\\n]+", timeout=2000)
if result != None: break
attempt = attempt + 1
self.proc.kill()
self.proc = None
try:
- return result.strip(" \n")
+ return result.strip(" \r\n")
except:
GPS.Console ("Messages").write ("Error while parsing ispell=" + result + "\n")
============================================================
--- share/library/rectangles.py c409f93da0f6fd3c8a512ab2b70a359e24edbdda
+++ share/library/rectangles.py 573a0be96c09e77c6caba5046693cfe0ef601ad7
@@ -181,21 +181,30 @@ def apply_on_rectangle (func, start, end
try:
if start.buffer() == end.buffer():
- if start > end:
- current = start
- start = end
- end = current
- else:
- current = start
+ line = min (start.line (), end.line ())
+ maxline = max (start.line (), end.line ())
+ mincol = min (start.column (), end.column ())
+ maxcol = max (start.column (), end.column ())
+ buf = start.buffer ()
- start.buffer().start_undo_group()
- while current < end:
- endcolumn = EditorLocation (current.buffer(), current.line(), end.column())
+ buf.start_undo_group()
+
+ while line <= maxline:
+ ## Some lines might not include enough characters for the rectangle
+ eol = EditorLocation (buf, line, 1).end_of_line ()
+ if eol.column () > maxcol:
+ endcolumn = EditorLocation (buf, line, maxcol)
+ current = EditorLocation (buf, line, mincol)
+ else:
+ endcolumn = eol - 1
+ if eol.column () > mincol:
+ current = EditorLocation (buf, line, mincol)
+ else:
+ current = eol - 1
+
func (start, end, current, endcolumn, *args)
- if current.line() == start.buffer().lines_count():
- current = end
- else:
- current = EditorLocation (start.buffer(), current.line() + 1, start.column())
+ line = line + 1
+
start.buffer().finish_undo_group()
except:
Logger ("RECTANGLE").log ("Unexpected exception: " + traceback.format_exc())
============================================================
--- share/plug-ins/build_modes.xml 53d41e07f841cc0579cc67a9e6bd1fd51c3b0b83
+++ share/plug-ins/build_modes.xml 78024b088724be9a146448623cd8c5752f44e2cf
@@ -20,6 +20,37 @@
</extra-args>
</builder-mode>
+ <builder-mode name="checks">
+ <description>Build with full checking enabled</description>
+ <subdir>check</subdir>
+ <supported-model>builder</supported-model>
+ <supported-model>gnatmake</supported-model>
+ <supported-model filter="--subdirs=">gprclean</supported-model>
+ <extra-args>
+ <arg>--subdirs=%subdir</arg>
+ <arg>-cargs</arg>
+ <arg>-g</arg>
+ <arg>-O0</arg>
+ <arg>-gnato</arg>
+ <arg>-fstack-check</arg>
+ <arg>-gnatVa</arg>
+ </extra-args>
+ </builder-mode>
+
+ <builder-mode name="optimize">
+ <description>Build for production with full optimization</description>
+ <subdir>opt</subdir>
+ <supported-model>builder</supported-model>
+ <supported-model>gnatmake</supported-model>
+ <supported-model filter="--subdirs=">gprclean</supported-model>
+ <extra-args>
+ <arg>--subdirs=%subdir</arg>
+ <arg>-cargs</arg>
+ <arg>-O2</arg>
+ <arg>-gnatn</arg>
+ </extra-args>
+ </builder-mode>
+
<builder-mode name="gcov">
<description>Build with gcov support</description>
<subdir>gcov</subdir>
@@ -29,7 +60,8 @@
<extra-args>
<arg>--subdirs=%subdir</arg>
<arg>-cargs</arg>
- <arg>--coverage</arg>
+ <arg>-fprofile-arcs</arg>
+ <arg>-ftest-coverage</arg>
<arg>-largs</arg>
<arg>--coverage</arg>
</extra-args>
============================================================
--- share/plug-ins/gnatpsta.py 04f8333908787a18a835f14bb711b39a3171fd35
+++ share/plug-ins/gnatpsta.py 4f98b4ebc989bf6b8c4fef49e0b8686de0b58bf0
@@ -15,7 +15,7 @@ from GPS import *
############################################################################
from GPS import *
-import os, tempfile
+import os, tempfile, os_utils
from gps_utils import *
def on_exit (process, exit_status, output):
@@ -36,14 +36,16 @@ def display():
dir = tempfile.mkdtemp ()
path = None
- try:
+ if os_utils.locate_exec_on_path ("gnatpsta") != "":
proc = Process ("gnatpsta", on_exit=on_exit)
- except:
+ else:
path = dir + "/p.ads"
f = open (path, "w")
f.write ("package p is end p;")
f.close ()
- proc = Process ("gcc -c -xada -gnatc -gnatS " + path, on_exit=on_exit)
+ proc = Process \
+ (Project.root().get_attribute_as_string("gnat", "ide") +
+ " compile -q -gnatc -gnatS " + path, on_exit=on_exit)
proc.standard = dir + "/standard.ads"
proc.wait()
============================================================
--- share/plug-ins/gps_utils/__init__.py a8747ff4b888b09f6f10584a05ad3868f38cb658
+++ share/plug-ins/gps_utils/__init__.py c819fdda40eac331f857b016fd71be9e4be11d35
@@ -133,15 +133,16 @@ def in_ada_file (context):
def in_ada_file (context):
"""Returns True if the focus is currently inside an Ada editor"""
if not hasattr (context, "in_ada_file"):
- buffer = EditorBuffer.get ()
- context.in_ada_file = MDI.current ().name () == buffer.file().name () \
+ buffer = EditorBuffer.get (open=False)
+ context.in_ada_file = buffer \
+ and MDI.current ().name () == buffer.file().name () \
and buffer.file ().language ().lower () == "ada"
return context.in_ada_file
def in_xml_file (context):
"""Returns True if the focus is in an XML editor"""
if not hasattr (context, "in_xml_file"):
- buffer = EditorBuffer.get ()
+ buffer = EditorBuffer.get (open=False)
context.in_xml_file = MDI.current ().name () == buffer.file().name () \
and buffer.file ().language ().lower () in ["xml", "html"]
return context.in_xml_file
============================================================
--- share/plug-ins/gps_utils/console_process.py 0266d3172c1bf6eb691894b4c25de5f0f1349a6d
+++ share/plug-ins/gps_utils/console_process.py 8ad566d40bd8af62c47575177b729b7315fc381b
@@ -1,5 +1,20 @@
-import GPS
+import GPS, sys
+Shift_Mask = 1
+Lock_Mask = 2
+Control_Mask = 4
+Mod1_Mask = 8
+Mod2_Mask = 16
+
+Key_Return = 65293
+Key_Backspace = 65288
+Key_Tab = 65289
+Key_Left = 65361
+Key_Up = 65362
+Key_Right = 65363
+Key_Down = 65364
+Key_Escape = 65307
+
class Console_Process (GPS.Console, GPS.Process):
"""This class provides a way to spawn an interactive process and
do its input/output in a dedicated console in GPS.
@@ -23,6 +38,9 @@ class Console_Process (GPS.Console, GPS.
However, because of that the __init__ method that would be called
when calling My_Process (...) is also that of ANSI_Console.
Therefore you must define your own __init__ method locally.
+
+ See also the class ANSI_Console_Process if you need your process
+ to execute within a terminal that understands ANSI escape sequences.
"""
def on_output (self, matched, unmatched):
@@ -39,7 +57,7 @@ class Console_Process (GPS.Console, GPS.
self.destroy () # Close console
else:
self.write (remaining_output)
- self.write ("exit status: " + `status`)
+ self.write ("\nexit status: " + `status`)
except: pass # Might have already been destroyed if that's what
# resulted in the call to on_exit
@@ -72,32 +90,141 @@ class Console_Process (GPS.Console, GPS.
about completion, such as an OS shell for instance, you could have
a different implementation. input is the full input till, but not
including, the tab character"""
- self.write ("\n")
+ self.write ("\t")
- def __init__ (self, process, args="", close_on_exit=True, force = False):
+ def on_key (self, keycode, key, modifier):
+ """The user has pressed a key in the console (any key). This is called
+ before any of the higher level on_completion or on_input callbacks.
+ If this subprogram returns True, GPS will consider that the key has
+ already been handled and will not do its standard processing with it.
+ By default, we simply let the key through and let GPS handle it.
+
+ _key_ is the unicode character (numeric value) that was entered by
+ the user. _modifier_ is a mask of the control and shift keys that
+ were pressed at the same time. See the *_Mask constants above.
+ keycode is the code of the key, which is useful for non-printable
+ characters. It is set to 0 in some cases if the input is simulated
+ after the user has copied some text into the console
+
+ This function is also called for each character pasted by the user
+ in the console. If it returns True, then the selection will not be
+ inserted in the console.
+ """
+ return False
+
+ def __init__ (self, process, args="", close_on_exit=True, force = False,
+ ansi = False, manage_prompt = True):
"""Spawn a new interactive process and show its input/output in a
new GPS console. The process is created so that it does not
appear in the task manager, and therefore the user can exit GPS
- without being asked whether or not to kill the process."""
+ without being asked whether or not to kill the process.
+
+ If _force_ is set to True, a new console is opened, otherwise an
+ existing one will be reused (although you should take care in this
+ case if you have multiple processes attached to the same console).
+
+ If _manage_prompt_ is True, then GPS will do some higher level
+ handling of prompts: when some output is done by the process, GPS
+ will temporarily hide what the user was typing, insert the output,
+ and append what the user was typing. This is in general suitable but
+ might interfer with external programs that do their own screen
+ management through ANSI commands (like a Unix shell for instance)."""
self.close_on_exit = close_on_exit
try:
GPS.Console.__init__ (
self, process.split()[0],
- on_input = self.on_input,
- on_destroy = self.on_destroy,
- on_resize = self.on_resize,
- on_interrupt = self.on_interrupt,
+ manage_prompt = manage_prompt,
+ on_input = self.on_input,
+ on_destroy = self.on_destroy,
+ on_resize = self.on_resize,
+ on_interrupt = self.on_interrupt,
on_completion = self.on_completion,
- force = force)
+ on_key = self.on_key,
+ ansi = ansi,
+ force = force)
GPS.Process.__init__ (
self, process + " " + args, ".+",
single_line_regexp=True, # For efficiency
+ strip_cr = not ansi, # If ANSI terminal, CR is relevant
task_manager=False,
on_exit = self.on_exit,
on_match = self.on_output)
GPS.MDI.get_by_child (self).raise_window ()
except:
- self.destroy()
- self.kill()
+ GPS.Console().write (str (sys.exc_info()[1]) + "\n")
+ try:
+ self.destroy()
+ self.kill()
+ except:
+ pass
GPS.Console().write ("Could not spawn: " + process + " " + args + "\n")
+class ANSI_Console_Process (Console_Process):
+ """This class has a purpose similar to Console_Process.
+ However, this class does not attempt to do any of the high-level
+ processing of prompt and input that Console_Process does, and instead
+ forward immediately any of the key strokes within the console directly
+ to the external process.
+ It also provides an ANSI terminal to the external process. The latter
+ can thus send escape sequences to change colors, cursor position,...
+ """
+
+ def on_input (self, input):
+ # Do nothing, this was already handled when each key was pressed
+ pass
+
+ def on_completion (self, input):
+ # Do nothing, this was already handled when each key was pressed
+ pass
+
+ def __get_key_str (self, keycode, key):
+ """Convert a key/keycode into a string that can be sent to an external
+ process"""
+ if keycode == Key_Return:
+ return "\r"
+ elif keycode == Key_Tab:
+ return "\t"
+ elif keycode == Key_Backspace:
+ return chr (8)
+ elif key != 0:
+ return unichr (key).encode ("utf8")
+ elif keycode == Key_Escape:
+ return "\033"
+ elif keycode == Key_Left:
+ return "\033[D"
+ elif keycode == Key_Right:
+ return "\033[C"
+ elif keycode == Key_Up:
+ return "\033[A"
+ elif keycode == Key_Down:
+ return "\033[B"
+ else:
+ GPS.Logger ("CONSOLE").log ("keycode=" + `keycode` + " key=" + `key`)
+ return ""
+
+ def on_key (self, keycode, key, modifier):
+ if modifier == 0 or modifier == Shift_Mask:
+ self.send (self.__get_key_str (keycode, key), add_lf=False)
+
+ elif modifier == Control_Mask:
+ if key in range (ord ('A'), ord ('_') + 1):
+ self.send (chr (key - ord ('A') + 1), add_lf=False)
+ elif key in range (ord ('a'), ord ('z') + 1):
+ # Same as pressing the upper-case equivalent
+ self.send (chr (key - ord ('a') + 1), add_lf=False)
+ elif keycode == Key_Return or keycode == Key_Escape:
+ # Same as key without return
+ self.send ("\n", add_lf=False)
+ else:
+ # Seems like most terminals just send ESC in such a case
+ self.send ("\033", add_lf=False)
+
+ else:
+ GPS.Logger ("CONSOLE").log ("keycode=" + `keycode` + " key=" + `key` + " modifier=" + `modifier`)
+
+ return True
+
+ def __init__ (self, process, args=""):
+ Console_Process.__init__ (self, process, args, force = True,
+ ansi = True, manage_prompt = False)
+
============================================================
--- share/plug-ins/shell.py 19ef3f47c2ef56240c3a8873b398a62a0db69dfb
+++ share/plug-ins/shell.py 54d4c7610955fa377efe256a29e948746296d62c
@@ -16,23 +16,12 @@ from gps_utils.console_process import *
import GPS, re, traceback, os
from gps_utils.console_process import *
-class Ansi_Console (GPS.Console):
- """A console that hides ANSI escape sequences"""
-
- ansi_re = re.compile (r'\033\[\d*(;\d+)*[HfABCDRsuJKm]')
-
- def write (self, txt):
- txt = re.sub (Ansi_Console.ansi_re, "", txt)
- GPS.Console.write (self, txt)
-
-class Unix_Shell (Ansi_Console, Console_Process):
- def on_output (self, matched, unmatched):
- Console_Process.on_output (self, matched, unmatched)
-
+class Unix_Shell (ANSI_Console_Process):
def __init__ (self, process, args=""):
- os.putenv ("EMACS", "t") # Emulate whas emacs does, since some shells
- # rely on this (zsh)
- Console_Process.__init__ (self, process, args, force = True)
+ oldterm = os.environ["TERM"]
+ os.environ["TERM"] = "xterm"
+ ANSI_Console_Process.__init__ (self, process, args)
+ os.environ["TERM"] = oldterm
def create_default_shell (menu):
"""Spawns the user's shell as read from the environment variable SHELL"""
============================================================
--- share/plug-ins/spark.py 8ce28f9527f37b8ac1cfd3ee38f4770ef9850fd5
+++ share/plug-ins/spark.py d0854ffbe3614c1bb14a0804b1f9c958855d95b5
@@ -1,5 +1,5 @@
"""This file provides utilities used by the SPARK plug-in for GPS.
-Copyright (c) 2004-2007 Praxis High Integrity Systems Limited
+Copyright (c) 2004-2008 Praxis High Integrity Systems Limited
Copyright (c) 2005-2008 AdaCore
SPARK Toolset Customization for GPS
@@ -63,12 +63,18 @@ def on_match (process, match, since_last
spark_separator='-'
def on_match (process, match, since_last):
+ try:
+ process.output += since_last + match
+ except:
+ process.output = since_last + match
GPS.Console (spark_console).write (since_last + match)
-def on_exit (process, status, full_output):
- # Protect "Flow Error:123:" from being detected as a file reference
+def on_exit (process, status, remaining_output):
+ # Protect e.g. "Flow Error:123:" from being detected as a file reference
GPS.Locations.parse (
- full_output.replace (" Error:"," Error "), category=spark_category)
+ process.output.replace (" Error:"," Error,").replace \
+ (" Warning:"," Warning,"),
+ category=spark_category)
def examine_file (file):
"""Examine current file through the SPARK examiner. file is an instance
@@ -77,7 +83,7 @@ def examine_file (file):
GPS.Locations.remove_category (spark_category)
sw = file.project().get_tool_switches_as_string ("Examiner")
cmd = "spark "+sw + " "+spark_separator+'brief "' + file.name() + '"'
- GPS.Console (spark_console).clear ()
+ GPS.Console (spark_console, accept_input=False).clear ()
GPS.Console (spark_console).write (cmd + "\n")
GPS.Process (cmd, remote_server="Build_Server", regexp=".+", on_match=on_match, on_exit=on_exit)
GPS.MDI.get (spark_console).raise_window ()
@@ -116,7 +122,7 @@ def show_pogs_file():
GPS.cd (dir)
sw = GPS.Project.root().get_tool_switches_as_string ("POGS")
cmd = "pogs " + sw
- GPS.Console (pogs_console).clear ()
+ GPS.Console (pogs_console, accept_input=False).clear ()
GPS.Console (pogs_console).write (cmd + "\n")
GPS.Console (pogs_console).write (GPS.Process (cmd, remote_server="Build_Server").get_result())
GPS.MDI.get (pogs_console).raise_window ()
@@ -173,7 +179,7 @@ def sparkmake ():
GPS.MDI.save_all (False)
sw = GPS.current_context().project().get_tool_switches_as_string ("SPARKmake")
cmd = "sparkmake " + sw + " " + GPS.current_context().file().name()
- GPS.Console (spark_console).clear ()
+ GPS.Console (spark_console, accept_input=False).clear ()
GPS.Console (spark_console).write (cmd + "\n")
GPS.Console (spark_console).write (GPS.Process (cmd, remote_server="Build_Server").get_result())
GPS.MDI.get (spark_console).raise_window ()
@@ -270,6 +276,7 @@ a = """<?xml version="1.0"?>
<field line="1" label="Warning File " as-file="true" switch="~warning_file=" />
<field line="1" label="Configuration File " as-file="true" switch="~config=" />
<field line="1" label="Output directory" as-dir="true" switch="~output_directory" separator="="/>
+ <check column="1" line="1" label="Ignore spark.sw" switch="~noswitch" />
<title line="1" column="2" column-span="0" />
<title column="1" line="2">Language</title>
<radio column="1" line="2" >
@@ -350,7 +357,7 @@ a = """<?xml version="1.0"?>
<tool name="SPARKFormat">
<language>SPARK</language>
<language>Ada</language>
- <switches lines="3" columns="3" switch_char="~">
+ <switches lines="4" columns="4" switch_char="~">
<title line="1" column="1">Global variables modes</title>
<radio line="1" column="1">
<radio-entry label="Unchanged" switch="~noadd_modes" />
@@ -376,17 +383,19 @@ a = """<?xml version="1.0"?>
<title line="2" column="2">Annotations</title>
<field line="2" column="2" label="Annotation Character" switch="~annotation_character=" tip="Enter a single character to follow '--' as the mark for SPARK annotations (default '#')" />
- <title line="3" column="1" column-span="2">Indentation</title>
- <field line="3" column="1" label="Globals indentation" switch="~global_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for the global variables, or state 'inline' (default 'inline')" />
- <field line="3" label="Exports indentation" switch="~export_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for the export variables, or state 'inline' (default 'inline')" />
- <field line="3" label="Imports indentation" switch="~import_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for the import variables, or state 'inline' (default 'inline')" />
- <field line="3" label="Seperators indentation" switch="~separator_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for the separators ('from' and ampersand), or state 'inline' (default 'inline')" />
- <field line="3" label="Inherits indentation" switch="~inherit_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for the package names, or state 'inline' (default 'inline')" />
- <field line="3" label="Own indentation" switch="~own_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for own variables, or state 'inline' (default 'inline')" />
- <field line="3" label="Refinement indentation" switch="~refinement_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for own variables, or state 'inline' (default 'inline')" />
- <field line="3" label="Constituent indentation" switch="~constituent_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for constituents, or state 'inline' (default 'inline')" />
- <field line="3" label="Initialization indentation" switch="~initialization_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for own variables, or state 'inline' (default 'inline')" />
- <field line="3" label="Properties indentation" switch="~properties_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for own variables, or state 'inline' (default 'inline')" />
+ <title line="3" column="1">Default Switch File</title>
+ <check line="3" column="1" label="Ignore spark.sw" switch="~noswitch" />
+ <title line="4" column="1" column-span="2">Indentation</title>
+ <field line="4" column="1" label="Globals indentation" switch="~global_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for the global variables, or state 'inline' (default 'inline')" />
+ <field line="4" label="Exports indentation" switch="~export_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for the export variables, or state 'inline' (default 'inline')" />
+ <field line="4" label="Imports indentation" switch="~import_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for the import variables, or state 'inline' (default 'inline')" />
+ <field line="4" label="Seperators indentation" switch="~separator_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for the separators ('from' and ampersand), or state 'inline' (default 'inline')" />
+ <field line="4" label="Inherits indentation" switch="~inherit_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for the package names, or state 'inline' (default 'inline')" />
+ <field line="4" label="Own indentation" switch="~own_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for own variables, or state 'inline' (default 'inline')" />
+ <field line="4" label="Refinement indentation" switch="~refinement_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for own variables, or state 'inline' (default 'inline')" />
+ <field line="4" label="Constituent indentation" switch="~constituent_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for constituents, or state 'inline' (default 'inline')" />
+ <field line="4" label="Initialization indentation" switch="~initialization_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for own variables, or state 'inline' (default 'inline')" />
+ <field line="4" label="Properties indentation" switch="~properties_indent=" tip="Enter a number ( >0 )for the amount of indentation from '--#' for own variables, or state 'inline' (default 'inline')" />
</switches>
</tool>
============================================================
--- share/shell_commands.xml 4308d628a11619d0df704f5010d7ea81eb2685a6
+++ share/shell_commands.xml a94f2e3618b0849079b39e097725e1cc9f75264c
@@ -971,6 +971,15 @@ GPS.parse_xml ("""
<description>Reset the internal cross-reference database that GPS is using for most of its navigation facilities. You shouldn't have to call that yourself, since in general GPS should know by itself when it is necessary to refresh its database. However, this might be used as a workaround if you think you have troubles with the cross-reference information which isn't accurate.</description>
</shell_doc>
+ <shell_doc name="GPS.set_build_mode">
+ <param name="mode" default="">Name of the mode to set</param>
+ <description>Set the current build mode. If specified mode is not a registered mode, do nothing.</description>
+ </shell_doc>
+
+ <shell_doc name="GPS.get_build_mode">
+ <description>Return the name of the current build mode. Return an empty string if no mode is registered.</description>
+ </shell_doc>
+
<!--#################################################################
#### GPS shell commands
###################################################################-->
@@ -3130,7 +3139,7 @@ Note that this class is in fact availabl
class Console_Process (GPS.Console, GPS.Process):
def on_output (self, matched, unmatched):
self.write (unmatched + matched)
- def on_exit (self, status, full_output):
+ def on_exit (self, status, unmatched_output):
try: self.destroy ()
except: pass # Might already have been destroyed
def on_input (self, input):
@@ -3164,6 +3173,9 @@ Note that this class is in fact availabl
<param name="on_resize" default="">A subprogram</param>
<param name="on_interrupt" default="">A subprogram</param>
<param name="on_completion" default="">A subprogram</param>
+ <param name="on_key" default="">A subprogram</param>
+ <param name="manage_prompt" default="True">A boolean</param>
+ <param name="ansi" default="False">A boolean</param>
<description>Create a new instance of GPS.Console. GPS will try to reuse any existing console with the same name. If none exists yet, or the parameter force is set to True, then GPS will create a new console.
You cannot create the Python and Shell consoles through this call. If you do, an exception is raised. Instead, use GPS.execute_action ("/Tools/Consoles/Python"), and then get a handle on the console through GPS.Console. This is because these two consoles are tightly associated with each of the scripting languages.
@@ -3189,6 +3201,28 @@ The subprogram on_interrupt is called wh
The subprogram on_resize is called whenever the console is resized by the user. It is passed three parameters: $1 is the instance of GPS.Console, $2 is the number of visible rows in the console, and $3 is the number of visible columns. This is mostly useful when a process is running in the console, in which case you can use GPS.Process.set_size to let the process know about the size. Note that the size passed to this callback is conservative: since all characters might not have the same size, GPS tries to compute the maximal number of visible characters and pass this to the callback, but the exact number of characters might depend on the font.
The subprogram on_interrupt is called when the user presses control-c in the console. It receives a single parameter, which is the instance of GPS.Console. By default a control-c is handled by GPS itself and will kill the last process that was started.
+
+As described above, GPS provides a high-level handling of consoles, where it manages histories, completion, command line editing and execution on its own through the callbacks described above. This is in general a good thing and provides advanced functionalities to some programs that lack them. However, there are cases where this gets in the way. For instance, if you want to run a Unix shell or a program that manipulates the console by moving the cursor around on its own, the high-level handling of GPS gets in the way. In such a case, the following parameters can be used: on_key, manage_prompt and ansi.
+
+ansi should be set to true if GPS should emulate an ANSI terminal. These are terminals that understand certain escape sequences that applications sent to move the cursor to specific positions on screen or to change the color and attributes of text.
+
+manage_prompt should be set to False to disable GPS's handling of prompt. In general, this is incompatible with using the on_input callback, since GPS no longer distinguishes what was typed by the user and what was written by the external application. This also means that the application is free to write anywhere on the screen. This should in general be set to True if you expect your application to send ANSI sequences.
+
+on_key is a subprogram that is called every time the user presses a key in the console. This is much lower-level than the other callbacks above, but if you are driving external applications you might have a need to send the keys as they happen, and not wait for a newline. on_key receives four parameters:
+ - $1: the instance of GPS.Console
+ - $2: "keycode": this is the internal keycode for the key that the user
+ pressed. All keys can be represented this way, but this will
+ occasionaly be left to 0 when the user input was simulated and no
+ real key was pressed.
+ - $3: "key": this is the unicode character that the user entered. This will
+ be 0 when the character is not printable (for instance return, tab,
+ key up,...). In python, you can manipulate it with code like
+ unichr (key).encode ("utf8")
+ to get a string representation that can be sent to an external
+ process
+ - $4: "modifier": these are the state of the control, shift, mod1 and lock
+ keys. This is a bitmask, where shift is 1, lock is 2, control is 4
+ and mod1 is 8.
</description>
</shell_doc>
@@ -3488,6 +3522,10 @@ The action takes a single argument, whic
<description>Interface for handling customized documentation generation. This class is used in conjunction with GPS.DocgenTagHandler. You cannot create directly this class, but use the ones furnished in GPS.DocgenTagHandler callbacks.</description>
<see_also name="GPS.DocgenTagHandler" />
</shell_doc>
+ <shell_doc name="GPS.Docgen.register_css">
+ <param name="filename">A file name</param>
+ <description>Registers a new CSS file to use when generating the documentation. This allows either to override a default style, or add new ones for custom tags handling</description>
+ </shell_doc>
<shell_doc name="GPS.Docgen.register_tag_handler">
<param name="handler">The handler to register</param>
<description>Registers a new tag handler. This handler will be used each time a new documentation is generated and the corresponding tag is found</description>
@@ -3548,6 +3586,7 @@ def on_gps_start (hook):
docgen.generate_index_file ("Screenshots", "screenshots.html", content);
def on_gps_start (hook):
+ GPS.Docgen.register_css (GPS.get_system_dir() + "share/mycustomfiles/custom.css")
GPS.Docgen.register_tag_handler (ScreenshotTagHandler ())
GPS.Hook ("gps_started").add (on_gps_start)
@@ -3649,6 +3688,7 @@ My_Gdb()
<param name="show_command" default="False">A boolean</param>
<param name="single_line_regexp" default="False">A boolean</param>
<param name="case_sensitive_regexp" default="True">A boolean</param>
+ <param name="strip_cr" default="True">A boolean</param>
<description>Spawn specified command. Command can include triple-quoted strings, similar to python, which will always be preserved as one argument.
If regexp is not-empty and on_match_action is specified, launch on_match_action when regexp is found in the process output. If on_exit_action is specified, execute it when the process terminates. Return the ID of the spawned process.
@@ -3676,6 +3716,8 @@ If show_command is set, then the command
If show_command is set, then the command line used to spawn the new Process is displayed in the "Messages" console.
+If strip_cr is true, the output of the process will have all its \r removed before the string is passed on to GPS and your script. This in general provides better portability to Windows systems, but might not be suitable for applications for which CR is relevant (for instance those that drive an ANSI terminal).
+
An exception is raised if the process could not be spawned.</description>
<see_also name="GPS.Process"/>
</shell_doc>
============================================================
--- src_editor/src/completion_module.adb 165da68871bc0c4a1c804887ad87ab394e2902d5
+++ src_editor/src/completion_module.adb c0e1f73f148ca931bb6c5135cdda495f88894c11
@@ -1077,8 +1077,7 @@ package body Completion_Module is
(Handle => Kernel,
Callback => Load_One_File_Constructs'Access,
Chunk_Size => 1,
- Queue_Base_Name => Db_Loading_Queue,
- Kill_Existing_Queue => True,
+ Queue_Name => Db_Loading_Queue,
Operation_Name => "load entity db");
end Load_Construct_Database;
============================================================
--- src_editor/src/src_editor_buffer-line_information.adb 0cc78743c9e86ee580dae376567a0c7dda9a3f1b
+++ src_editor/src/src_editor_buffer-line_information.adb 2bfe6548dd0fe5d53c85a3917625d59c37f8ce4b
@@ -48,12 +48,15 @@ package body Src_Editor_Buffer.Line_Info
Me : constant Debug_Handle := Create ("Src_Editor_Buffer.Line_Information");
Block_Info_Column : constant String := "Block Information";
- -- Identifier for the block information column.
+ -- Identifier for the block information column
+ procedure Free (Info : in out Line_Information_Access);
+ -- Free memory associated with Info
+
procedure Remove_Line_Information_Column
(Buffer : access Source_Buffer_Record'Class;
Column : Integer);
- -- Remove the column from the side window information in Buffer.
+ -- Remove the column from the side window information in Buffer
procedure Remove_Blank_Lines
(Buffer : access Source_Buffer_Record'Class;
@@ -194,7 +197,7 @@ package body Src_Editor_Buffer.Line_Info
for J in Buffer.Editable_Lines'Range loop
if Buffer.Editable_Lines (J).Side_Info_Data = null then
- -- ??? Code duplication with Add_Lines.
+ -- ??? Code duplication with Add_Lines
Buffer.Editable_Lines (J).Side_Info_Data := new
Line_Info_Width_Array (Columns_Config.all'Range);
@@ -270,7 +273,7 @@ package body Src_Editor_Buffer.Line_Info
Width := Columns_Config.all (Column).Width;
- -- Free the column for all data.
+ -- Free the column for all data
for J in Editable_Lines'Range loop
if Editable_Lines (J).Side_Info_Data /= null then
@@ -368,18 +371,27 @@ package body Src_Editor_Buffer.Line_Info
Side_Column_Configuration_Changed (Buffer);
end Remove_Line_Information_Column;
+ ----------
+ -- Free --
+ ----------
+
+ procedure Free (Info : in out Line_Information_Access) is
+ begin
+ GNAT.Strings.Free (Info.Text);
+ GNAT.Strings.Free (Info.Tooltip_Text);
+ Unchecked_Free (Info);
+ end Free;
+
---------------------------
-- Free_File_Information --
---------------------------
procedure Free_File_Information
- (Buffer : access Source_Buffer_Record'Class) is
+ (Buffer : access Source_Buffer_Record'Class) is
begin
if Buffer.Extra_Information /= null then
for J in Buffer.Extra_Information'Range loop
- GNAT.Strings.Free (Buffer.Extra_Information (J).Info.Text);
- GNAT.Strings.Free (Buffer.Extra_Information (J).Info.Tooltip_Text);
- Unchecked_Free (Buffer.Extra_Information (J).Info);
+ Free (Buffer.Extra_Information (J).Info);
GNAT.Strings.Free (Buffer.Extra_Information (J).Identifier);
Unchecked_Free (Buffer.Extra_Information (J));
end loop;
@@ -428,7 +440,7 @@ package body Src_Editor_Buffer.Line_Info
else
for J in Buffer.Extra_Information'Range loop
if Buffer.Extra_Information (J).Identifier.all = Identifier then
- Unchecked_Free (Buffer.Extra_Information (J).Info);
+ Free (Buffer.Extra_Information (J).Info);
Buffer.Extra_Information (J).Info :=
new Line_Information_Record'(Info (Info'First));
Found := True;
@@ -456,7 +468,7 @@ package body Src_Editor_Buffer.Line_Info
return;
end if;
- -- If we reach this point, the info corresponds to line information.
+ -- If we reach this point, the info corresponds to line information
Layout := Create_Pango_Layout (Box);
Set_Font_Description (Layout, Default_Style.Get_Pref_Font);
@@ -515,7 +527,7 @@ package body Src_Editor_Buffer.Line_Info
return;
end if;
- -- The column has been found: update the stored data.
+ -- The column has been found: update the stored data
for K in Info'Range loop
Editable_Line := Editable_Line_Type (K);
@@ -599,10 +611,10 @@ package body Src_Editor_Buffer.Line_Info
procedure Draw_Info (Starting_X : Gint);
pragma Inline (Draw_Info);
- -- Draw the info contained in Line_Info, at offset Starting_X.
+ -- Draw the info contained in Line_Info, at offset Starting_X
procedure Draw_Line_Info;
- -- Draw the line number for Editable_Line.
+ -- Draw the line number for Editable_Line
procedure Draw_Blank_Line_Info;
-- Draw information for an area where there is no editable line
@@ -805,7 +817,7 @@ package body Src_Editor_Buffer.Line_Info
Apply_Tag (Buffer, Buffer.Non_Editable_Tag, Iter, End_Iter);
- -- Shift down editable lines.
+ -- Shift down editable lines
for J in Line .. Buffer.Editable_Lines'Last loop
if Buffer.Editable_Lines (J).Where = In_Buffer then
@@ -815,7 +827,7 @@ package body Src_Editor_Buffer.Line_Info
end if;
end loop;
- -- Reset information for newly inserted buffer lines.
+ -- Reset information for newly inserted buffer lines
for J in Buffer_Line .. Buffer_Line + Buffer_Line_Type (Number) - 1 loop
Buffer.Line_Data (J).Editable_Line := 0;
@@ -930,7 +942,7 @@ package body Src_Editor_Buffer.Line_Info
procedure Expand_Lines
(N : Buffer_Line_Type);
- -- Expand the line-indexed arrays to contain N lines in size.
+ -- Expand the line-indexed arrays to contain N lines in size
------------------
-- Expand_Lines --
@@ -1012,7 +1024,7 @@ package body Src_Editor_Buffer.Line_Info
Buffer.Original_Text_Inserted := True;
else
- -- Figure out whether we need to expand the line arrays.
+ -- Figure out whether we need to expand the line arrays
Bottom_Line := Buffer_Line_Type'Max
(Buffer_Line_Type (Get_Line_Count (Buffer)),
@@ -1046,7 +1058,7 @@ package body Src_Editor_Buffer.Line_Info
end loop;
end if;
- -- Reset the newly inserted lines.
+ -- Reset the newly inserted lines
for J in 0 .. Number - 1 loop
Buffer_Lines (Start + J) := New_Line_Data;
@@ -1194,7 +1206,7 @@ package body Src_Editor_Buffer.Line_Info
Get_Iter_At_Line (Buffer, Iter, Gint (Buffer_Line_At_Blanks) - 1);
Copy (Iter, End_Iter);
- -- Compute the real number of blank lines.
+ -- Compute the real number of blank lines
Buffer_Line := Buffer_Line_At_Blanks;
@@ -1208,7 +1220,7 @@ package body Src_Editor_Buffer.Line_Info
exit when Real_Number = Buffer_Line_Type (Number);
end loop;
- -- Remove the non-editable tag.
+ -- Remove the non-editable tag
Copy (Iter, Begin_Tag);
Backward_Char (Begin_Tag, Success);
@@ -1218,7 +1230,7 @@ package body Src_Editor_Buffer.Line_Info
Remove_Tag (Buffer, Buffer.Non_Editable_Tag, Begin_Tag, End_Iter);
- -- Remove the lines.
+ -- Remove the lines
Buffer.Blank_Lines := Buffer.Blank_Lines - Natural (Real_Number);
@@ -1241,7 +1253,7 @@ package body Src_Editor_Buffer.Line_Info
end if;
end loop;
- -- Redraw the side column.
+ -- Redraw the side column
Side_Column_Configuration_Changed (Buffer);
Buffer.Modifying_Real_Lines := False;
@@ -1306,11 +1318,11 @@ package body Src_Editor_Buffer.Line_Info
Insert (Buffer, Start_Iter, "" & ASCII.LF);
end if;
- -- Disable emitting new cursor positions while we hide lines.
+ -- Disable emitting new cursor positions while we hide lines
Buffer.Do_Not_Move_Cursor := True;
- -- Remove all blank lines in the block that is to be folded.
+ -- Remove all blank lines in the block that is to be folded
if Buffer.Blank_Lines /= 0 then
Result := Flatten_Area (Buffer, Line_Start, Line_End);
@@ -1326,7 +1338,7 @@ package body Src_Editor_Buffer.Line_Info
end if;
if Editable_Lines (L).Where = In_Buffer then
- -- Get the line of text and store it in the pointer.
+ -- Get the line of text and store it in the pointer
Get_Iter_At_Line
(Buffer,
@@ -1351,7 +1363,7 @@ package body Src_Editor_Buffer.Line_Info
Editable_Lines (L) := Line_Data;
end;
- -- Remove the line from the screen.
+ -- Remove the line from the screen
Forward_Char (End_Iter, Result);
@@ -1369,7 +1381,7 @@ package body Src_Editor_Buffer.Line_Info
Buffer.Hidden_Lines := Buffer.Hidden_Lines + Number_Of_Lines_Folded;
- -- Shift up editable lines.
+ -- Shift up editable lines
for J in Line_End + 1 .. Buffer.Last_Editable_Line loop
if Editable_Lines (J).Where = In_Buffer then
@@ -1378,7 +1390,7 @@ package body Src_Editor_Buffer.Line_Info
end if;
end loop;
- -- Add an icon to unhide the lines.
+ -- Add an icon to unhide the lines
Command := new Unhide_Editable_Lines_Type;
Command.Buffer := Source_Buffer (Buffer);
@@ -1394,7 +1406,7 @@ package body Src_Editor_Buffer.Line_Info
Buffer.Modifying_Real_Lines := False;
Register_Edit_Timeout (Buffer);
- -- Re-enable moving the cursor, and reemit the cursor position.
+ -- Re-enable moving the cursor, and reemit the cursor position
Buffer.Do_Not_Move_Cursor := Cursor_Move;
Emit_New_Cursor_Position (Buffer);
@@ -1431,15 +1443,15 @@ package body Src_Editor_Buffer.Line_Info
First_Line := Get_Editable_Line (Buffer, Buffer_Line);
Last_Line := Get_Editable_Line (Buffer, Buffer_Line + 1);
- -- Disable emitting new cursor positions while we hide lines.
+ -- Disable emitting new cursor positions while we hide lines
Buffer.Do_Not_Move_Cursor := True;
for Line in reverse First_Line .. Last_Line loop
- -- If the line is already in the buffer, skip.
+ -- If the line is already in the buffer, skip
if Editable_Lines (Line).Where /= In_Buffer then
- -- Insert the line.
+ -- Insert the line
Get_Iter_At_Mark (Buffer, Iter, Mark);
@@ -1455,7 +1467,7 @@ package body Src_Editor_Buffer.Line_Info
Buffer.Inserting := False;
Buffer.Modifying_Editable_Lines := True;
- -- Modify editable line structure.
+ -- Modify editable line structure
declare
Line_Data : constant Editable_Line_Data :=
@@ -1467,7 +1479,7 @@ package body Src_Editor_Buffer.Line_Info
Editable_Lines (Line) := Line_Data;
end;
- -- Set the editable line information.
+ -- Set the editable line information
Buffer.Line_Data (Buffer_Line).Editable_Line := Line;
Number_Of_Lines_Unfolded := Number_Of_Lines_Unfolded + 1;
@@ -1491,7 +1503,7 @@ package body Src_Editor_Buffer.Line_Info
end if;
end loop;
- -- Highlight the inserted text.
+ -- Highlight the inserted text
Get_Iter_At_Line
(Buffer, Start_Iter, Gint (Get_Buffer_Line (Buffer, First_Line) - 1));
@@ -1500,11 +1512,11 @@ package body Src_Editor_Buffer.Line_Info
Highlight_Slice (Buffer, Start_Iter, End_Iter);
- -- Redraw the side column.
+ -- Redraw the side column
Side_Column_Configuration_Changed (Buffer);
- -- Add an icon to hide the lines.
+ -- Add an icon to hide the lines
Command := new Hide_Editable_Lines_Type;
Command.Buffer := Source_Buffer (Buffer);
@@ -1519,7 +1531,7 @@ package body Src_Editor_Buffer.Line_Info
Buffer.Modifying_Real_Lines := False;
Register_Edit_Timeout (Buffer);
- -- Re-enable moving the cursor, and reemit the cursor position.
+ -- Re-enable moving the cursor, and reemit the cursor position
Buffer.Do_Not_Move_Cursor := Cursor_Move;
Emit_New_Cursor_Position (Buffer);
@@ -1824,7 +1836,7 @@ package body Src_Editor_Buffer.Line_Info
return;
end if;
- -- Get the text tag, create it if necessary.
+ -- Get the text tag, create it if necessary
Tag := Lookup (Get_Tag_Table (Buffer), Get_Name (Style));
@@ -1888,7 +1900,7 @@ package body Src_Editor_Buffer.Line_Info
end if;
end if;
- -- Highlight/Unhighlight the text.
+ -- Highlight/Unhighlight the text
if Remove then
Remove_Tag (Buffer, Tag, Start_Iter, End_Iter);
@@ -1953,13 +1965,13 @@ package body Src_Editor_Buffer.Line_Info
Result : Boolean := False;
pragma Unreferenced (Returned);
begin
- -- There is nothing to do if the lines are real.
+ -- There is nothing to do if the lines are real
if Lines_Are_Real (Buffer) then
return False;
end if;
- -- Unfold all the lines.
+ -- Unfold all the lines
for Line in Start_Line .. End_Line loop
if Editable_Lines (Line).Where /= In_Buffer then
@@ -1968,7 +1980,7 @@ package body Src_Editor_Buffer.Line_Info
end if;
end loop;
- -- Remove all blank lines.
+ -- Remove all blank lines
if Buffer.Blank_Lines /= 0 then
Buffer_Line := Get_Buffer_Line (Buffer, Start_Line);
============================================================
--- src_editor/src/src_editor_buffer-line_information.ads bb8ff1549d216778e1e8ec5bdb0ff2284066ed51
+++ src_editor/src/src_editor_buffer-line_information.ads b596666636b20e9cf1e7786b196ce3ce41852aa9
@@ -51,7 +51,7 @@ package Src_Editor_Buffer.Line_Informati
-- User must not free Info.
procedure Free_File_Information
- (Buffer : access Source_Buffer_Record'Class);
+ (Buffer : access Source_Buffer_Record'Class);
-- Free all file information stored in the buffer
function Get_Side_Information
============================================================
--- src_editor/src/src_editor_buffer.adb 0ad931732ba2c6262892372d201bef14b6477407
+++ src_editor/src/src_editor_buffer.adb 13ee8312173e67ff097d0cd88f2a6fb38c2a5761
@@ -2761,6 +2761,7 @@ package body Src_Editor_Buffer is
Length : aliased Natural;
Last : Natural;
CR_Found : Boolean := False;
+ NUL_Found : Boolean := False;
F, L : Gtk_Text_Iter;
Valid : Boolean;
Recovering : Boolean := False;
@@ -2822,9 +2823,15 @@ package body Src_Editor_Buffer is
(Get_Language_Handler (Buffer.Kernel), Filename));
end if;
- Strip_CR (Contents.all, Last, CR_Found);
+ Strip_CR_And_NUL (Contents.all, Last, CR_Found, NUL_Found);
+ Set_Charset (Buffer, Get_File_Charset (Filename));
- Set_Charset (Buffer, Get_File_Charset (Filename));
+ if NUL_Found then
+ Console.Insert
+ (Buffer.Kernel,
+ (-"Warning: NUL characters stripped from ")
+ & Full_Name (Filename).all, Mode => Console.Error);
+ end if;
UTF8 := Glib.Convert.Convert
(Contents (Contents'First .. Last), "UTF-8",
@@ -2847,6 +2854,10 @@ package body Src_Editor_Buffer is
if not Valid then
Length := First_Invalid - 1;
+ Console.Insert
+ (Buffer.Kernel,
+ (-"Warning: invalid characters stripped from ")
+ & Full_Name (Filename).all, Mode => Console.Error);
end if;
Insert_At_Cursor (Buffer, UTF8, Gint (Length));
============================================================
--- vcs/src/vcs_view-explorer.adb 8c25a565754a0f6edc6ed6e1000df933357eb523
+++ vcs/src/vcs_view-explorer.adb 03a56dc326c47c9d9e93a8fb53c711ade05c4161
@@ -456,7 +456,7 @@ package body VCS_View.Explorer is
Get_Log_From_File (Kernel, File, False) /= GNATCOLL.VFS.No_File;
-- Set_Cache already does a copy of the File_Status, no need to
- -- redo it here
+ -- redo it here.
Line := (File_Status, Log);
Set_Cache (Get_Status_Cache, File, Line);
end if;
============================================================
--- widgets/src/build_configurations.adb 2bdb4f5e6448cebdfe943184ffe224b684885224
+++ widgets/src/build_configurations.adb d98140566a382f16da642f67755f10b851baf384
@@ -805,11 +805,12 @@ package body Build_Configurations is
-- Main node
N.Attributes := new String'
("model="""
- & XML_Protect (To_String (Target.Model.Name)) & """ " &
- "category="""
- & XML_Protect (To_String (Target.Properties.Category)) & """ " &
- "name="""
- & XML_Protect (To_String (Target.Properties.Menu_Name)) & """");
+ & Glib.Xml_Int.Protect (To_String (Target.Model.Name))
+ & """ category="""
+ & Glib.Xml_Int.Protect (To_String (Target.Properties.Category))
+ & """ name="""
+ & Glib.Xml_Int.Protect (To_String (Target.Properties.Menu_Name))
+ & """");
-- Insert a <icon> node if needed
N.Child := new Node;
============================================================
--- common/src/interactive_consoles.adb b42fba369a7ac1d219cb42655dc0fc392bbe2fd0
+++ widgets/src/interactive_consoles.adb efeda90feea8f8e66c9e34550c1995f39d1244da
@@ -31,10 +31,13 @@ with Glib.Properties; use Glib.Prope
with Glib.Values; use Glib.Values;
with Glib.Object; use Glib.Object;
with Glib.Properties; use Glib.Properties;
+with Glib.Unicode; use Glib.Unicode;
+with Gdk.Keyval; use Gdk.Keyval;
with Gdk.Types; use Gdk, Gdk.Types;
with Gdk.Types.Keysyms; use Gdk.Types.Keysyms;
with Gdk.Event; use Gdk.Event;
with Gtk.Enums; use Gtk.Enums;
+with Gtk.Handlers;
with Gtk.Main; use Gtk.Main;
with Gtk.Object; use Gtk.Object;
with Gtk.Text_Buffer; use Gtk.Text_Buffer;
@@ -48,6 +51,7 @@ with Gtkada.Handlers; use Gtkada.Han
with Gtk.Selection; use Gtk.Selection;
with Gtk.Arguments; use Gtk.Arguments;
with Gtkada.Handlers; use Gtkada.Handlers;
+with Gtkada.Terminal; use Gtkada.Terminal;
with Gtkada.MDI; use Gtkada.MDI;
with Pango.Font; use Pango.Font;
with Pango.Enums; use Pango.Enums;
@@ -280,7 +284,9 @@ package body Interactive_Consoles is
overriding procedure Insert_Prompt
(Console : access Interactive_Virtual_Console_Record; Txt : String) is
begin
- if not Get_Editable (Console.Console.View) then
+ if not Get_Editable (Console.Console.View)
+ or else Console.Console.Prompt = null
+ then
-- If the console does not support input, no need to display a
-- prompt.
return;
@@ -546,9 +552,12 @@ package body Interactive_Consoles is
procedure Clear_Input (Console : access Interactive_Console_Record) is
Prompt_Iter, Last_Iter : Gtk_Text_Iter;
begin
- Get_End_Iter (Console.Buffer, Last_Iter);
- Get_Iter_At_Mark (Console.Buffer, Prompt_Iter, Console.Prompt_Mark);
- Delete (Console.Buffer, Prompt_Iter, Last_Iter);
+ -- If the console is managing the prompt on its own
+ if Console.Prompt /= null then
+ Get_End_Iter (Console.Buffer, Last_Iter);
+ Get_Iter_At_Mark (Console.Buffer, Prompt_Iter, Console.Prompt_Mark);
+ Delete (Console.Buffer, Prompt_Iter, Last_Iter);
+ end if;
end Clear_Input;
------------------------
@@ -564,16 +573,27 @@ package body Interactive_Consoles is
Prompt_Iter : Gtk_Text_Iter;
begin
Internal := Console.Internal_Insert;
- Get_End_Iter (Console.Buffer, Last_Iter);
-- Read current user input (there might be none!). Then remove it from
-- the console temporarily, so that output is not intermixed with user
-- input. It will be put back after the output in Terminate_Output.
- if not Text_Is_Input and then Console.User_Input = null then
- Get_Iter_At_Mark (Console.Buffer, Prompt_Iter, Console.Prompt_Mark);
- Console.User_Input := new String'
- (Get_Slice (Console.Buffer, Prompt_Iter, Last_Iter));
- Delete (Console.Buffer, Prompt_Iter, Last_Iter);
+ -- However we do nothing when the console is not managing the prompt on
+ -- its own but letting the user do it.
+
+ if Console.Prompt /= null then
+ Get_End_Iter (Console.Buffer, Last_Iter);
+
+ if not Text_Is_Input and then Console.User_Input = null then
+ Get_Iter_At_Mark
+ (Console.Buffer, Prompt_Iter, Console.Prompt_Mark);
+ Console.User_Input := new String'
+ (Get_Slice (Console.Buffer, Prompt_Iter, Last_Iter));
+ Delete (Console.Buffer, Prompt_Iter, Last_Iter);
+ end if;
+
+ else
+ Get_Iter_At_Mark
+ (Console.Buffer, Last_Iter, Get_Insert (Console.Buffer));
end if;
end Prepare_For_Output;
@@ -589,31 +609,36 @@ package body Interactive_Consoles is
Last_Iter : Gtk_Text_Iter;
Prompt_Iter : Gtk_Text_Iter;
begin
- -- Protect the text we just output so that it is not editable by users
+ if Console.Prompt /= null then
+ -- Protect the text we just output so that it is not editable by
+ -- users
- Get_Iter_At_Mark (Console.Buffer, Prompt_Iter, Console.Prompt_Mark);
- Get_End_Iter (Console.Buffer, Last_Iter);
- Apply_Tag
- (Console.Buffer, Console.Uneditable_Tag, Prompt_Iter, Last_Iter);
- Apply_Tag
- (Console.Buffer,
- Console.External_Messages_Tag, Prompt_Iter, Last_Iter);
+ Get_Iter_At_Mark (Console.Buffer, Prompt_Iter, Console.Prompt_Mark);
+ Get_End_Iter (Console.Buffer, Last_Iter);
+ Apply_Tag
+ (Console.Buffer, Console.Uneditable_Tag, Prompt_Iter, Last_Iter);
+ Apply_Tag
+ (Console.Buffer,
+ Console.External_Messages_Tag, Prompt_Iter, Last_Iter);
- -- Move the prompt mark at the end of the output, so that user input is
- -- only read from that point on.
+ -- Move the prompt mark at the end of the output, so that user input
+ -- is only read from that point on.
- if Show_Prompt then
- Display_Prompt (Console);
- else
- Display_Text_As_Prompt (Console, "");
- end if;
+ if Show_Prompt then
+ Display_Prompt (Console);
+ else
+ Display_Text_As_Prompt (Console, "");
+ end if;
- -- Put back the partial input the user had started typing (was saved in
- -- Prepare_For_Ouptut).
+ -- Put back the partial input the user had started typing (was saved
+ -- in Prepare_For_Ouptut).
- Get_End_Iter (Console.Buffer, Last_Iter);
- Insert (Console.Buffer, Last_Iter, Console.User_Input.all);
- Free (Console.User_Input);
+ Get_End_Iter (Console.Buffer, Last_Iter);
+ Insert (Console.Buffer, Last_Iter, Console.User_Input.all);
+ Free (Console.User_Input);
+ else
+ Scroll_Mark_Onscreen (Console.View, Get_Insert (Console.Buffer));
+ end if;
Console.Message_Was_Displayed := True;
Console.Internal_Insert := Internal;
@@ -633,56 +658,10 @@ package body Interactive_Consoles is
Show_Prompt : Boolean := True;
Text_Is_Input : Boolean := False)
is
- Last_Iter, Prompt_Iter, Tmp_Iter : Gtk_Text_Iter;
- Internal : Boolean;
- Success : Boolean;
- Count : Natural := 0;
+ Last_Iter : Gtk_Text_Iter;
+ Internal : Boolean;
begin
- -- Special case: if the text starts with ^H characters, we delete that
- -- many characters from the input. If we are editing after the prompt,
- -- we delete up to the prompt character only (since the rest is not
- -- editable anyway there is nothing specific to do). The rest of the
- -- text is then added, but is marked as user input if we were in the
- -- middle of user input.
- -- In particular, this is useful when doing completion in a shell
- -- window, since the shell emits these characters while the user
- -- circulates through all possible completions
-
- if UTF8 /= "" and then UTF8 (UTF8'First) = ASCII.BS then
- for U in UTF8'Range loop
- if UTF8 (U) = ASCII.BS then
- Count := Count + 1;
- else
- exit;
- end if;
- end loop;
-
- Get_End_Iter (Console.Buffer, Last_Iter);
- Get_Iter_At_Mark (Console.Buffer, Prompt_Iter, Console.Prompt_Mark);
-
- if Get_Offset (Last_Iter) /= Get_Offset (Prompt_Iter) then
- -- in user edition
- Copy (Last_Iter, Dest => Tmp_Iter);
- Backward_Chars (Tmp_Iter, Gint (Count), Success);
- if Get_Offset (Tmp_Iter) < Get_Offset (Prompt_Iter) then
- Copy (Prompt_Iter, Dest => Tmp_Iter);
- end if;
-
- Delete (Console.Buffer, Tmp_Iter, Last_Iter);
-
- -- We could use Insert recursively with Text_Is_Input set to True
- Insert (Console.Buffer, Tmp_Iter,
- UTF8 (UTF8'First + Count .. UTF8'Last));
- return;
-
- else
- -- Do nothing, we'll display the BS as special characters in the
- -- console
- null;
- end if;
- end if;
-
Prepare_For_Output (Console, Text_Is_Input, Internal, Last_Iter);
if Add_LF then
@@ -844,11 +823,45 @@ package body Interactive_Consoles is
(Widget : access Gtk_Widget_Record'Class;
Params : Glib.Values.GValues)
is
+ Console : constant Interactive_Console := Interactive_Console (Widget);
Args : constant Gtk_Args := Gtk_Args (Params);
Data : constant Selection_Data := Selection_Data (To_C_Proxy (Args, 1));
+ Tmp : Boolean := False;
begin
if Get_Length (Data) > 0 then
- Insert_And_Execute (Widget, Strip_CR (Get_Data_As_String (Data)));
+ declare
+ Str : constant String := Strip_CR (Get_Data_As_String (Data));
+ Index : Natural;
+ Next : Natural;
+ begin
+ if Console.On_Key /= null then
+ -- We execute the callback for each input character. If at
+ -- least one of them returns True, we will not process Str
+ -- through the standard console mechanism.
+ -- The string is UTF8, since it comes from gtk+
+
+ Index := Str'First;
+ while Index <= Str'Last loop
+ Next := UTF8_Next_Char (Str, Index);
+
+ Tmp := Tmp
+ or Console.On_Key
+ (Console,
+ Modifier => 0,
+ Uni => UTF8_Get_Char (Str (Index .. Next - 1)),
+ User_Data => Console.Key_User_Data);
+
+ Index := Next;
+ end loop;
+ end if;
+
+ if Tmp then
+ Gtk.Handlers.Emit_Stop_By_Name
+ (Console.View, Signal_Selection_Received);
+ else
+ Insert_And_Execute (Console, Str);
+ end if;
+ end;
end if;
exception
@@ -1016,6 +1029,17 @@ package body Interactive_Consoles is
Success : Boolean;
begin
+ if Console.On_Key /= null then
+ if Console.On_Key (Console => Console,
+ Modifier => Get_State (Event),
+ Key => Key,
+ Uni => To_Unicode (Key),
+ User_Data => Console.Key_User_Data)
+ then
+ return True;
+ end if;
+ end if;
+
case Key is
when GDK_Up | GDK_Down =>
if Console.Input_Blocked or else Console.Waiting_For_Input then
@@ -1204,7 +1228,9 @@ package body Interactive_Consoles is
procedure Display_Prompt
(Console : access Interactive_Console_Record'Class) is
begin
- Display_Text_As_Prompt (Console, Console.Prompt.all);
+ if Console.Prompt /= null then
+ Display_Text_As_Prompt (Console, Console.Prompt.all);
+ end if;
end Display_Prompt;
----------------------------
@@ -1218,16 +1244,18 @@ package body Interactive_Consoles is
Cursor_Iter : Gtk_Text_Iter;
begin
- if Selection_Exists (Console.Buffer) then
- return False;
- end if;
+ if Console.Prompt /= null then
+ if Selection_Exists (Console.Buffer) then
+ return False;
+ end if;
- Get_Iter_At_Mark (Console.Buffer, Prompt_Iter, Console.Prompt_Mark);
- Get_Iter_At_Mark (Console.Buffer, Cursor_Iter, Console.Insert_Mark);
+ Get_Iter_At_Mark (Console.Buffer, Prompt_Iter, Console.Prompt_Mark);
+ Get_Iter_At_Mark (Console.Buffer, Cursor_Iter, Console.Insert_Mark);
- if Compare (Cursor_Iter, Prompt_Iter) < 0 then
- Place_Cursor (Console.Buffer, Prompt_Iter);
- Console.Insert_Mark := Get_Insert (Console.Buffer);
+ if Compare (Cursor_Iter, Prompt_Iter) < 0 then
+ Place_Cursor (Console.Buffer, Prompt_Iter);
+ Console.Insert_Mark := Get_Insert (Console.Buffer);
+ end if;
end if;
return False;
@@ -1373,12 +1401,14 @@ package body Interactive_Consoles is
Key : Histories.History_Key;
Highlight : Gdk_Color := Null_Color;
Wrap_Mode : Gtk.Enums.Gtk_Wrap_Mode := Gtk.Enums.Wrap_None;
- Empty_Equals_Repeat : Boolean := False) is
+ Empty_Equals_Repeat : Boolean := False;
+ ANSI_Support : Boolean := False;
+ Manage_Prompt : Boolean := True) is
begin
Console := new Interactive_Console_Record;
Initialize (Console, Prompt, Handler, User_Data, Font,
History_List, Key, Highlight, Wrap_Mode,
- Empty_Equals_Repeat);
+ Empty_Equals_Repeat, ANSI_Support, Manage_Prompt);
end Gtk_New;
----------------
@@ -1395,13 +1425,20 @@ package body Interactive_Consoles is
Key : Histories.History_Key;
Highlight : Gdk_Color := Null_Color;
Wrap_Mode : Gtk.Enums.Gtk_Wrap_Mode;
- Empty_Equals_Repeat : Boolean := False)
+ Empty_Equals_Repeat : Boolean := False;
+ ANSI_Support : Boolean := False;
+ Manage_Prompt : Boolean := True)
is
Iter : Gtk_Text_Iter;
+ Term : Gtkada_Terminal;
+-- Term_View : Gtkada_Terminal_View;
begin
-- Initialize the text buffer and the text view
- Console.Prompt := new String'(Prompt);
+ if Manage_Prompt then
+ Console.Prompt := new String'(Prompt);
+ end if;
+
Set_Command_Handler (Console, Handler, User_Data);
Console.Key := new String'(String (Key));
Console.History := History_List;
@@ -1413,7 +1450,16 @@ package body Interactive_Consoles is
H_Scrollbar_Policy => Policy_Automatic,
V_Scrollbar_Policy => Policy_Automatic);
- Gtk_New (Console.Buffer);
+ if ANSI_Support then
+ Gtk_New (Term, Prevent_Cursor_Motion_With_Mouse => True);
+-- Gtk_New (Term_View, Term);
+
+ Console.Buffer := Gtk_Text_Buffer (Term);
+-- Console.View := Gtk_Text_View (Term_View);
+ else
+ Gtk_New (Console.Buffer);
+ end if;
+
Gtk_New (Console.View, Console.Buffer);
Set_Wrap_Mode (Console.View, Wrap_Mode);
@@ -1558,6 +1604,19 @@ package body Interactive_Consoles is
Console.Completion_User_Data := User_Data;
end Set_Completion_Handler;
+ ---------------------
+ -- Set_Key_Handler --
+ ---------------------
+
+ procedure Set_Key_Handler
+ (Console : access Interactive_Console_Record'Class;
+ Handler : Key_Handler;
+ User_Data : System.Address := System.Null_Address) is
+ begin
+ Console.On_Key := Handler;
+ Console.Key_User_Data := User_Data;
+ end Set_Key_Handler;
+
---------------------------
-- Set_Interrupt_Handler --
---------------------------
@@ -1758,8 +1817,12 @@ package body Interactive_Consoles is
procedure Set_Prompt
(Console : access Interactive_Console_Record; Prompt : String) is
begin
- Free (Console.Prompt);
- Console.Prompt := new String'(Prompt);
+ -- If the console is not managing the prompt itself, this subprogram
+ -- should have no effect
+ if Console.Prompt /= null then
+ Free (Console.Prompt);
+ Console.Prompt := new String'(Prompt);
+ end if;
end Set_Prompt;
--------------
============================================================
--- common/src/interactive_consoles.ads ee31102d1c58ca7ad274253354c9cc3874875175
+++ widgets/src/interactive_consoles.ads f21e0e9f29743f2774b11ee73794fa1cbdafbf08
@@ -27,6 +27,7 @@ with Gdk.Color; use Gdk.Color;
with GNAT.Strings;
with Gdk.Color; use Gdk.Color;
+with Gdk.Types;
with Glib;
with Gtk.Enums;
with Gtk.Main;
@@ -95,13 +96,26 @@ package Interactive_Consoles is
Key : Histories.History_Key;
Highlight : Gdk_Color := Null_Color;
Wrap_Mode : Gtk.Enums.Gtk_Wrap_Mode := Gtk.Enums.Wrap_None;
- Empty_Equals_Repeat : Boolean := False);
+ Empty_Equals_Repeat : Boolean := False;
+ ANSI_Support : Boolean := False;
+ Manage_Prompt : Boolean := True);
-- Create a new console.
-- History_List and Key are used to handle the history of commands entered
-- by the user in the interactive window. No history is provided if
-- History_List is null
-- If Empty_Equals_Repeat is True, an empty command will execute the last
-- command.
+ -- If _manage_prompt_ is True, then GPS will do some higher level handling
+ -- of prompts: when some output is done by the process, GPS will
+ -- temporarily hide what the user was typing, insert the output, and append
+ -- what the user was typing. This is in general suitable but might interfer
+ -- with external programs that do their own screen management through ANSI
+ -- commands (like a Unix shell for instance). This is not the same as
+ -- having an empty Prompt! If _manage_prompt_ is set to False, the text
+ -- passed to Handler will be incorrect
+ -- If _ANSI_Support_ is True, the console will recognize, and either handle
+ -- or hide the escape sequences generates by application to move cursor,
+ -- change colors or text attributes,...
procedure Initialize
(Console : access Interactive_Console_Record'Class;
@@ -113,7 +127,9 @@ package Interactive_Consoles is
Key : Histories.History_Key;
Highlight : Gdk_Color := Null_Color;
Wrap_Mode : Gtk.Enums.Gtk_Wrap_Mode;
- Empty_Equals_Repeat : Boolean := False);
+ Empty_Equals_Repeat : Boolean := False;
+ ANSI_Support : Boolean := False;
+ Manage_Prompt : Boolean := True);
-- Internal initialization function
procedure Insert
@@ -135,7 +151,8 @@ package Interactive_Consoles is
-- Suspend the user insertion and insert Text as an information message.
-- If Add_To_History is True, the inserted text will be inserted in the
-- user command history.
- -- If Show_Prompt is true, then a prompt is printed after the text.
+ -- If Show_Prompt is true (and the console is setup to manage the prompt on
+ -- its own), then a prompt is printed after the text.
-- If Text_Is_Input is true, the text is added as if the user was typing it
-- in the console. This text will thus remaing editable later one. On the
-- other hand is Text_Is_Input is false, the text is marked as read ony,
@@ -200,6 +217,24 @@ package Interactive_Consoles is
-- console. A default interrupt handler is provided that asks the scripting
-- language to do the necessary work.
+ type Key_Handler is access
+ function
+ (Console : access Interactive_Console_Record'Class;
+ Modifier : Gdk.Types.Gdk_Modifier_Type;
+ Key : Gdk.Types.Gdk_Key_Type := 0;
+ Uni : Glib.Gunichar := 0;
+ User_Data : System.Address) return Boolean;
+ procedure Set_Key_Handler
+ (Console : access Interactive_Console_Record'Class;
+ Handler : Key_Handler;
+ User_Data : System.Address := System.Null_Address);
+ -- A handler to be called every time the user presses a key in the console.
+ -- If the handler returns True, GPS will do no further processing on the
+ -- key and simply ignore it. The default is to just return False, ie let
+ -- the console do its own high-level management of user input.
+ -- _Key_ might be unspecified in some cases (if for instance the key is
+ -- simulated after the user copied some text into the console.
+
function Interrupt
(Console : access Interactive_Console_Record'Class) return Boolean;
-- Handles a control-C in the console.
@@ -311,13 +346,18 @@ private
Interrupt : Interrupt_Handler;
Interrupt_User_Data : System.Address;
+ On_Key : Key_Handler;
+ Key_User_Data : System.Address;
+
User_Data : System.Address;
Buffer : Gtk.Text_Buffer.Gtk_Text_Buffer;
View : Gtk.Text_View.Gtk_Text_View;
Prompt : GNAT.Strings.String_Access;
- -- The prompt to be displayed
+ -- The prompt to be displayed. This is set to null if the console should
+ -- not manage the prompt on its own, but let the user insert it on its
+ -- own.
Prompt_Mark : Gtk.Text_Mark.Gtk_Text_Mark;
-- The position after which the user can insert text