The unified diff between revisions [cd6af1d0..] and [994737ec..] is displayed below. It can also be downloaded as a raw diff.
#
#
# add_file "distrib/gps-4.3-gnat-6.1.2.diff"
# content [52be2780c93a20ff978c32fc974a91906e14ff13]
#
# patch "INSTALL"
# from [dc85dd1a3ec9a1e58e7f76b87cfd0163461e4df2]
# to [a64ee29b0679758a7832084d2504c7feba3c5435]
#
# patch "browsers/src/browsers-canvas.adb"
# from [f0a35ec9e87e6f726c705c469d51d18d80993a4d]
# to [bd514e2355d2d43d2f1cf4fcdf16373f351f0e2f]
#
# patch "common/expect/expWinSlave.h"
# from [4f6ab2ee40f0bbe606c390378b360a03cd519b8a]
# to [dc3f7c06c273f8fdae643f64504e838dea888311]
#
# patch "common/expect/expWinSlaveDbg.c"
# from [cdfe242c295eeb28a48adac463b50f2a51cf6330]
# to [b18c6d24118ae04b7b1b782cb6bf8ccd681a2f6b]
#
# patch "common/expect/expWinSlaveDrv.c"
# from [8154f89fb947a84240273726cd8bfc281dd560bb]
# to [d66dbb7091ce343e77959cce6b02606569f171f0]
#
# patch "common/expect/expWinSlaveKey.c"
# from [b0092b57e4f632093e04558fdf23af74dfe48fcc]
# to [a74ec58da1454ef6b716961910f2a9745b1c0dde]
#
# patch "common/src/file_utils.adb"
# from [199cbc0e3c988fb89ad3845c21b57c7fb4da705c]
# to [3746361189efe166adecd6b11421e900dea50f3c]
#
# patch "common/src/file_utils.ads"
# from [54cf6f4d6ea7166cae2ff2b9209a808351ba2d48]
# to [c426c7839685109d484e20321ede20acd8d6decb]
#
# patch "common/src/g-exttre.adb"
# from [7c9801b656f56fb57637038f63cbd1d28489cfe7]
# to [0beb7300eae532fa0357ed32040789ea8df34b5c]
#
# patch "common/src/g-exttre.ads"
# from [8acac5f931ac257221bea779485b4e41c45da36d]
# to [5dd702d66de0d18210fa0d04c614d0e2723b8ba8]
#
# patch "common/src/machine_descriptors.ads"
# from [12c8c5415bf83a55489660a4258d4bbc87adf212]
# to [847a76253ac979b9218e3f32a970baa758240d02]
#
# patch "common/src/remote_descriptors.adb"
# from [69621d757d0ca95484c9009c7b0d382efb51ee54]
# to [ebb50c70eed94720bd5b46b122cd2394e63aaa49]
#
# patch "common/src/remote_descriptors.ads"
# from [1a2592dd41719a1d86e0625029c57e80bf0d2cc0]
# to [a8551c86fa53c897e1643c157a3f1744f9545898]
#
# patch "distrib/doinstall"
# from [61da58431cabe7c473fb43cf3368b354cd553670]
# to [c04ce84f7b4e62e23e84fd0d631086ca963296f8]
#
# patch "distrib/features"
# from [fed18c7ae439ae2f39933a0d060618822c36435d]
# to [18d8d9f471e2d061bb68c14ffc4d43191ff3cbc8]
#
# patch "docs/gps.texi"
# from [1554dec52b7bd9a3fbedd69d91f0f18bd00912e0]
# to [d89aaa2dfd4bc1dfa47a66e5547f15fdec04cfac]
#
# patch "gnatlib/docs/gnatcoll.texi"
# from [422b53945eaf614a48ad68e75da3c7087408ebf7]
# to [2c8ee60aebd4b30e5f942675ffd83bb524950ccc]
#
# patch "gnatlib/src/gnatcoll-filesystem.adb"
# from [a2ff624e99969931610a736eab1aeb0e7eb7d231]
# to [d1336e768edd9f09ddebf87fb55c30fb1dd15232]
#
# patch "gnatlib/src/gnatcoll-sql-exec.adb"
# from [1e38ff9bb5407d946d5522a86b6763d6a96b26ff]
# to [809b7bf1cafe686904c633be96a22f45fc4137fc]
#
# patch "gnatlib/src/gnatcoll-sql.adb"
# from [df15c50675965259357b549e26fdc9d051cc6c75]
# to [10992650a25cdb2f1f11357548f3edc46c2b855f]
#
# patch "gnatlib/src/gnatcoll-sql.ads"
# from [0ccbb7725e55e9ba254145c7fe321b6a1a093b9a]
# to [f8dd06a01326e04c5574fe5e0a1b81cf73d02b50]
#
# patch "gvd/gvd/debugger-gdb.adb"
# from [8615ab3009abb14c430452d28fd44088ab68907c]
# to [b5487e2a259107918a0234f6a6574105881f8bd4]
#
# patch "kernel/src/gps-kernel-console.adb"
# from [a39f76b97d81073600c1eee5a4294ac8962f4136]
# to [c4a29886aa3c596915fcb04ce0ced9ba8daeffae]
#
# patch "kernel/src/gps-kernel-preferences.adb"
# from [23b524646f7b750e48a949a4e5b25a4764581914]
# to [640920d5938c103671f30524223d3f492cda0179]
#
# patch "kernel/src/gps-kernel-preferences.ads"
# from [42cf8fb3c97e2ebf683b76a53366058b40d5cfc2]
# to [28412fa8585563f779510b07c3c92d2cb8ed0723]
#
# patch "kernel/src/gps-kernel-properties.adb"
# from [8e8b0df8c3ca6c196e4bd404a39820251ae85175]
# to [1632c37bf3d01c9899c713857da7ae9c5deb20b0]
#
# patch "kernel/src/gps-kernel-remote.adb"
# from [82ded91952d6d30b71040a8dd7b8c5984de20405]
# to [40c68743b35e6eb11befb57ff6c467e3d24ce07c]
#
# patch "kernel/src_info/projects-registry.adb"
# from [a30cd2e99f63aa8343a548d6f218c878d728099e]
# to [15f722ba9cc45bb8cb58029d77b6a6ee6ebfdbe2]
#
# patch "kernel/src_info/projects.ads"
# from [ed15a6e88aea46d9db70011dcb041af04e33fa90]
# to [d939aecf2c10cb79bfd0fc4e73b8b92307c670f5]
#
# patch "share/plug-ins/ada_support.py"
# from [953a55ac6190ef3e6350ebc197772b5f370cb284]
# to [db5771b0d300f3191c513239b269861d1e3922cf]
#
# patch "share/plug-ins/build_modes.xml"
# from [78024b088724be9a146448623cd8c5752f44e2cf]
# to [5025daccc717bc4c0a0220ced59315b7890e588d]
#
# patch "share/plug-ins/protocols.xml.in"
# from [a5a5e57958812110f4f04ce42708256b046731b5]
# to [cebe15c53fc86d20659d79cc848214faae8dfcf7]
#
# patch "share/plug-ins/spark.py"
# from [d0854ffbe3614c1bb14a0804b1f9c958855d95b5]
# to [a06ee926490affd0644750c9b8ab69b23518d502]
#
# patch "src_editor/src/src_editor_module.adb"
# from [13f07da5d4792a50511ee655bedcb6440aa916d8]
# to [1e2388f3e9a7aaebe16b2bd40213a37ee945432f]
#
# patch "vcs/src/vcs_activities_view_api.adb"
# from [15d5ed0407857fb79dc1d5f5a8d52a823d9ff4e8]
# to [5b64990046fc1c76ee393375dbf5f667f46da346]
#
# patch "widgets/src/gtkada-terminal.adb"
# from [ca97052bf0ca57d5f6bfea1657f4a61cca7236d8]
# to [9db9aa591fbdc926a02a790d0947ada07d612b6e]
#
============================================================
--- distrib/gps-4.3-gnat-6.1.2.diff 52be2780c93a20ff978c32fc974a91906e14ff13
+++ distrib/gps-4.3-gnat-6.1.2.diff 52be2780c93a20ff978c32fc974a91906e14ff13
@@ -0,0 +1,26 @@
+--- /dev/null 2008-12-01 09:36:42.828125000 +0100
++++ common/src/use_acl.c 2008-12-01 09:36:16.203125000 +0100
+@@ -0,0 +1,23 @@
++/*********************************************************************
++ * G P S *
++ * *
++ * Copyright (C) 2008, AdaCore *
++ * AdaCore *
++ * *
++ * GPS is free software; you can redistribute it and/or modify it *
++ * under the terms of the GNU General Public License as published by *
++ * the Free Software Foundation; either version 2 of the License, or *
++ * (at your option) any later version. *
++ * *
++ * This program is distributed in the hope that it will be useful, *
++ * but WITHOUT ANY WARRANTY; without even the implied warranty of *
++ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
++ * General Public License for more details. You should have received *
++ * a copy of the GNU General Public License along with this program; *
++ * if not, write to the Free Software Foundation, Inc., 59 Temple *
++ * Place - Suite 330, Boston, MA 02111-1307, USA. *
++ *********************************************************************/
++
++/* Dummy version of __gnat_use_acl */
++
++int __gnat_use_acl = 0;
============================================================
--- INSTALL dc85dd1a3ec9a1e58e7f76b87cfd0163461e4df2
+++ INSTALL a64ee29b0679758a7832084d2504c7feba3c5435
@@ -62,5 +62,5 @@ above, with a few additional steps:
- You need to use the SVN version of GtkAda matching GPS sources (same date/tag)
- Depending on your GNAT version, you may also need to apply
- distrib/gps-4.3-gpl-2008.diff
+ distrib/gps-4.3-gnat-6.1.2.diff
============================================================
--- browsers/src/browsers-canvas.adb f0a35ec9e87e6f726c705c469d51d18d80993a4d
+++ browsers/src/browsers-canvas.adb bd514e2355d2d43d2f1cf4fcdf16373f351f0e2f
@@ -169,6 +169,7 @@ package body Browsers.Canvas is
procedure Dump
(Me : Debug_Handle; Tree : Active_Area_Tree; Indent : Natural := 0);
+ pragma Warnings (Off, Dump);
-- For debugging purposes, dump the tree to Me
procedure Destroyed (Browser : access Gtk_Widget_Record'Class);
============================================================
--- common/expect/expWinSlave.h 4f6ab2ee40f0bbe606c390378b360a03cd519b8a
+++ common/expect/expWinSlave.h dc3f7c06c273f8fdae643f64504e838dea888311
@@ -4,7 +4,7 @@
* Useful definitions used by the slave driver but not useful
* for anybody else.
*
- * Copyright (c) 2006 AdaCore
+ * Copyright (c) 2006-2008 AdaCore
* Copyright (c) 1997 by Mitel, Inc.
* Copyright (c) 1997 by Gordon Chaffee (chaffee@home.com)
*
@@ -95,7 +95,6 @@ extern BOOL ExpReadMaster(HANDLE hFile
extern BOOL ExpReadMaster(HANDLE hFile,
void *buf, DWORD n, PDWORD pCount,
PDWORD pError);
-extern void ExpNewConsoleSequences(HANDLE hMaster);
extern void ExpProcessFreeByHandle(HANDLE hProcess);
extern void ExpSetConsoleSize(HANDLE hConsoleInW,
HANDLE hConsoleOut,
============================================================
--- common/expect/expWinSlaveDbg.c cdfe242c295eeb28a48adac463b50f2a51cf6330
+++ common/expect/expWinSlaveDbg.c b18c6d24118ae04b7b1b782cb6bf8ccd681a2f6b
@@ -70,6 +70,8 @@
#define EXP_FLAG_PI 0x80
#ifndef UNICODE
+SHORT curY = 0;
+SHORT curX = 0;
# define ExpCreateProcessInfo ExpCreateProcessInfoA
# define OnWriteConsoleOutput OnWriteConsoleOutputA
# define ReadSubprocessString ReadSubprocessStringA
@@ -281,6 +283,7 @@ ExpBreakInfo BreakArrayKernel32[] = {
OnWriteConsoleOutputCharacterA, EXP_BREAK_OUT},
{"WriteConsoleOutputCharacterW", 5,
OnWriteConsoleOutputCharacterW, EXP_BREAK_OUT|EXP_BREAK_IN},
+ {"SetConsoleCursorPosition", 5, OnSetConsoleCursorPosition, EXP_BREAK_OUT},
{NULL, 0, NULL}
};
@@ -616,7 +619,7 @@ ExpCommonDebugger()
}
/* Process the debugging event code. */
-
+ EXP_LOG ("Debug event %d",debEvent.dwDebugEventCode);
switch (debEvent.dwDebugEventCode) {
case EXCEPTION_DEBUG_EVENT:
/*
@@ -1795,17 +1798,32 @@ OnWriteConsoleA(ExpProcess *proc, ExpThr
} else {
p = buf;
}
+ EXP_LOG ("Reading %d byte(s)", n);
ptr = (PVOID) threadInfo->args[1];
ReadSubprocessMemory(proc, ptr, p, n * sizeof(CHAR));
+ for (i = 0; i < n; i++)
+ if (p[i] == '\n') {
+ curY++;
+ curX = 0;
+ } else {
+ curX++;
+ }
+
+#ifdef EXPLAUNCH_DEBUG
{ // DEBUG
p2 = malloc ((n + 1) * sizeof(CHAR));
memcpy (p2, p, n);
p2[n] = '\0';
- EXP_LOG ("Read from WriteConsoleA: '%s'", p2);
+ if (n == 1) {
+ EXP_LOG ("Read from WriteConsoleA: '0x%08x'", p[0]);
+ } else {
+ EXP_LOG ("Read from WriteConsoleA: '%s'", p2);
+ }
free (p2);
}
+#endif
bRet = ExpWriteMaster(HMaster, p, n);
@@ -1871,10 +1889,10 @@ OnWriteConsoleW(ExpProcess *proc, ExpThr
w = WideCharToMultiByte(CP_ACP, 0, p, n, a, asize, NULL, NULL);
bRet = ExpWriteMaster(HMaster, a, w);
- if (p != buf) {
- free(p);
- free(a);
- }
+ if (p != buf) {
+ free(p);
+ free(a);
+ }
}
/*
@@ -1897,73 +1915,24 @@ CreateVtSequence(ExpProcess *proc, COORD
void
CreateVtSequence(ExpProcess *proc, COORD newPos, DWORD n)
{
- COORD oldPos;
- CHAR buf[2048];
- DWORD count;
- BOOL b;
+ LOG_ENTRY ("CreateVtSequence (nothing to do)");
+ EXP_LOG ("newPos is x= %d, ", newPos.X);
+ EXP_LOG ("y= %d, ", newPos.Y);
- LOG_ENTRY ("CreateVtSequence");
+ if (curX > 0 && newPos.X == 0) {
+ EXP_LOG ("\\R !!!", NULL);
+ ExpWriteMaster(HMaster, "\r", 1);
+ }
-/* oldPos = CursorPosition; */
-
-/* EXP_LOG ("Old X: %d", oldPos.X); */
-/* EXP_LOG ("Old Y: %d", oldPos.Y); */
-/* EXP_LOG ("CursorKnown: %d", CursorKnown); */
-
-/* if (CursorKnown && (newPos.X == 0) && (oldPos.X != 0)) { */
-/* buf[0]='\n'; */
-/* count = 1; */
-/* } else { */
-/* count = 0; */
-/* } */
-
-/* newPos.X += (SHORT) (n % ConsoleSize.X); */
-/* newPos.Y += (SHORT) (n / ConsoleSize.X); */
-/* CursorPosition = newPos; */
-/* CursorKnown = TRUE; */
-
-/* EXP_LOG ("New X: %d", newPos.X); */
-/* EXP_LOG ("New Y: %d", newPos.Y); */
-
-/* if (count > 0) { */
-/* b = ExpWriteMaster(HMaster, buf, count); */
-/* } */
-/* LOG_EXIT ("CreateVtSequence"); */
+ if (newPos.X == 0) {
+ // set as 1, so that two consecutive calls will output \r
+ curX = 1;
+ }
}
/*
*----------------------------------------------------------------------
*
- * ExpNewConsoleSequences
- *
- * Sets up a new console. Sets the scrollable region of
- * the window, clears the screen, etc.
- *
- * Results:
- * None
- *
- *----------------------------------------------------------------------
- */
-void
-ExpNewConsoleSequences(HANDLE hMaster)
-{
- UCHAR buf[100];
- DWORD bufpos = 0;
-
- /* Clear to end of screen */
- wsprintfA(&buf[bufpos], "\033[%d;%dH\033[J", 1, 1);
- bufpos += strlen(&buf[bufpos]);
-
- /* Reset cursor */
- wsprintfA(&buf[bufpos], "\033[%d;%dH", CursorPosition.Y, CursorPosition.X);
- bufpos += strlen(&buf[bufpos]);
-
- ExpWriteMaster(hMaster, buf, bufpos);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* ExpSetConsoleSize --
*
* Sets the console to the appropriate size
@@ -1976,6 +1945,7 @@ ExpSetConsoleSize(HANDLE hConsoleInW, HA
void
ExpSetConsoleSize(HANDLE hConsoleInW, HANDLE hConsoleOut, int w, int h)
{
+ LOG_ENTRY ("ExpSetConsoleSize");
COORD largest;
SMALL_RECT winrect;
INPUT_RECORD resizeRecord;
@@ -2406,6 +2376,7 @@ OnGetStdHandle(ExpProcess *proc, ExpThre
{
DWORD i;
BOOL found;
+ LOG_ENTRY ("GetStdHandle");
if (*returnValue == (DWORD) INVALID_HANDLE_VALUE) {
return;
@@ -2492,7 +2463,7 @@ RefreshScreen()
BOOL b;
int x, y, prespaces, postspaces, offset;
- LOG_ENTRY("SetConsoleActiveScreenBuffer");
+ LOG_ENTRY("RefreshScreen");
/* Clear the screen */
wsprintfA(&buf[bufpos], "\033[2J");
============================================================
--- common/expect/expWinSlaveDrv.c 8154f89fb947a84240273726cd8bfc281dd560bb
+++ common/expect/expWinSlaveDrv.c d66dbb7091ce343e77959cce6b02606569f171f0
@@ -421,15 +421,16 @@ ExpProcessInput(HANDLE hMaster, HANDLE h
dwState = STATE_WRITE_DATA;
break;
case STATE_WRITE_DATA:
+#ifdef EXPLAUNCH_DEBUG
+ buffer[dwNeeded] = '\0';
EXP_LOG ("STATE_WRITE_DATA: '%s'", buffer);
+#endif
if (WriteBufferToSlave(FALSE, hConsoleInW, hConsoleOut,
buffer, dwNeeded) == FALSE)
{
EXP_LOG("Unable to write to slave: 0x%x", GetLastError());
}
- ExpReading = (char*) malloc (dwNeeded + 1);
- memcpy (ExpReading, buffer, dwNeeded);
- ExpReading [dwNeeded] = '\0';
+
EXP_LOG_FLUSH;
dwTotalNeeded -= dwNeeded;
if (dwTotalNeeded) {
@@ -523,84 +524,15 @@ ExpWriteMaster(HANDLE hFile, LPCVOID buf
BOOL
ExpWriteMaster(HANDLE hFile, LPCVOID buf, DWORD n)
{
- DWORD count, dwResult;
+ DWORD count;
BOOL bRet;
- WSABUF wsabuf[1];
- CHAR buf2[n+1];
- int start,start2;
- int ExpReadingStart;
- int i;
EXP_LOG_FLUSH;
- start = 0;
- start2 = 0;
EXP_LOG ("ExpWriteMaster Received %d bytes", n);
- if (ExpReading != NULL) {
- EXP_LOG ("Need to skip: '%s'", ExpReading);
- while ((start < n) &&
- (ExpReading[start] == ((char*)buf)[start]) &&
- (ExpReading[start]!='\0'))
- {
- start++;
- }
- start2 = start;
- EXP_LOG ("Nb characters = %d", n);
- if ((n == CONSOLE_WINDOW_WIDTH - 2) &&
- (start == 0) &&
- (((char*)buf)[0] == '<'))
- {
- // The Windows console might have scrolled horizontally... damned
- // In this case, the console does a complete refresh of the screen
- // which is 79 characters long - 1 for the cursor, and -1 for the one
- // that is inserted. It starts with a '<'
- // The newly received characters starts at position 51, and the
- // remaining is filled with spaces
- start2 = CONSOLE_WINDOW_WIDTH - 28;
- EXP_LOG ("51st character is %c\n", ((char*)buf)[start2]);
- // Check if first character is a space...
- if (ExpReading[start] == ' ') {
- // add this one, check for following ones
- start++;
- start2++;
- }
- while ((start2 < n) &&
- (ExpReading[start] == ((char*)buf)[start2]) &&
- (ExpReading[start]!='\0') &&
- (ExpReading[start]!=' '))
- {
- start++;
- start2++;
- }
- while ((start2 < n) && ((char*)buf)[start2] == ' ') {
- start2++;
- }
- }
- }
- EXP_LOG ("start2 is %d", start2);
- if (ExpReading != NULL) {
- if (start2 == n) {
- // Skip all incoming buffer
- char *tmp;
- tmp = malloc (strlen (ExpReading) - start + 1);
- memcpy (tmp, &ExpReading[start], strlen (ExpReading) - start + 1);
- free (ExpReading);
- ExpReading = tmp;
- } else {
- // We received something that has nothing to do with what we sent.
- // or all ExpReading mathed.
- free (ExpReading);
- ExpReading = NULL;
- }
- }
- EXP_LOG ("n-start2 is %d", n-start2);
- if (start2 < n) {
- memcpy (buf2, &((char*)buf)[start2], n-start2);
- buf2[n-start2]='\0';
-
- EXP_LOG ("ExpWriteMaster :'%s'", buf2);
+ if (n > 0) {
// End Debug
- bRet = WriteFile(hFile, buf2, n-start2, &count, NULL);
+ bRet = WriteFile(hFile, buf, n, &count, NULL);
if (!bRet) EXP_LOG ("Error writing to master %8x\n", GetLastError());
return bRet;
}
============================================================
--- common/expect/expWinSlaveKey.c b0092b57e4f632093e04558fdf23af74dfe48fcc
+++ common/expect/expWinSlaveKey.c a74ec58da1454ef6b716961910f2a9745b1c0dde
@@ -35,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 */ { 13, 28, 0},
+/* 10 */ { 74, 36, RIGHT_CTRL_PRESSED},
/* 11 */ { 75, 37, RIGHT_CTRL_PRESSED},
/* 12 */ { 76, 38, RIGHT_CTRL_PRESSED},
/* 13 */ { 13, 28, 0},
============================================================
--- common/src/file_utils.adb 199cbc0e3c988fb89ad3845c21b57c7fb4da705c
+++ common/src/file_utils.adb 3746361189efe166adecd6b11421e900dea50f3c
@@ -109,6 +109,45 @@ package body File_Utils is
return Result;
end Read_Files_From_Dirs;
+ --------------
+ -- Is_Empty --
+ --------------
+
+ function Is_Empty (Directory : String) return Boolean is
+ Dir : Dir_Type;
+ File : String (1 .. 1024);
+ File_Last : Natural;
+
+ begin
+ declare
+ Normalized_Dir : constant String := Name_As_Directory (Directory);
+ begin
+ if Normalized_Dir /= "" then
+ Open (Dir, Normalized_Dir);
+
+ loop
+ Read (Dir, File, File_Last);
+ exit when File_Last = 0;
+
+ if File (File'First .. File_Last) /= "."
+ and then File (File'First .. File_Last) /= ".."
+ then
+ Close (Dir);
+ return False;
+ end if;
+ end loop;
+
+ Close (Dir);
+ end if;
+
+ exception
+ when Directory_Error =>
+ null;
+ end;
+
+ return True;
+ end Is_Empty;
+
-----------------------
-- Is_Case_Sensitive --
-----------------------
============================================================
--- common/src/file_utils.ads 54cf6f4d6ea7166cae2ff2b9209a808351ba2d48
+++ common/src/file_utils.ads c426c7839685109d484e20321ede20acd8d6decb
@@ -34,6 +34,9 @@ package File_Utils is
-- Return all the files found in Dirs. Each directory in Dirs should be
-- separated with Path_Separator
+ function Is_Empty (Directory : String) return Boolean;
+ -- Return whether the directory is empty or not.
+
function Is_Case_Sensitive
(Server : Server_Type := GPS_Server) return Boolean;
-- Return true if filenames are case sensitive on the server
============================================================
--- common/src/g-exttre.adb 7c9801b656f56fb57637038f63cbd1d28489cfe7
+++ common/src/g-exttre.adb 0beb7300eae532fa0357ed32040789ea8df34b5c
@@ -268,7 +268,7 @@ package body GNAT.Expect.TTY.Remote is
end if;
end if;
- if Descriptor.Use_Cr_Lf and then Add_LF then
+ if Descriptor.Use_Cr_Lf = CRLF and then Add_LF then
Send (TTY_Descriptor, Str & ASCII.CR, Add_LF, Empty_Buffer);
else
Send (TTY_Descriptor, Str, Add_LF, Empty_Buffer);
@@ -293,17 +293,21 @@ package body GNAT.Expect.TTY.Remote is
New_Args : String_List_Access;
Old_Args : String_List_Access;
Regexp_Array : Compiled_Regexp_Array (1 .. 3);
+ Verify_Cr_Lf : Boolean := False;
+ First_Call : Boolean := True;
function Process_Arg_List (L : String_List) return String_List;
-- process the list of arguments, replacing tags with actual values
- procedure Wait_For_Prompt (Intermediate : Boolean := False);
+ procedure Wait_For_Prompt
+ (Intermediate : Boolean := False);
-- Wait for prompt on target
procedure My_Send
(Descriptor : in out Process_Descriptor'Class;
Dbg : Connection_Debugger;
Str : String;
+ Use_Cr_Lf : Boolean;
Add_LF : Boolean := True;
Empty_Buffer : Boolean := False;
Password_Mode : Boolean := False);
@@ -380,13 +384,36 @@ package body GNAT.Expect.TTY.Remote is
Remote_Desc.Extra_Prompt_Array (J).Ptrn;
end loop;
- Expect (Descriptor.Machine.Sessions (Session_Nb).Pd,
- Res,
- Regexp_Array & Extra_Regexp_Array,
- Matched,
- Descriptor.Machine.Desc.Timeout,
- False);
+ Expect
+ (Descriptor.Machine.Sessions (Session_Nb).Pd,
+ Res,
+ Regexp_Array & Extra_Regexp_Array,
+ Matched,
+ Descriptor.Machine.Desc.Timeout,
+ False);
+ if Descriptor.Use_Cr_Lf = Auto then
+ declare
+ Out_Str : constant String :=
+ Expect_Out
+ (Descriptor.Machine.Sessions (Session_Nb).Pd);
+ begin
+ if Out_Str'Length > 0
+ and then Index (Out_Str, "" & ASCII.LF) >= Out_Str'First
+ and then Index (Out_Str, "" & ASCII.CR) < Out_Str'First
+ then
+ Trace (Me, "Remote uses LF");
+ Descriptor.Use_Cr_Lf := LF;
+ else
+ Trace (Me, "Remote uses CR/LF");
+ Descriptor.Use_Cr_Lf := CRLF;
+ -- Indicate that we need to verify the accuracy of this
+ -- assumption
+ Verify_Cr_Lf := True;
+ end if;
+ end;
+ end if;
+
if Active (Me) then
Log
("RCV",
@@ -427,8 +454,76 @@ package body GNAT.Expect.TTY.Remote is
when 1 =>
-- Received shell prompt
- Trace (Me, "got prompt in Wait_For_Prompt");
+ Trace
+ (Me, "got prompt in Wait_For_Prompt");
+ -- We need to verify if the remote host really needs CR/LF
+ -- being sent:
+ -- in some cases this makes the remote machine receive
+ -- the equivalent of two LFs (thus two prompts) which
+ -- unsynchronizes the expect interface.
+
+ -- This happens whith telnet on AIX, where the AIX server
+ -- returns CR/LF, but expects LF as input
+
+ -- We verify this by looking for duplicated prompt after the
+ -- first command is sent (so upon the second call to
+ -- Wait_For_Prompt)
+ if Verify_Cr_Lf and then First_Call then
+ First_Call := False;
+ elsif Verify_Cr_Lf then
+ Verify_Cr_Lf := False;
+
+ if Descriptor.Use_Cr_Lf = CRLF then
+ declare
+ Str : constant String :=
+ Strip_CR
+ (Expect_Out
+ (Descriptor.Machine.Sessions
+ (Session_Nb).Pd));
+ Ref : Integer := -1;
+
+ begin
+ for J in reverse Str'Range loop
+ if Str (J) = ASCII.LF then
+ Ref := J + 1;
+ exit;
+ end if;
+ end loop;
+
+ if Ref in Str'Range then
+ declare
+ Ref_Prompt : constant String :=
+ Str (Ref .. Str'Last);
+ begin
+ for J in reverse Str'First .. Ref - 1 loop
+ if Str (J) = ASCII.LF
+ and then J >= Str'First + Ref_Prompt'Length
+ and then
+ Str (J - Ref_Prompt'Length .. J - 1) =
+ Ref_Prompt
+ and then
+ (J - Ref_Prompt'Length = Str'First
+ or else
+ Str
+ (J - Ref_Prompt'Length - 1) =
+ ASCII.LF)
+ then
+ -- Found a duplicated prompt
+ Trace
+ (Me,
+ "Deactivating CR/LF as this leads to" &
+ " duplicated prompts");
+ Descriptor.Use_Cr_Lf := LF;
+ exit;
+ end if;
+ end loop;
+ end;
+ end if;
+ end;
+ end if;
+ end if;
+
when 2 =>
Trace (Me, "got user name prompt in Wait_For_Prompt");
@@ -451,7 +546,8 @@ package body GNAT.Expect.TTY.Remote is
My_Send
(Descriptor.Machine.Sessions (Session_Nb).Pd,
Descriptor.Machine.Desc.Dbg,
- Descriptor.Machine.Desc.User_Name.all);
+ Descriptor.Machine.Desc.User_Name.all,
+ Descriptor.Use_Cr_Lf = CRLF);
Wait_For_Prompt (Intermediate);
when 3 | 4 =>
@@ -507,6 +603,7 @@ package body GNAT.Expect.TTY.Remote is
My_Send (Descriptor.Machine.Sessions (Session_Nb).Pd,
Descriptor.Machine.Desc.Dbg,
Password.all,
+ Descriptor.Use_Cr_Lf = CRLF,
Password_Mode => True);
Free (Password);
end;
@@ -525,14 +622,15 @@ package body GNAT.Expect.TTY.Remote is
raise Invalid_Process with
"Unexpected error when connecting to " &
- Descriptor.Machine.Desc.Nickname.all;
+ Descriptor.Machine.Desc.Nickname.all;
end if;
if Remote_Desc.Extra_Prompt_Array (Res_Extra).Auto_Answer then
My_Send
(Descriptor.Machine.Sessions (Session_Nb).Pd,
Descriptor.Machine.Desc.Dbg,
- Remote_Desc.Extra_Prompt_Array (Res_Extra).Answer.all);
+ Remote_Desc.Extra_Prompt_Array (Res_Extra).Answer.all,
+ Descriptor.Use_Cr_Lf = CRLF);
else
declare
Str : constant String := Query_User
@@ -544,7 +642,8 @@ package body GNAT.Expect.TTY.Remote is
My_Send
(Descriptor.Machine.Sessions (Session_Nb).Pd,
Descriptor.Machine.Desc.Dbg,
- Str);
+ Str,
+ Descriptor.Use_Cr_Lf = CRLF);
else
Close (Descriptor.Machine.Sessions (Session_Nb).Pd);
Descriptor.Machine.Sessions (Session_Nb).State := OFF;
@@ -566,6 +665,7 @@ package body GNAT.Expect.TTY.Remote is
(Descriptor : in out Process_Descriptor'Class;
Dbg : Connection_Debugger;
Str : String;
+ Use_Cr_Lf : Boolean;
Add_LF : Boolean := True;
Empty_Buffer : Boolean := False;
Password_Mode : Boolean := False) is
@@ -584,8 +684,8 @@ package body GNAT.Expect.TTY.Remote is
end if;
end if;
- if Remote_Desc.Use_Cr_Lf and then Add_LF then
- Send (Descriptor, Str & ASCII.CR, True, Empty_Buffer);
+ if Use_Cr_Lf and then Add_LF then
+ Send (Descriptor, Str & ASCII.CR & ASCII.LF, False, Empty_Buffer);
else
Send (Descriptor, Str, Add_LF, Empty_Buffer);
end if;
@@ -622,12 +722,10 @@ package body GNAT.Expect.TTY.Remote is
if Remote_Desc = null then
raise Invalid_Nickname with
"Invalid remote access tool name for " &
- Descriptor.Machine.Desc.Nickname.all &
- ": " & Descriptor.Machine.Desc.Access_Name.all;
+ Descriptor.Machine.Desc.Nickname.all &
+ ": " & Descriptor.Machine.Desc.Access_Name.all;
end if;
- Descriptor.Use_Cr_Lf := Remote_Desc.Use_Cr_Lf;
-
if Descriptor.Machine.Sessions (Session_Nb).State = OFF then
-- Launch a new session
@@ -766,47 +864,27 @@ package body GNAT.Expect.TTY.Remote is
-- Wait for connection confirmation
+ Descriptor.Use_Cr_Lf := Descriptor.Machine.Desc.Cr_Lf;
+ -- First call of Wait_For_Prompt will resolve the case where
+ -- Use_Cr_Lf is "Auto"
Wait_For_Prompt (True);
- -- Send just a LF to force Windows console to scroll, and thus
- -- correctly init the expect interface... strange...
- My_Send
- (Descriptor.Machine.Sessions (Session_Nb).Pd,
- Descriptor.Machine.Desc.Dbg,
- "");
- Wait_For_Prompt (True);
-
-- Determine if the machine echoes commands
if Descriptor.Shell.No_Echo_Cmd.all /= "" then
- if Active (Me) then
- Log ("SND", Descriptor.Shell.No_Echo_Cmd.all);
- end if;
-
- if Descriptor.Machine.Desc.Dbg /= null then
- Print
- (Descriptor.Machine.Desc.Dbg,
- Descriptor.Shell.No_Echo_Cmd.all,
- Input);
- end if;
-
My_Send
(Descriptor.Machine.Sessions (Session_Nb).Pd,
Descriptor.Machine.Desc.Dbg,
- Descriptor.Shell.No_Echo_Cmd.all);
+ Descriptor.Shell.No_Echo_Cmd.all,
+ Descriptor.Use_Cr_Lf = CRLF);
Wait_For_Prompt (True);
end if;
if Descriptor.Machine.Determine_Echoing then
- if Descriptor.Machine.Desc.Dbg /= null then
- Print (Descriptor.Machine.Desc.Dbg,
- Test_Echo_Cmd,
- Input);
- end if;
-
My_Send
(Descriptor.Machine.Sessions (Session_Nb).Pd,
Descriptor.Machine.Desc.Dbg,
- Test_Echo_Cmd);
+ Test_Echo_Cmd,
+ Descriptor.Use_Cr_Lf = CRLF);
Expect (Descriptor.Machine.Sessions (Session_Nb).Pd, Res,
Echoing_Regexps,
Descriptor.Machine.Desc.Timeout, False);
@@ -818,9 +896,21 @@ package body GNAT.Expect.TTY.Remote is
end if;
if Res = 1 then
+ if Descriptor.Machine.Desc.Dbg /= null then
+ Print (Descriptor.Machine.Desc.Dbg,
+ " ... <remote echoes commands> ...",
+ Output);
+ end if;
+
Log ("Init_Session", "remote echoes cmds");
Descriptor.Machine.Echoing := True;
elsif Res = 2 then
+ if Descriptor.Machine.Desc.Dbg /= null then
+ Print (Descriptor.Machine.Desc.Dbg,
+ " ... <remote does not echo commands> ...",
+ Output);
+ end if;
+
Log ("Init_Session", "remote does not echo commands");
Descriptor.Machine.Echoing := False;
else
@@ -838,17 +928,11 @@ package body GNAT.Expect.TTY.Remote is
for J in Descriptor.Shell.Init_Cmds'Range loop
Flush (Descriptor.Machine.Sessions (Session_Nb).Pd);
-
- if Descriptor.Machine.Desc.Dbg /= null then
- Print (Descriptor.Machine.Desc.Dbg,
- Descriptor.Shell.Init_Cmds (J).all,
- Input);
- end if;
-
My_Send
(Descriptor.Machine.Sessions (Session_Nb).Pd,
Descriptor.Machine.Desc.Dbg,
- Descriptor.Shell.Init_Cmds (J).all);
+ Descriptor.Shell.Init_Cmds (J).all,
+ Descriptor.Use_Cr_Lf = CRLF);
Wait_For_Prompt (False);
end loop;
@@ -856,21 +940,18 @@ package body GNAT.Expect.TTY.Remote is
for J in Descriptor.Machine.Desc.Extra_Init_Commands'Range loop
Flush (Descriptor.Machine.Sessions (Session_Nb).Pd);
- if Descriptor.Machine.Desc.Dbg /= null then
- Print (Descriptor.Machine.Desc.Dbg,
- Descriptor.Machine.Desc.Extra_Init_Commands (J).all,
- Input);
- end if;
-
My_Send
(Descriptor.Machine.Sessions (Session_Nb).Pd,
Descriptor.Machine.Desc.Dbg,
- Descriptor.Machine.Desc.Extra_Init_Commands (J).all);
+ Descriptor.Machine.Desc.Extra_Init_Commands (J).all,
+ Descriptor.Use_Cr_Lf = CRLF);
Wait_For_Prompt;
end loop;
end if;
Descriptor.Machine.Sessions (Session_Nb).State := READY;
+ Descriptor.Machine.Sessions (Session_Nb).Cr_Lf :=
+ Descriptor.Use_Cr_Lf;
if On_New_Connection /= null then
On_New_Connection (Descriptor.Machine.Desc.Nickname.all);
@@ -887,6 +968,9 @@ package body GNAT.Expect.TTY.Remote is
Descriptor.Machine.Sessions (Session_Nb).Pd.Pid;
Descriptor.Process :=
Descriptor.Machine.Sessions (Session_Nb).Pd.Process;
+ Descriptor.Use_Cr_Lf :=
+ Descriptor.Machine.Sessions (Session_Nb).Cr_Lf;
+
-- Set Terminated state as it is not started yet !
Descriptor.Terminated := True;
Descriptor.Busy := False;
@@ -1138,8 +1222,22 @@ package body GNAT.Expect.TTY.Remote is
-- is dynamically allocated (i.e. buffer_size is 0)
if Desc.Machine.Echoing and then not Desc.Current_Echo_Skipped then
+ -- PuTTY used in telnet mode with Windows server echoes all commands
+ -- with a trailing '\r' (no \n). We take this into account here.
+ -- Another case is Windows specific: in case the command line is
+ -- too long for the console, a \r is issued in the echo, followed
+ -- by '<' and a truncated version of the beginning of the echo.
+ -- In the last case, we'll wait for \n
for J in Str'Range loop
- if Str (J) = ASCII.LF then
+ if Str (J) = ASCII.LF
+ or else
+ (Str (J) = ASCII.CR
+ and then
+ (J = Str'Last
+ or else
+ (Str (J + 1) /= ASCII.LF
+ and then Str (J + 1) /= '<')))
+ then
Log ("Remove", Str (Str'First .. J));
Size := Str'Last - J;
Tmp_Buf := Desc.Buffer;
@@ -1238,7 +1336,7 @@ package body GNAT.Expect.TTY.Remote is
Matched : GNAT.Regpat.Match_Array (0 .. 1);
Res : Expect_Match;
NL_Regexp : constant Pattern_Matcher :=
- Compile ("^[^\n]*\n", Single_Line);
+ Compile ("^[^\n\r]*(\n|\r)", Single_Line);
begin
if Descriptor.Session_Nb = 0 then
@@ -1275,7 +1373,7 @@ package body GNAT.Expect.TTY.Remote is
if Descriptor.Shell.Get_Status_Cmd /= null then
-- Try to retrieve the terminated program's status
- if Descriptor.Use_Cr_Lf then
+ if Descriptor.Use_Cr_Lf = CRLF then
Send
(Desc, Descriptor.Shell.Get_Status_Cmd.all & ASCII.CR);
else
@@ -1323,7 +1421,6 @@ package body GNAT.Expect.TTY.Remote is
Expect_Out (Desc)
(Matched (1).First .. Matched (1).Last);
begin
- Trace (Me, "Status is '" & Out_Str & "'");
Status := Integer'Value (Out_Str);
if Active (Me) then
@@ -1511,7 +1608,7 @@ package body GNAT.Expect.TTY.Remote is
Echoing => False,
Determine_Echoing => True,
Next => null,
- Sessions => (others => (Pd, OFF)));
+ Sessions => (others => (Pd, Auto, OFF)));
Desc.Ref := Desc.Ref + 1;
Register_Machine_Descriptor (Desc, Descriptor);
============================================================
--- common/src/g-exttre.ads 8acac5f931ac257221bea779485b4e41c45da36d
+++ common/src/g-exttre.ads 5dd702d66de0d18210fa0d04c614d0e2723b8ba8
@@ -242,6 +242,7 @@ private
type Session is record
Pd : TTY_Process_Descriptor;
+ Cr_Lf : Cr_Lf_Handling;
State : Shell_State_Type := OFF;
end record;
-- This record represents a machine's session. A session is an opened
@@ -272,7 +273,7 @@ private
-- What shell is on the remote server
Machine : Remote_Machine_Descriptor_Access := null;
-- What machine this descriptor is connected to
- Use_Cr_Lf : Boolean := False;
+ Use_Cr_Lf : Cr_Lf_Handling := Auto;
-- Tell if CR shall be sent along with LF
Session_Nb : Natural := 0;
-- Session number on this machine
============================================================
--- common/src/machine_descriptors.ads 12c8c5415bf83a55489660a4258d4bbc87adf212
+++ common/src/machine_descriptors.ads 847a76253ac979b9218e3f32a970baa758240d02
@@ -27,6 +27,8 @@ package Machine_Descriptors is
package Machine_Descriptors is
+ type Cr_Lf_Handling is (CRLF, LF, Auto);
+
type Machine_Descriptor_Record is tagged record
Nickname : String_Access;
-- Identifier of the machine
@@ -44,6 +46,8 @@ package Machine_Descriptors is
-- Timeout value used when connecting to the machine (in ms)
Max_Nb_Connections : Natural := 3;
-- Maximum number of simultaneous connections on the machine
+ Cr_Lf : Cr_Lf_Handling := Auto;
+ -- Whether we should send LF, CR/LF or determine it automatically
Ref : Natural := 0;
-- Ref counter
Dbg : Connection_Debugger := null;
============================================================
--- common/src/remote_descriptors.adb 69621d757d0ca95484c9009c7b0d382efb51ee54
+++ common/src/remote_descriptors.adb ebb50c70eed94720bd5b46b122cd2394e63aaa49
@@ -31,8 +31,9 @@ package body Remote_Descriptors is
-- ??? Should get rid of this global variable
Login_Regexp : constant Pattern_Matcher :=
- Compile ("^[^\n]*([Ll]ogin|[Nn]ame)[^\n]*: *$",
- Multiple_Lines or Single_Line);
+ Compile
+ ("^[^\n]*([Ll]ogin|[Nn]ame|[Cc]onnexion)[^\n]*: *$",
+ Multiple_Lines or Single_Line);
-- Default regexp for login prompt
procedure Free (Descr : in out Remote_Descriptor_Access);
@@ -119,7 +120,6 @@ package body Remote_Descriptors is
Password_Prompt_Ptrn : String_Access;
Passphrase_Prompt_Ptrn : String_Access;
Extra_Prompt_Array : Extra_Prompts := Null_Extra_Prompts;
- Use_Cr_Lf : Boolean := False;
Use_Pipes : Boolean := False)
is
-- ??? Add max_password_prompt in parameters
@@ -146,7 +146,7 @@ package body Remote_Descriptors is
else
Login_Ptrn := new Pattern_Matcher'(Compile (
User_Prompt_Ptrn.all,
- Single_Line + Multiple_Lines));
+ Single_Line or Multiple_Lines));
end if;
if Password_Prompt_Ptrn = null then
@@ -154,7 +154,7 @@ package body Remote_Descriptors is
else
Password_Ptrn := new Pattern_Matcher'(Compile (
Password_Prompt_Ptrn.all,
- Single_Line + Multiple_Lines));
+ Single_Line or Multiple_Lines));
end if;
if Passphrase_Prompt_Ptrn = null then
@@ -163,7 +163,7 @@ package body Remote_Descriptors is
else
Passphrase_Ptrn := new Pattern_Matcher'(Compile (
Passphrase_Prompt_Ptrn.all,
- Single_Line + Multiple_Lines));
+ Single_Line or Multiple_Lines));
end if;
Remote.all :=
@@ -176,7 +176,6 @@ package body Remote_Descriptors is
Password_Prompt_Ptrn => Password_Ptrn,
Passphrase_Prompt_Ptrn => Passphrase_Ptrn,
Extra_Prompt_Array => new Extra_Prompts'(Extra_Prompt_Array),
- Use_Cr_Lf => Use_Cr_Lf,
Use_Pipes => Use_Pipes,
Max_Password_Prompt => 3,
Next => Remote_Descriptor_List);
============================================================
--- common/src/remote_descriptors.ads 1a2592dd41719a1d86e0625029c57e80bf0d2cc0
+++ common/src/remote_descriptors.ads a8551c86fa53c897e1643c157a3f1744f9545898
@@ -64,7 +64,6 @@ package Remote_Descriptors is
Password_Prompt_Ptrn : String_Access;
Passphrase_Prompt_Ptrn : String_Access;
Extra_Prompt_Array : Extra_Prompts := Null_Extra_Prompts;
- Use_Cr_Lf : Boolean := False;
Use_Pipes : Boolean := False);
-- Adds a new Remote Access Descriptor
-- Name : identifier of this descriptor
@@ -82,8 +81,6 @@ package Remote_Descriptors is
-- expression shall isolate the key_id with
-- parenthesis
-- Extra_Prompt_Array : extra specific prompts.
- -- Use_Cr_Lf : tell if CR character needs to be added when
- -- sending commands to the tool.
-- Use_Pipes : tell if the tool is launched in pipe or tty
-- mode. Only applicable on Windows (no effect
-- on other machines)
@@ -106,7 +103,6 @@ package Remote_Descriptors is
Password_Prompt_Ptrn : Pattern_Matcher_Access := null;
Passphrase_Prompt_Ptrn : Pattern_Matcher_Access := null;
Extra_Prompt_Array : Extra_Prompts_Access := null;
- Use_Cr_Lf : Boolean := False;
Use_Pipes : Boolean := False;
Max_Password_Prompt : Natural := 3;
Next : Remote_Descriptor_Access := null;
============================================================
--- distrib/doinstall 61da58431cabe7c473fb43cf3368b354cd553670
+++ distrib/doinstall c04ce84f7b4e62e23e84fd0d631086ca963296f8
@@ -117,24 +117,10 @@ install_binaries() {
(cd $current_dir; tar cf - bin etc lib share) | tar xf -
if [ -d lib/gps-xorg ]; then
- if [ -f lib/64 ]; then
- lib=lib64
- else
- lib=lib
- fi
-
if [ "`type Xorg 2>/dev/null | cut -d' ' -f3`" != "" ]; then
ln -s gps-xorg lib/gps
- if [ -f /usr/$lib/libexpat.so.1 ]; then
- ln -s /usr/$lib/libexpat.so.1 lib/gps/libexpat.so.0
- else
- ln -s /usr/$lib/libexpat.so lib/gps/libexpat.so.1
- fi
else
ln -s gps-xfree lib/gps
- if [ -f /usr/$lib/libexpat.so.1 ]; then
- ln -s /usr/$lib/libexpat.so.1 lib/gps/libexpat.so.0
- fi
fi
fi
============================================================
--- distrib/features fed18c7ae439ae2f39933a0d060618822c36435d
+++ distrib/features 18d8d9f471e2d061bb68c14ffc4d43191ff3cbc8
@@ -1,5 +1,5 @@
====================================================
-GPS 4.4 NEW FEATURES LIST Current as of Nov 24, 2008
+GPS 4.4 NEW FEATURES LIST Current as of Nov 27, 2008
====================================================
Copyright (c) 2007-2008, AdaCore
@@ -15,13 +15,6 @@ 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:
============================================================
--- docs/gps.texi 1554dec52b7bd9a3fbedd69d91f0f18bd00912e0
+++ docs/gps.texi d89aaa2dfd4bc1dfa47a66e5547f15fdec04cfac
@@ -29,8 +29,8 @@
@end flushright
@sp 2
@subtitle Version @value{GPSVersion}
-@subtitle Document revision level $Revision: 132507 $
-@subtitle Date: $Date: 2008-11-19 14:08:20 +0100 (Wed, 19 Nov 2008) $
+@subtitle Document revision level $Revision: 133042 $
+@subtitle Date: $Date: 2008-12-04 19:21:53 +0100 (Thu, 04 Dec 2008) $
@author AdaCore
@page
@@ -57,7 +57,7 @@ @top Using the GNAT Programming Studio
Version @value{GPSVersion}
-Date: $Date: 2008-11-19 14:08:20 +0100 (Wed, 19 Nov 2008) $
+Date: $Date: 2008-12-04 19:21:53 +0100 (Thu, 04 Dec 2008) $
Copyright @copyright{} 2001-2008, AdaCore
This document may be copied, in whole or in part, in any form or by any
@@ -8385,7 +8385,6 @@ @section Documentation Generation
@image{docgen}
@end ifhtml
-
@c For a description of the
@c documentation generator renderer @pxref{Defining a documentation format}.
@@ -8940,6 +8939,13 @@ @subsection Connection settings
compile, debug and execute at the same time on the machine, GPS will need
more that one connection to do this. The default value is 3.
@item
+(In Advanced configuration pane) The handling of line terminations. Depending
+on the kind of server you are connecting to and the remote access tool used,
+commands sent to the server need sometimes to end with the LF character, or
+CR/LF characters. GPS can most of the time detect automatically what is needed
+(the 'auto' mode), but this behavior can be forced to use CR/LF (cr/lf handling
+set to 'on') or LF (cr/lf handling set to 'off').
+@item
(In Advanced configuration pane) The Debug console allow you to easily
debug a remote connection. If checked, it will open a console
reporting all exchanges between GPS and the selected server.
@@ -9439,6 +9445,11 @@ @section The Preferences Dialog
@end table
+@item Use Windows ACL
+This is a Windows specific preference which is disabled by default. When
+enabled GPS will use the ACL to change the file's write permission. Note
+that ACL can't be used on network drives.
+
@item External editor
@cindex external editor
The default external editor to use.
@@ -13791,11 +13802,6 @@ @subsubsection Defining a remote connect
A regular expression, used to catch passphrase prompts from the
connection tool. If undefined, a default regular expression is used.
-@item use_cr_lf (optional)
-Boolean value, used to tell GPS if the connection tool requires CR+LF
-characters to determine an end of line, or if LF is sufficient. Set to
-false by default.
-
@item extra_ptrn (optional)
Complex child. Used to catch extra prompts from the connection tool,
other than password, passphrase or usename prompts. This tag has an
============================================================
--- gnatlib/docs/gnatcoll.texi 422b53945eaf614a48ad68e75da3c7087408ebf7
+++ gnatlib/docs/gnatcoll.texi 2c8ee60aebd4b30e5f942675ffd83bb524950ccc
@@ -135,7 +135,7 @@ @top @value{Title}
Version @value{Version}
-Copyright @copyright{} 2007, AdaCore
+Copyright @copyright{} 2007-2008, AdaCore
This document may be copied, in whole or in part, in any form or by any
means, as is or with alterations, provided that (1) alterations are clearly
@@ -2956,9 +2956,6 @@ @chapter Database interface
back-end is a matter of extending a tagged type and overriding the
appropriate subprograms.
-This interface is based on top of the GNADE package (available on
-Internet), although it hides that layer.
-
This interface was designed with several goals in mind: type-safety,
integrity with regards to changes to the database schema, ease of
writing queries and performance. A paper was published at the
============================================================
--- gnatlib/src/gnatcoll-filesystem.adb a2ff624e99969931610a736eab1aeb0e7eb7d231
+++ gnatlib/src/gnatcoll-filesystem.adb d1336e768edd9f09ddebf87fb55c30fb1dd15232
@@ -117,7 +117,14 @@ package body GNATCOLL.Filesystem is
Root : String;
Sub : String) return String is
begin
- return Ensure_Directory (Filesystem_Record'Class (FS), Root) & Sub;
+ -- If Root is empty, return Sub. Else, a double slash will be used,
+ -- which can be badly interpreted (on windows, this may furnish a
+ -- \\machine\service kind of path).
+ if Root = "" then
+ return Sub;
+ else
+ return Ensure_Directory (Filesystem_Record'Class (FS), Root) & Sub;
+ end if;
end Concat;
---------------------------
============================================================
--- gnatlib/src/gnatcoll-sql-exec.adb 1e38ff9bb5407d946d5522a86b6763d6a96b26ff
+++ gnatlib/src/gnatcoll-sql-exec.adb 809b7bf1cafe686904c633be96a22f45fc4137fc
@@ -313,6 +313,7 @@ package body GNATCOLL.SQL.Exec is
-- slave will return the newly inserted values ?
Connection.Success := Is_Success (R.all);
if not Connection.Success then
+ Set_Failure (Connection);
Trace
(Me_Query,
Query & " (" & Status (R.all) & " " & Error_Msg (R.all)
============================================================
--- gnatlib/src/gnatcoll-sql.adb df15c50675965259357b549e26fdc9d051cc6c75
+++ gnatlib/src/gnatcoll-sql.adb 10992650a25cdb2f1f11357548f3edc46c2b855f
@@ -1269,6 +1269,22 @@ package body GNATCOLL.SQL is
return F;
end Lower;
+ --------------------
+ -- Cast_To_String --
+ --------------------
+
+ function Cast_To_String
+ (Field : SQL_Field'Class) return SQL_Field_Text'Class
+ is
+ F : SQL_Field_Text_Build
+ (Table => null, Instance => null, Name => null);
+ D : constant Named_Field_Internal_Access := new Named_Field_Internal;
+ begin
+ D.Value := new String'("CAST (" & Field.Name.all & " AS TEXT)");
+ F.Data.Data := SQL_Field_Internal_Access (D);
+ return F;
+ end Cast_To_String;
+
---------------
-- To_String --
---------------
@@ -2109,6 +2125,16 @@ package body GNATCOLL.SQL is
return Result;
end Is_Not_Null;
+ ---------
+ -- Any --
+ ---------
+
+ function Any
+ (Self : SQL_Field_Text; Str : SQL_Field_Text) return SQL_Criteria is
+ begin
+ return Compare (Self, Str, Criteria_Any);
+ end Any;
+
-----------
-- Ilike --
-----------
@@ -2230,6 +2256,8 @@ package body GNATCOLL.SQL is
when Criteria_Less_Or_Equal => Append (Result, "<=");
when Criteria_Greater_Than => Append (Result, ">");
when Criteria_Greater_Or_Equal => Append (Result, ">=");
+ when Criteria_Any =>
+ Append (Result, " = ANY (");
when Criteria_Like => Append (Result, " LIKE ");
when Criteria_Ilike => Append (Result, " ILIKE ");
when Criteria_Not_Like => Append (Result, " NOT LIKE ");
@@ -2240,6 +2268,13 @@ package body GNATCOLL.SQL is
Append (Result,
To_String
(Self.Criteria.Data.Arg2.Data.Field.all, Long));
+
+ case Self.Criteria.Data.Op is
+ when Criteria_Any =>
+ Append (Result, ")");
+ when others =>
+ null;
+ end case;
end if;
when Criteria_Criteria =>
============================================================
--- gnatlib/src/gnatcoll-sql.ads 0ccbb7725e55e9ba254145c7fe321b6a1a093b9a
+++ gnatlib/src/gnatcoll-sql.ads f8dd06a01326e04c5574fe5e0a1b81cf73d02b50
@@ -319,6 +319,10 @@ package GNATCOLL.SQL is
return SQL_Field_Time'Class;
-- Return the different between two dates
+ function Cast_To_String
+ (Field : SQL_Field'Class) return SQL_Field_Text'Class;
+ -- Convert any field type to a text field
+
type Aggregate_Function is new String;
Func_Count : constant Aggregate_Function := "count";
Func_Distinct : constant Aggregate_Function := "distinct";
@@ -567,6 +571,10 @@ package GNATCOLL.SQL is
(Self : SQL_Field'Class; Subquery : SQL_Query) return SQL_Criteria;
-- Whether Self is equal to any of the values in List
+ function Any
+ (Self : SQL_Field_Text; Str : SQL_Field_Text) return SQL_Criteria;
+ -- "Self = ANY (Str)"
+
function Ilike
(Self : SQL_Field_Text; Str : String) return SQL_Criteria;
function Ilike
@@ -1130,6 +1138,7 @@ private
Criteria_Or,
Criteria_Like,
Criteria_Ilike,
+ Criteria_Any,
Criteria_Not_Like,
Criteria_Not_Ilike,
Criteria_Overlaps,
============================================================
--- gvd/gvd/debugger-gdb.adb 8615ab3009abb14c430452d28fd44088ab68907c
+++ gvd/gvd/debugger-gdb.adb b5487e2a259107918a0234f6a6574105881f8bd4
@@ -171,7 +171,7 @@ package body Debugger.Gdb is
-- How to get the range of addresses for a given line
GNAT_Binder_File_Pattern : constant Pattern_Matcher := Compile
- ("(b~.+\.adb)|(b_.+\.c)");
+ ("(b(~|_).+\.(adb|c))");
No_Definition_Of : constant String := "No definition of";
-- String used to detect undefined commands
@@ -1230,10 +1230,16 @@ package body Debugger.Gdb is
-- the corresponding main file.
if Matched (0) /= No_Match then
+ First := Matched (0).First + 2;
+
+ if Str (First) = '_' then
+ First := First + 1;
+ end if;
+
Send
(Debugger,
"info line " &
- Str (Matched (0).First + 2 .. Matched (0).Last) & ":1",
+ Str (First .. Matched (0).Last) & ":1",
Mode => Internal);
return;
end if;
============================================================
--- kernel/src/gps-kernel-console.adb a39f76b97d81073600c1eee5a4294ac8962f4136
+++ kernel/src/gps-kernel-console.adb c4a29886aa3c596915fcb04ce0ced9ba8daeffae
@@ -430,7 +430,7 @@ package body GPS.Kernel.Console is
NChild : GPS_MDI_Child;
Create : Boolean;
begin
- if Title /= "" then
+ if Title /= "" and then Title /= "Messages" then
Create := Force_Create;
if not Create then
Child := Find_MDI_Child_By_Name (Get_MDI (Kernel), Title);
@@ -484,6 +484,7 @@ package body GPS.Kernel.Console is
elsif Child /= null then
Highlight_Child (Child);
Console := Interactive_Console (Get_Widget (Child));
+ Enable_Prompt_Display (Console, Accept_Input);
end if;
return Console;
============================================================
--- kernel/src/gps-kernel-preferences.adb 23b524646f7b750e48a949a4e5b25a4764581914
+++ kernel/src/gps-kernel-preferences.adb 640920d5938c103671f30524223d3f492cda0179
@@ -608,51 +608,63 @@ package body GPS.Kernel.Preferences is
Default => Automatic,
Page => -"Editor");
+ if Config.Host = Config.Windows then
+ Use_ACL := Create
+ (Manager => Kernel.Preferences,
+ Name => "Src-Editor-Use-ACL",
+ Label => -"Use Windows ACL",
+ Doc =>
+ -"Whether GPS should use ACL when changing the "
+ & "read/write permissions",
+ Default => False,
+ Page => -"Editor");
+ end if;
+
Default_Style := Create
- (Manager => Kernel.Preferences,
- Name => "Src-Editor-Default-Style",
- Label => -"Default",
- Doc => -"Default style used in the source editors",
+ (Manager => Kernel.Preferences,
+ Name => "Src-Editor-Default-Style",
+ Label => -"Default",
+ Doc => -"Default style used in the source editors",
Default_Font => "Courier 10",
Default_Fg => "black",
Default_Bg => "white",
Page => -"Editor/Fonts & Colors");
Keywords_Style := Create
- (Manager => Kernel.Preferences,
- Name => "Src-Editor-Keywords-Style",
- Label => -"Keywords",
- Doc => -"Style to use when displaying keywords",
+ (Manager => Kernel.Preferences,
+ Name => "Src-Editor-Keywords-Style",
+ Label => -"Keywords",
+ Doc => -"Style to use when displaying keywords",
Default_Font => "Courier Bold 10",
Default_Fg => "black",
Default_Bg => "white",
Page => -"Editor/Fonts & Colors");
Comments_Style := Create
- (Manager => Kernel.Preferences,
- Name => "Src-Editor-Comments-Style",
- Label => -"Comments",
- Doc => -"Style to use when displaying comments",
+ (Manager => Kernel.Preferences,
+ Name => "Src-Editor-Comments-Style",
+ Label => -"Comments",
+ Doc => -"Style to use when displaying comments",
Default_Font => "Courier Medium Oblique 10",
Default_Fg => "blue",
Default_Bg => "white",
Page => -"Editor/Fonts & Colors");
Annotated_Comments_Style := Create
- (Manager => Kernel.Preferences,
- Name => "Src-Editor-Annotated-Comments-Style",
- Label => -"Annotated Comments",
- Doc => -"Style to use when displaying annotated comments",
+ (Manager => Kernel.Preferences,
+ Name => "Src-Editor-Annotated-Comments-Style",
+ Label => -"Annotated Comments",
+ Doc => -"Style to use when displaying annotated comments",
Default_Font => "Courier Medium Oblique 10",
Default_Fg => "#21A9DE",
Default_Bg => "white",
Page => -"Editor/Fonts & Colors");
Strings_Style := Create
- (Manager => Kernel.Preferences,
- Name => "Src-Editor-Strings-Style",
- Label => -"Strings",
- Doc => -"Style to use when displaying strings",
+ (Manager => Kernel.Preferences,
+ Name => "Src-Editor-Strings-Style",
+ Label => -"Strings",
+ Doc => -"Style to use when displaying strings",
Default_Font => "Courier 10",
Default_Fg => "brown",
Default_Bg => "white",
@@ -806,10 +818,10 @@ package body GPS.Kernel.Preferences is
Diff_Cmd := Create
(Manager => Kernel.Preferences,
- Name => "Diff-Utils-Diff",
- Label => -"Diff command",
- Doc => -("Command used to compute differences between two files."
- & " Arguments can also be specified"),
+ Name => "Diff-Utils-Diff",
+ Label => -"Diff command",
+ Doc => -("Command used to compute differences between two files."
+ & " Arguments can also be specified"),
Default => Config.Default_Diff_Cmd,
Page => -"Visual diff");
@@ -877,13 +889,13 @@ package body GPS.Kernel.Preferences is
File_Pattern := Create
(Manager => Kernel.Preferences,
- Name => "Messages-File-Regpat",
- Label => -"File pattern",
- Doc =>
- -"Pattern used to detect file locations (e.g error messages)",
+ Name => "Messages-File-Regpat",
+ Label => -"File pattern",
+ Doc =>
+ -"Pattern used to detect file locations (e.g error messages)",
Default =>
"^([^:]:?[^:]*):(\d+):((\d+):)? ((warning)?(\(style)?.*)",
- Page => -"Messages");
+ Page => -"Messages");
File_Pattern_Index := Create
(Manager => Kernel.Preferences,
@@ -947,10 +959,10 @@ package body GPS.Kernel.Preferences is
Secondary_File_Pattern := Create
(Manager => Kernel.Preferences,
- Name => "Messages-Secondary-File-Regpat",
- Label => -"Secondary File pattern",
- Doc =>
- -"Pattern used to detect secondary file locations in messages",
+ Name => "Messages-Secondary-File-Regpat",
+ Label => -"Secondary File pattern",
+ Doc =>
+ -"Pattern used to detect secondary file locations in messages",
Default => "([^: ]+):(\d+)(:(\d+):)?",
Page => -"Messages");
@@ -1145,9 +1157,9 @@ package body GPS.Kernel.Preferences is
Html_Browser := Create
(Manager => Kernel.Preferences,
- Name => "Helpers-HTML-Browser",
- Label => -"HTML browser",
- Doc =>
+ Name => "Helpers-HTML-Browser",
+ Label => -"HTML browser",
+ Doc =>
-("Program used to browse HTML pages. " &
"No value means automatically try to find a suitable browser."
& ASCII.LF
@@ -1166,8 +1178,8 @@ package body GPS.Kernel.Preferences is
Print_Command := Create
(Manager => Kernel.Preferences,
Name => "Helpers-Print-Command",
- Label => -"Print command",
- Doc => -("Program used to print files. No value means use " &
+ Label => -"Print command",
+ Doc => -("Program used to print files. No value means use " &
"the built-in printing capability (available under " &
"Windows only)"),
Default => Config.Default_Print_Cmd,
============================================================
--- kernel/src/gps-kernel-preferences.ads 42cf8fb3c97e2ebf683b76a53366058b40d5cfc2
+++ kernel/src/gps-kernel-preferences.ads 28412fa8585563f779510b07c3c92d2cb8ed0723
@@ -181,6 +181,7 @@ package GPS.Kernel.Preferences is
Tab_Width : Integer_Preference;
Highlight_Column : Integer_Preference;
Speed_Column_Policy : Speed_Column_Policy_Prefs.Preference;
+ Use_ACL : Boolean_Preference;
Submenu_For_Dispatching_Calls : Dispatching_Menu_Policy_Prefs.Preference;
-- Of type Dispatching_Menu_Policy
============================================================
--- kernel/src/gps-kernel-properties.adb 8e8b0df8c3ca6c196e4bd404a39820251ae85175
+++ kernel/src/gps-kernel-properties.adb 1632c37bf3d01c9899c713857da7ae9c5deb20b0
@@ -17,6 +17,8 @@
-- Place - Suite 330, Boston, MA 02111-1307, USA. --
-----------------------------------------------------------------------
+with Ada.Characters.Handling;
+with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Unchecked_Deallocation;
with File_Utils; use File_Utils;
@@ -30,7 +32,7 @@ with Traces; use Tra
with Remote; use Remote;
with String_Hash;
with Traces; use Traces;
-with GNATCOLL.VFS; use GNATCOLL.VFS;
+with GNATCOLL.VFS; use GNATCOLL.VFS;
package body GPS.Kernel.Properties is
@@ -61,17 +63,17 @@ package body GPS.Kernel.Properties is
type Properties_Description_HTable is
access all Properties_Description_Hash.String_Hash_Table.HTable;
+ -- ??? Do we really need this extra level of indirection?
- procedure Free (Hash : in out Properties_Description_HTable);
+ function Property_Key_Less_Than (Left, Right : String) return Boolean;
- package Properties_Hash is new String_Hash
- (Data_Type => Properties_Description_HTable,
- Free_Data => Free,
- Null_Ptr => null,
- Case_Sensitive => Is_Case_Sensitive (Build_Server));
- use Properties_Hash.String_Hash_Table;
+ package Properties_Hash is new Ada.Containers.Indefinite_Ordered_Maps
+ (Key_Type => String,
+ Element_Type => Properties_Description_HTable,
+ "<" => Property_Key_Less_Than);
+ use Properties_Hash;
- All_Properties : Properties_Hash.String_Hash_Table.HTable;
+ All_Properties : Properties_Hash.Map;
-- Global variable storing all the current properties for the current
-- project.
-- ??? It would be nicer to store this in the kernel but:
@@ -123,6 +125,20 @@ package body GPS.Kernel.Properties is
(Data : in out Callback_Data'Class; Command : String);
-- Handles script commands for properties
+ ----------------------------
+ -- Property_Key_Less_Than --
+ ----------------------------
+
+ function Property_Key_Less_Than (Left, Right : String) return Boolean is
+ begin
+ if Is_Case_Sensitive (Build_Server) then
+ return Left < Right;
+ else
+ return Ada.Characters.Handling.To_Lower (Left)
+ < Ada.Characters.Handling.To_Lower (Right);
+ end if;
+ end Property_Key_Less_Than;
+
----------
-- Free --
----------
@@ -137,25 +153,12 @@ package body GPS.Kernel.Properties is
Destroy (Description.Value.all);
Unchecked_Free (Description.Value);
end if;
+
if Description.Unparsed /= null then
Free (Description.Unparsed);
end if;
- Unchecked_Free (Description);
- end Free;
- ----------
- -- Free --
- ----------
-
- procedure Free (Hash : in out Properties_Description_HTable) is
- procedure Unchecked_Free is new Ada.Unchecked_Deallocation
- (Properties_Description_Hash.String_Hash_Table.HTable,
- Properties_Description_HTable);
- begin
- if Hash /= null then
- Reset (Hash.all);
- Unchecked_Free (Hash);
- end if;
+ Unchecked_Free (Description);
end Free;
-------------
@@ -268,12 +271,16 @@ package body GPS.Kernel.Properties is
-- Not used yet, the idea is to have various attributes in the XML file
-- depending on the resource type
- Hash : Properties_Description_HTable;
+ Hash : Properties_Description_HTable;
+ Cursor : Properties_Hash.Cursor;
begin
- Hash := Get (All_Properties, Resource_Key);
- if Hash = null then
+ Cursor := All_Properties.Find (Resource_Key);
+
+ if Has_Element (Cursor) then
+ Hash := Element (Cursor);
+ else
Hash := new Properties_Description_Hash.String_Hash_Table.HTable;
- Set (All_Properties, Resource_Key, Hash);
+ All_Properties.Include (Resource_Key, Hash);
end if;
Set (Hash.all, Name, new Property_Description'(Property));
@@ -295,13 +302,19 @@ package body GPS.Kernel.Properties is
Found : out Boolean)
is
pragma Unreferenced (Resource_Kind);
- Hash : Properties_Description_HTable;
- Descr : Property_Description_Access;
+
+ Hash : Properties_Description_HTable;
+ Descr : Property_Description_Access;
+ Cursor : Properties_Hash.Cursor;
begin
Found := False;
- Hash := Get (All_Properties, Resource_Key);
- if Hash /= null then
+
+ Cursor := All_Properties.Find (Resource_Key);
+
+ if Has_Element (Cursor) then
+ Hash := Element (Cursor);
Descr := Get (Hash.all, Name);
+
if Descr /= null then
if Descr.Value = null then
Load (Property, Descr.Unparsed);
@@ -330,10 +343,14 @@ package body GPS.Kernel.Properties is
Name : String)
is
pragma Unreferenced (Resource_Kind);
- Hash : Properties_Description_HTable;
+
+ Hash : Properties_Description_HTable;
+ Cursor : Properties_Hash.Cursor;
begin
- Hash := Get (All_Properties, Resource_Key);
- if Hash /= null then
+ Cursor := All_Properties.Find (Resource_Key);
+
+ if Has_Element (Cursor) then
+ Hash := Element (Cursor);
Remove (Hash.all, Name);
Save_Persistent_Properties (Kernel);
end if;
@@ -370,8 +387,7 @@ package body GPS.Kernel.Properties is
Name : String;
Found : out Boolean) is
begin
- Get_Resource_Property (Property, Index_Value, Index_Name,
- Name, Found);
+ Get_Resource_Property (Property, Index_Value, Index_Name, Name, Found);
end Get_Property;
---------------------
@@ -401,6 +417,7 @@ package body GPS.Kernel.Properties is
Filename : String := Full_Name (File, True).all;
begin
Canonical_Case_File_Name (Filename);
+
return Filename;
end To_String;
@@ -439,8 +456,8 @@ package body GPS.Kernel.Properties is
Property : access Property_Record'Class;
Persistent : Boolean := False) is
begin
- Set_Property (Kernel, "project", To_String (Project), Name,
- Property, Persistent);
+ Set_Property
+ (Kernel, "project", To_String (Project), Name, Property, Persistent);
end Set_Property;
------------------
@@ -515,7 +532,7 @@ package body GPS.Kernel.Properties is
(Kernel : access Kernel_Handle_Record'Class)
is
Filename : constant String := Get_Properties_Filename (Kernel);
- Iter : Properties_Hash.String_Hash_Table.Iterator;
+ Cursor : Properties_Hash.Cursor;
Iter2 : Properties_Description_Hash.String_Hash_Table.Iterator;
Hash : Properties_Description_HTable;
Root, File, Prop, Src, Dst : Node_Ptr;
@@ -534,14 +551,14 @@ package body GPS.Kernel.Properties is
Next => null,
Specific_Data => 1);
- Get_First (All_Properties, Iter);
- loop
- Hash := Get_Element (Iter);
- exit when Hash = null;
+ Cursor := All_Properties.First;
+ while Has_Element (Cursor) loop
+ Hash := Element (Cursor);
+
File := new Node'
(Tag => new String'("properties"),
- Attributes => new String'("file='" & Get_Key (Iter) & "'"),
+ Attributes => new String'("file='" & Key (Cursor) & "'"),
Value => null,
Parent => null,
Child => null,
@@ -614,7 +631,7 @@ package body GPS.Kernel.Properties is
Free (File);
end if;
- Get_Next (All_Properties, Iter);
+ Next (Cursor);
end loop;
Print (Root, Filename, Success);
@@ -633,8 +650,24 @@ package body GPS.Kernel.Properties is
(Kernel : access Kernel_Handle_Record'Class)
is
pragma Unreferenced (Kernel);
+
+ Cursor : Properties_Hash.Cursor;
+ Hash : Properties_Description_HTable;
+
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Properties_Description_Hash.String_Hash_Table.HTable,
+ Properties_Description_HTable);
begin
- Reset (All_Properties);
+ Cursor := First (All_Properties);
+
+ while Has_Element (Cursor) loop
+ Hash := Element (Cursor);
+ Reset (Hash.all);
+ Unchecked_Free (Hash);
+ Next (Cursor);
+ end loop;
+
+ All_Properties.Clear;
end Reset_Properties;
-----------------------------------
@@ -744,10 +777,13 @@ package body GPS.Kernel.Properties is
File => File,
Name => Nth_Arg (Data, 2),
Found => Found);
+
if not Found then
Set_Error_Msg (Data, -"Property not found");
+
elsif Prop2.Value = null then
Set_Return_Value (Data, "");
+
else
Set_Return_Value (Data, Prop2.Value.all);
end if;
@@ -796,10 +832,13 @@ package body GPS.Kernel.Properties is
Project => Project,
Name => Nth_Arg (Data, 2),
Found => Found);
+
if not Found then
Set_Error_Msg (Data, -"Property not found");
+
elsif Prop2.Value = null then
Set_Return_Value (Data, "");
+
else
Set_Return_Value (Data, Prop2.Value.all);
end if;
============================================================
--- kernel/src/gps-kernel-remote.adb 82ded91952d6d30b71040a8dd7b8c5984de20405
+++ kernel/src/gps-kernel-remote.adb 40c68743b35e6eb11befb57ff6c467e3d24ce07c
@@ -17,6 +17,7 @@
-- Place - Suite 330, Boston, MA 02111-1307, USA. --
-----------------------------------------------------------------------
+with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Exceptions; use Ada, Ada.Exceptions;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
@@ -354,6 +355,7 @@ package body GPS.Kernel.Remote is
Advanced_Table : Gtk_Table;
User_Name_Entry : Gtk_Entry;
Max_Nb_Connected_Spin : Gtk_Spin_Button;
+ Cr_Lf_Combo : Gtkada_Combo;
Timeout_Spin : Gtk_Spin_Button;
Init_Cmds_View : Gtk_Text_View;
Debug_Button : Gtk_Check_Button;
@@ -515,6 +517,7 @@ package body GPS.Kernel.Remote is
Max_Nb_Connections : Natural;
User_Name : GNAT.OS_Lib.String_Access;
Timeout : Natural;
+ Cr_Lf : Cr_Lf_Handling;
Extra_Init_Cmds : GNAT.OS_Lib.Argument_List_Access;
Nb_Init_Cmds : Natural;
Child : Node_Ptr;
@@ -584,6 +587,14 @@ package body GPS.Kernel.Remote is
User_Name := new String'("");
end if;
+ Field := Get_Field (Node, "cr_lf");
+
+ if Field /= null then
+ Cr_Lf := Cr_Lf_Handling'Value (Field.all);
+ else
+ Cr_Lf := Auto;
+ end if;
+
Field := Get_Field (Node, "timeout");
if Field /= null then
@@ -639,6 +650,7 @@ package body GPS.Kernel.Remote is
Max_Nb_Connections => Max_Nb_Connections,
User_Name => User_Name,
Timeout => Timeout,
+ Cr_Lf => Cr_Lf,
Extra_Init_Commands => Extra_Init_Cmds,
Attribute => Attribute,
Applied => True,
@@ -794,6 +806,10 @@ package body GPS.Kernel.Remote is
Child.Value := new String'(Natural'Image (Desc.Timeout));
Add_Child (Item, Child);
Child := new Node;
+ Child.Tag := new String'("cr_lf");
+ Child.Value := new String'(Desc.Cr_Lf'Img);
+ Add_Child (Item, Child);
+ Child := new Node;
Child.Tag := new String'("max_nb_connections");
Child.Value := new String'
(Natural'Image (Desc.Max_Nb_Connections));
@@ -1637,8 +1653,9 @@ package body GPS.Kernel.Remote is
Fill or Expand, 0, 10, 10);
Gtk_New (Dialog.Advanced_Table,
- Rows => 4, Columns => 2, Homogeneous => False);
+ Rows => 5, Columns => 2, Homogeneous => False);
Set_Expanded_Widget (Dialog.Advanced_Pane, Dialog.Advanced_Table);
+
-- ??? The following uses Gtk_Expander instead of Collapsing_Pane
-- Gtk_New (Frame);
-- Attach (Dialog.Right_Table, Frame,
@@ -1700,12 +1717,33 @@ package body GPS.Kernel.Remote is
"the same time on the machine, GPS will need more that one " &
"connection to do this. The default value is 3."));
- Gtk_New (Label, -"Debug console:");
+ Gtk_New (Label, -"CR/LF Handling:");
Set_Alignment (Label, 0.0, 0.5);
Attach (Dialog.Advanced_Table, Label, 0, 1, 3, 4,
Fill or Expand, 0, 10);
+ Gtk_New (Dialog.Cr_Lf_Combo);
+ Set_Name (Dialog.Cr_Lf_Combo, "crlf handling combo");
+ Set_Editable (Get_Entry (Dialog.Cr_Lf_Combo), False);
+ Attach (Dialog.Advanced_Table, Dialog.Cr_Lf_Combo,
+ 1, 2, 3, 4,
+ Fill or Expand, 0);
+ Set_Tip
+ (Tips, Get_Entry (Dialog.Cr_Lf_Combo),
+ -("Indicates what characters the remote host understands as line" &
+ " ending: LF, CR/LF, or automatically determine it."));
+
+ for J in Cr_Lf_Handling'Range loop
+ Gtk_New (Item, Ada.Characters.Handling.To_Lower (J'Img));
+ Add (Get_List (Dialog.Cr_Lf_Combo), Item);
+ end loop;
+ Show_All (Get_List (Dialog.Cr_Lf_Combo));
+
+ Gtk_New (Label, -"Debug console:");
+ Set_Alignment (Label, 0.0, 0.5);
+ Attach (Dialog.Advanced_Table, Label, 0, 1, 4, 5,
+ Fill or Expand, 0, 10);
Gtk_New (Dialog.Debug_Button);
- Attach (Dialog.Advanced_Table, Dialog.Debug_Button, 1, 2, 3, 4, 0, 0);
+ Attach (Dialog.Advanced_Table, Dialog.Debug_Button, 1, 2, 4, 5, 0, 0);
Set_Tip
(Tips, Dialog.Debug_Button,
-("The Debug console allow you to easily debug a remote connection." &
@@ -1758,6 +1796,9 @@ package body GPS.Kernel.Remote is
(Get_Buffer (Dialog.Init_Cmds_View), Gtk.Text_Buffer.Signal_Changed,
On_Changed'Access, Dialog, False);
Widget_Boolean_Callback.Object_Connect
+ (Get_Entry (Dialog.Cr_Lf_Combo),
+ Gtk.Editable.Signal_Changed, On_Changed'Access, Dialog, True);
+ Widget_Boolean_Callback.Object_Connect
(Dialog.Debug_Button, Signal_Clicked,
On_Changed'Access, Dialog, False);
Widget_Callback.Object_Connect
@@ -2072,6 +2113,8 @@ package body GPS.Kernel.Remote is
(Get_Text (Dialog.User_Name_Entry)),
Timeout =>
Integer (Get_Value_As_Int (Dialog.Timeout_Spin)) * 1000,
+ Cr_Lf => Cr_Lf_Handling'Value
+ (Get_Text (Get_Entry (Dialog.Cr_Lf_Combo))),
Max_Nb_Connections => Integer
(Get_Value_As_Int (Dialog.Max_Nb_Connected_Spin)),
Extra_Init_Commands => new Argument_List'
@@ -2174,21 +2217,30 @@ package body GPS.Kernel.Remote is
end if;
Dialog.Restoring := True;
- Set_Text (Dialog.Network_Name_Entry,
- Item.Desc.Network_Name.all);
- Set_Text (Dialog.User_Name_Entry,
- Item.Desc.User_Name.all);
- Set_Text (Get_Entry (Dialog.Remote_Access_Combo),
- Item.Desc.Access_Name.all);
- Set_Text (Get_Entry (Dialog.Remote_Shell_Combo),
- Item.Desc.Shell_Name.all);
Set_Text
+ (Dialog.Network_Name_Entry,
+ Item.Desc.Network_Name.all);
+ Set_Text
+ (Dialog.User_Name_Entry,
+ Item.Desc.User_Name.all);
+ Set_Text
+ (Get_Entry (Dialog.Remote_Access_Combo),
+ Item.Desc.Access_Name.all);
+ Set_Text
+ (Get_Entry (Dialog.Remote_Shell_Combo),
+ Item.Desc.Shell_Name.all);
+ Set_Text
(Get_Entry (Dialog.Remote_Sync_Combo),
Machine_Descriptor_Record (Item.Desc.all).Rsync_Func.all);
- Set_Value (Dialog.Timeout_Spin,
- Gdouble (Item.Desc.Timeout) / 1000.0);
- Set_Value (Dialog.Max_Nb_Connected_Spin,
- Gdouble (Item.Desc.Max_Nb_Connections));
+ Set_Value
+ (Dialog.Timeout_Spin,
+ Gdouble (Item.Desc.Timeout) / 1000.0);
+ Set_Value
+ (Dialog.Max_Nb_Connected_Spin,
+ Gdouble (Item.Desc.Max_Nb_Connections));
+ Set_Text
+ (Get_Entry (Dialog.Cr_Lf_Combo),
+ Ada.Characters.Handling.To_Lower (Item.Desc.Cr_Lf'Img));
Set_Text (Get_Buffer (Dialog.Init_Cmds_View), "");
Set_Active (Dialog.Debug_Button, Item.Desc.Dbg /= null);
@@ -2278,6 +2330,7 @@ package body GPS.Kernel.Remote is
Extra_Init_Commands => null,
Timeout => 10000,
Max_Nb_Connections => 3,
+ Cr_Lf => Auto,
Attribute => User_Defined,
Applied => False,
Ref => 1,
@@ -2353,18 +2406,27 @@ package body GPS.Kernel.Remote is
Set (Gtk_Tree_Store (Model), Iter, User_Def_Col, False);
-- Set dialog values
- Set_Text (Dialog.Network_Name_Entry,
- Item.Desc.Network_Name.all);
- Set_Text (Dialog.User_Name_Entry,
- Item.Desc.User_Name.all);
- Set_Text (Get_Entry (Dialog.Remote_Access_Combo),
- Item.Desc.Access_Name.all);
- Set_Text (Get_Entry (Dialog.Remote_Shell_Combo),
- Item.Desc.Shell_Name.all);
- Set_Value (Dialog.Timeout_Spin,
- Gdouble (Item.Desc.Timeout) / 1000.0);
- Set_Value (Dialog.Max_Nb_Connected_Spin,
- Gdouble (Item.Desc.Max_Nb_Connections));
+ Set_Text
+ (Dialog.Network_Name_Entry,
+ Item.Desc.Network_Name.all);
+ Set_Text
+ (Dialog.User_Name_Entry,
+ Item.Desc.User_Name.all);
+ Set_Text
+ (Get_Entry (Dialog.Remote_Access_Combo),
+ Item.Desc.Access_Name.all);
+ Set_Text
+ (Get_Entry (Dialog.Remote_Shell_Combo),
+ Item.Desc.Shell_Name.all);
+ Set_Value
+ (Dialog.Timeout_Spin,
+ Gdouble (Item.Desc.Timeout) / 1000.0);
+ Set_Value
+ (Dialog.Max_Nb_Connected_Spin,
+ Gdouble (Item.Desc.Max_Nb_Connections));
+ Set_Text
+ (Get_Entry (Dialog.Cr_Lf_Combo),
+ Ada.Characters.Handling.To_Lower (Item.Desc.Cr_Lf'Img));
Set_Active (Dialog.Debug_Button, Item.Desc.Dbg /= null);
Dialog.Restoring := False;
end if;
@@ -2985,7 +3047,6 @@ package body GPS.Kernel.Remote is
Password_Prompt_Ptrn : Glib.String_Ptr;
Passphrase_Prompt_Ptrn : Glib.String_Ptr;
Extra_Ptrn_Length : Natural;
- Use_Cr_Lf : Boolean;
Use_Pipes : Boolean;
begin
@@ -3007,7 +3068,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;
@@ -3220,21 +3281,6 @@ package body GPS.Kernel.Remote is
Password_Prompt_Ptrn := Get_Field (Node, "password_prompt_ptrn");
Passphrase_Prompt_Ptrn := Get_Field (Node, "passphrase_prompt_ptrn");
- declare
- Use_Cr_Lf_String_Access : constant Glib.String_Ptr :=
- Get_Field (Node, "use_cr_lf");
- begin
- if Use_Cr_Lf_String_Access = null then
- Use_Cr_Lf := False;
- else
- Use_Cr_Lf := Boolean'Value (Use_Cr_Lf_String_Access.all);
- end if;
-
- exception
- when others =>
- Use_Cr_Lf := False;
- end;
-
Child := Node.Child;
Extra_Ptrn_Length := 0;
@@ -3294,7 +3340,6 @@ package body GPS.Kernel.Remote is
Passphrase_Prompt_Ptrn =>
GNAT.OS_Lib.String_Access (Passphrase_Prompt_Ptrn),
Extra_Prompt_Array => Extra_Ptrns,
- Use_Cr_Lf => Use_Cr_Lf,
Use_Pipes => Use_Pipes);
-- The contents of those string_list is freed when the descriptor
============================================================
--- kernel/src_info/projects-registry.adb a30cd2e99f63aa8343a548d6f218c878d728099e
+++ kernel/src_info/projects-registry.adb 15f722ba9cc45bb8cb58029d77b6a6ee6ebfdbe2
@@ -47,6 +47,7 @@ with Prj.Com; use Prj.
with GPS.Intl; use GPS.Intl;
with OS_Utils; use OS_Utils;
with Prj.Com; use Prj.Com;
+with Prj.Env; use Prj.Env;
with Prj.Ext; use Prj.Ext;
with Prj.PP; use Prj.PP;
with Prj.Util; use Prj.Util;
@@ -264,6 +265,10 @@ package body Projects.Registry is
-- Return access to the various tables that contain information about the
-- project
+ procedure Do_Subdirs_Cleanup (Registry : Project_Registry);
+ -- Cleanup empty subdirs created when opening a project with prj.subdirs
+ -- set.
+
--------------------
-- Array_Elements --
--------------------
@@ -430,6 +435,7 @@ package body Projects.Registry is
Naming : Naming_Scheme_Access;
begin
if Registry.Data /= null then
+ Do_Subdirs_Cleanup (Registry);
Unload_Project (Registry, View_Only);
else
Registry.Data := new Project_Registry_Data;
@@ -1765,7 +1771,7 @@ package body Projects.Registry is
-- Make sure the file we found has the same full name, since it might
-- match a file from the project that has the same base name, but not
-- belong to the project (FB03-003)
- if Get_String (S.Full_Name) /= Full_Name (Source_Filename).all then
+ if Create (Get_String (S.Full_Name)) /= Source_Filename then
P := No_Project;
end if;
@@ -2419,9 +2425,9 @@ package body Projects.Registry is
procedure Set_Mode_Subdir
(Registry : in out Project_Registry; Subdir : String)
is
- pragma Unreferenced (Registry);
begin
if Prj.Subdirs /= null then
+ Do_Subdirs_Cleanup (Registry);
Types.Free (Prj.Subdirs);
end if;
@@ -2459,6 +2465,67 @@ package body Projects.Registry is
return Prj.Subdirs.all;
end Get_Mode_Subdir;
+ ------------------------
+ -- Do_Subdirs_Cleanup --
+ ------------------------
+
+ procedure Do_Subdirs_Cleanup (Registry : Project_Registry) is
+ function Get_Paths return String;
+ -- Get the list of directories that potentially need cleanup
+
+ function Get_Paths return String is
+ begin
+ if Registry.Data = null
+ or else Get_View (Registry.Data.Root) = Prj.No_Project
+ then
+ return Prj.Subdirs.all;
+ else
+ declare
+ Objs : constant String :=
+ Prj.Env.Ada_Objects_Path
+ (Get_View (Registry.Data.Root),
+ Registry.Data.Root.View_Tree).all;
+ begin
+ if Objs = "" then
+ return Prj.Subdirs.all;
+ else
+ return Objs;
+ end if;
+ end;
+ end if;
+ end Get_Paths;
+
+ Dir_Iter : Path_Iterator;
+
+ begin
+ -- Nothing to do if Prj.Subdirs is not set.
+ if Prj.Subdirs = null then
+ return;
+ end if;
+
+ declare
+ Objs : constant String := Get_Paths;
+ begin
+ Dir_Iter := Start (Objs);
+
+ while not At_End (Objs, Dir_Iter) loop
+ declare
+ Dir : constant String := Current (Objs, Dir_Iter);
+ begin
+ if Dir /= ""
+ and then Is_Directory (Dir)
+ and then Is_Empty (Dir)
+ then
+ -- Remove emtpy directories
+ GNAT.Directory_Operations.Remove_Dir (Dir);
+ end if;
+ end;
+
+ Dir_Iter := Next (Objs, Dir_Iter);
+ end loop;
+ end;
+ end Do_Subdirs_Cleanup;
+
--------------
-- Get_Tree --
--------------
============================================================
--- kernel/src_info/projects.ads ed15a6e88aea46d9db70011dcb041af04e33fa90
+++ kernel/src_info/projects.ads d939aecf2c10cb79bfd0fc4e73b8b92307c670f5
@@ -466,8 +466,7 @@ package Projects is
-- If Recursive is False, then the only project ever returned is
-- Root_Project. This is provided only to simplify the caller's code
--
- -- In all cases, Root_Project itself is returned first by the iterator. The
- -- project extended by Root_Project, if any, is also returned if
+ -- The project extended by Root_Project, if any, is also returned if
-- Include_Extended is true or if Direct_Only is False.
--
-- If Direct_Only is True and Recursive is True, then only the projects
============================================================
--- share/plug-ins/ada_support.py 953a55ac6190ef3e6350ebc197772b5f370cb284
+++ share/plug-ins/ada_support.py db5771b0d300f3191c513239b269861d1e3922cf
@@ -11,7 +11,7 @@ And finally a number of predefined text
## No user customization below this line
###########################################################################
-import GPS, os, os.path, re, string, traceback
+import GPS, os, os.path, re, string, sys, traceback
import os_utils, gnat_switches
gnatmakeproc = None
@@ -38,7 +38,6 @@ class gnatMakeProc:
self.validity_checks_list = []
self.style_checks_list = []
self.gnatCmd = ""
- self.style_alias = "-gnaty3abcefhiklmnprst"
def getXmlForCompiler(self):
global ruleseditor, xmlCompilerHead, xmlCompilerPopupValidity, xmlCompilerPopupStyles, xmlCompilerTrailer
@@ -128,8 +127,19 @@ class gnatMakeProc:
</popup>
<popup label="Style checks" line="2" column="1" >
"""
+ style_alias_res = re.split ("^ *This is equivalent to ([^., ]*).*", tip ("-gnaty", [ "y", "-gnaty" ]));
+ if len (style_alias_res) > 1:
+ default_style_alias = "-"+style_alias_res[1]
+ else:
+ default_style_alias = "-gnaty3abcefhiklmnprst"
+
for switch in self.style_checks_list:
- if switch[3]=="0":
+ if switch[0]=="y":
+ xml += '<expansion switch="-gnatyy" alias="-gnaty" />'
+ elif switch[0]=="g":
+ xml += '<expansion switch="-gnatyg" alias="%s" />' % (default_style_alias + "dISux")
+ elif switch[3]=="0":
+ GPS.Console("Messages").write ("add check switch -gnaty%s\n" % (switch[0]))
xml += """<check %s switch="-gnaty%s">%s</check>""" % (label ("-gnaty", switch), switch[0], tip("-gnaty",switch))
else:
# place gnaty1-9 to the begining of the command_line: prevents
@@ -139,11 +149,10 @@ class gnatMakeProc:
else:
before=""
xml += """<spin %s switch="-gnaty%s" min="%s" max="%s" default="%s" separator="" %s>%s</spin>""" % (label ("-gnaty", switch), switch[0], switch[2], switch[3], switch[4], before, tip("-gnaty",switch))
- xml += '<expansion switch="-gnatyy" alias="-gnaty" />'
xml += '<expansion switch="-gnatym" alias="-gnatyM79" />'
- xml += '<expansion switch="-gnaty" alias="'+self.style_alias+'" />'
+ xml += """<expansion switch="-gnaty" alias="%s" />""" % (default_style_alias)
xml += """
- <expansion switch="-gnaty" />
+ <expansion switch="-gnaty"/>
</popup>
"""
xmlCompiler = xmlCompilerHead+xml+xmlCompilerTrailer
@@ -167,7 +176,7 @@ class gnatMakeProc:
try:
xmlCompiler = self.getXmlForCompiler()
except:
- print "Exception thrown in ada_support.py"
+ print "Exception thrown in ada_support.py", sys.exc_info()[1]
xmlCompiler = xmlCompilerHead+xmlCompilerDefault+xmlCompilerTrailer
GPS.parse_xml ("""<?xml version="1.0" ?><GPS>"""+xmlCompiler+"</GPS>")
@@ -233,16 +242,9 @@ class gnatMakeProc:
if res[1] == "1-9":
self.style_checks_list.append(["", res[3], "0", "9", "0"])
- elif res[1] == "y":
- sw = ["y", ""]
- style_alias_res = re.split ("^ *This is equivalent to ([^., ]*).*", tip ("-gnaty", sw));
- if len (style_alias_res) > 1:
- self.style_alias = "-"+style_alias_res[1]
- else:
- self.style_alias = "-gnaty3abcefhiklmnprst"
-
- # no parameters. Do not include -gnatyN (remove all checks), -gnatyg (GNAT checks) and -gnatym (alias of -gnatyM79)
- elif res[1] != "N" and res[1] != "g" and res[1] != "m":
+ # no parameters. Do not include -gnatyN (remove all checks) and -gnatym (alias of -gnatyM79)
+ elif res[1] != "N" and res[1] != "m":
+ GPS.Console ("Messages").write ("new switch -gnaty%s\n" % (res[1]))
if res[2] == "":
self.style_checks_list.append([res[1], res[3], "0", "0", "0"])
else:
============================================================
--- share/plug-ins/build_modes.xml 78024b088724be9a146448623cd8c5752f44e2cf
+++ share/plug-ins/build_modes.xml 5025daccc717bc4c0a0220ced59315b7890e588d
@@ -11,6 +11,7 @@
<subdir>debug</subdir>
<supported-model>builder</supported-model>
<supported-model>gnatmake</supported-model>
+ <supported-model>gprbuild</supported-model>
<supported-model filter="--subdirs=">gprclean</supported-model>
<extra-args>
<arg>--subdirs=%subdir</arg>
@@ -25,6 +26,7 @@
<subdir>check</subdir>
<supported-model>builder</supported-model>
<supported-model>gnatmake</supported-model>
+ <supported-model>gprbuild</supported-model>
<supported-model filter="--subdirs=">gprclean</supported-model>
<extra-args>
<arg>--subdirs=%subdir</arg>
@@ -42,6 +44,7 @@
<subdir>opt</subdir>
<supported-model>builder</supported-model>
<supported-model>gnatmake</supported-model>
+ <supported-model>gprbuild</supported-model>
<supported-model filter="--subdirs=">gprclean</supported-model>
<extra-args>
<arg>--subdirs=%subdir</arg>
@@ -56,10 +59,12 @@
<subdir>gcov</subdir>
<supported-model>builder</supported-model>
<supported-model>gnatmake</supported-model>
+ <supported-model>gprbuild</supported-model>
<supported-model filter="--subdirs=">gprclean</supported-model>
<extra-args>
<arg>--subdirs=%subdir</arg>
<arg>-cargs</arg>
+ <arg>-g</arg>
<arg>-fprofile-arcs</arg>
<arg>-ftest-coverage</arg>
<arg>-largs</arg>
@@ -72,10 +77,12 @@
<subdir>gprof</subdir>
<supported-model>builder</supported-model>
<supported-model>gnatmake</supported-model>
+ <supported-model>gprbuild</supported-model>
<supported-model filter="--subdirs=">gprclean</supported-model>
<extra-args>
<arg>--subdirs=%subdir</arg>
<arg>-cargs</arg>
+ <arg>-g</arg>
<arg>-pg</arg>
<arg>-largs</arg>
<arg>-pg</arg>
@@ -88,6 +95,7 @@
<shadow>TRUE</shadow>
<supported-model>builder</supported-model>
<supported-model>gnatmake</supported-model>
+ <supported-model>gprbuild</supported-model>
<supported-model filter="--subdirs=">gprclean</supported-model>
<server>Tools_Server</server>
<substitutions>
============================================================
--- share/plug-ins/protocols.xml.in a5a5e57958812110f4f04ce42708256b046731b5
+++ share/plug-ins/protocols.xml.in cebe15c53fc86d20659d79cc848214faae8dfcf7
@@ -50,7 +50,6 @@
<start_command_common_args>-t -C -ssh %U %h %C</start_command_common_args>
<start_command_user_args>-l %u</start_command_user_args>
<extra_ptrn auto_answer="true" answer="y">^Store key in cache\? \(y/n\) *</extra_ptrn>
- <use_cr_lf>True</use_cr_lf>
</remote_connection_config>
<!-- PLINK RSH -->
@@ -59,7 +58,6 @@
<start_command use_pipes="false">plink</start_command>
<start_command_common_args>-rsh %U %h %C</start_command_common_args>
<start_command_user_args>-l %u</start_command_user_args>
- <use_cr_lf>True</use_cr_lf>
</remote_connection_config>
<!-- PLINK TELNET -->
@@ -68,7 +66,6 @@
<start_command use_pipes="false">plink</start_command>
<start_command_common_args>-telnet %U %h %C</start_command_common_args>
<start_command_user_args>-l %u</start_command_user_args>
- <use_cr_lf>True</use_cr_lf>
</remote_connection_config>
<!-- SH shell -->
============================================================
--- share/plug-ins/spark.py d0854ffbe3614c1bb14a0804b1f9c958855d95b5
+++ share/plug-ins/spark.py a06ee926490affd0644750c9b8ab69b23518d502
@@ -459,8 +459,8 @@ a = """<?xml version="1.0"?>
<shell>MDI.save_all false</shell>
<shell>Project %p</shell>
<shell>Project.get_tool_switches_as_string %1 "SPARKFormat" </shell>
- <external output="SPARK Output" server="build_server">sparkformat %1 %f</external>
- <shell>Editor.edit %f 0 0 0 true</shell>
+ <external output="SPARK Output" server="build_server">sparkformat %1 %F</external>
+ <shell>Editor.edit %F 0 0 0 true</shell>
</action>
<action name="Examine metafile" category="Spark" output="none">
@@ -469,7 +469,7 @@ a = """<?xml version="1.0"?>
<shell>Locations.remove_category Examiner</shell>
<shell>Project %p</shell>
<shell>Project.get_tool_switches_as_string %1 "Examiner" </shell>
- <external output="SPARK Output" server="build_server">spark %1 ~brief @%f</external>
+ <external output="SPARK Output" server="build_server">spark %1 ~brief @%F</external>
<on-failure>
<shell>Locations.parse """%1 """ Examiner</shell>
</on-failure>
@@ -484,7 +484,7 @@ a = """<?xml version="1.0"?>
<filter language="VCG" />
<shell>Project %p</shell>
<shell>Project.get_tool_switches_as_string %1 "Simplifier" </shell>
- <external server="build_server" output="Simplifier Output">spadesimp %f %1</external>
+ <external server="build_server" output="Simplifier Output">spadesimp %F %1</external>
</action>
<action name="Simplify all" category="Spark" output="none">
============================================================
--- src_editor/src/src_editor_module.adb 13f07da5d4792a50511ee655bedcb6440aa916d8
+++ src_editor/src/src_editor_module.adb 1e2388f3e9a7aaebe16b2bd40213a37ee945432f
@@ -63,6 +63,7 @@ with Completion_Module;
with Casing_Exceptions; use Casing_Exceptions;
with Commands.Interactive; use Commands, Commands.Interactive;
with Completion_Module; use Completion_Module;
+with Config; use Config;
with Default_Preferences; use Default_Preferences;
with File_Utils; use File_Utils;
with Filesystems; use Filesystems;
@@ -3267,6 +3268,9 @@ package body Src_Editor_Module is
Id : constant Source_Editor_Module :=
Source_Editor_Module (Src_Editor_Module_Id);
+ Runtime_Use_ACL : C.int;
+ pragma Import (C, Runtime_Use_ACL, "__gnat_use_acl");
+
Iter : Child_Iterator;
Child : MDI_Child;
begin
@@ -3346,6 +3350,15 @@ package body Src_Editor_Module is
Next (Iter);
end loop;
end if;
+
+ -- Set ACL usage
+ if Config.Host = Config.Windows then
+ if Use_ACL.Get_Pref then
+ Runtime_Use_ACL := 1;
+ else
+ Runtime_Use_ACL := 0;
+ end if;
+ end if;
end Preferences_Changed;
----------
============================================================
--- vcs/src/vcs_activities_view_api.adb 15d5ed0407857fb79dc1d5f5a8d52a823d9ff4e8
+++ vcs/src/vcs_activities_view_api.adb 5b64990046fc1c76ee393375dbf5f667f46da346
@@ -1037,9 +1037,7 @@ package body VCS_Activities_View_API is
Set_Sensitive (Item, Active);
end if;
- if File_Section
- or else (Activity_Section and then Actions (Commit) /= null)
- then
+ if File_Section or else Activity_Section then
Gtk_New (Item);
Append (Menu, Item);
end if;
@@ -1054,20 +1052,18 @@ package body VCS_Activities_View_API is
end if;
if Activity_Section then
- if Actions (Commit) /= null then
- Gtk_New (Item, Label => -"Edit revision log");
+ Gtk_New (Item, Label => -"Edit revision log");
+ Append (Menu, Item);
+ Context_Callback.Connect
+ (Item, Signal_Activate, On_Menu_Edit_Log'Access, Context);
+ Set_Sensitive (Item, True);
+
+ if Has_Log (Kernel, Activity) then
+ Gtk_New (Item, Label => -"Remove revision log");
Append (Menu, Item);
Context_Callback.Connect
- (Item, Signal_Activate, On_Menu_Edit_Log'Access, Context);
+ (Item, Signal_Activate, On_Menu_Remove_Log'Access, Context);
Set_Sensitive (Item, True);
-
- if Has_Log (Kernel, Activity) then
- Gtk_New (Item, Label => -"Remove revision log");
- Append (Menu, Item);
- Context_Callback.Connect
- (Item, Signal_Activate, On_Menu_Remove_Log'Access, Context);
- Set_Sensitive (Item, True);
- end if;
end if;
end if;
end VCS_Activities_Contextual_Menu;
============================================================
--- widgets/src/gtkada-terminal.adb ca97052bf0ca57d5f6bfea1657f4a61cca7236d8
+++ widgets/src/gtkada-terminal.adb 9db9aa591fbdc926a02a790d0947ada07d612b6e
@@ -833,6 +833,8 @@ package body Gtkada.Terminal is
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 38 => Term.Current_Foreground := Tag_Array'First; -- Default
+ when 39 => Term.Current_Foreground := -1;
when 40 => Term.Current_Background := Tag_Array'First;
when 41 => Term.Current_Background := Tag_Array'First + 1;
@@ -842,6 +844,8 @@ package body Gtkada.Terminal is
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 48 => Term.Current_Background := Tag_Array'First; -- Default
+ when 49 => Term.Current_Background := -1;
when others =>
Trace (Me, "Set_Attribute:" & Ansi'Img);