paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-11 21:39:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL file dropping under gtk: applied #0011105: Patch to fix file drag and drop problems from Colin Western

Browse Source 
git-svn-id: trunk@14784 -
This commit is contained in:
tombo 2008-04-08 13:31:23 +00:00
parent b845efb8ab
commit d8a2b452ec
2 changed files with 9 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -2666,10 +2666,11 @@ procedure GtkDragDataReceived(widget:PGtkWidget; context:PGdkDragContext;
var
S: TStringList;
I: Integer;
FileName: String;
FileName, DecodedFileName: String;
Files: Array of String;
Form: TControl;
Result: Boolean;
U: TURI;
begin
//DebugLn('GtkDragDataReceived ' + PChar(selection_data^.data));
Result := False;
@ -2686,17 +2687,12 @@ begin
FileName := S[I];
if FileName = '' then Continue;
// uri -> file name, maybe for GTK2: g_filename_from_uri
// uri = protocol://hostname/file name
// convert uri of local files to file name
if Copy(FileName, 1, 17) = 'file://localhost/' then Delete(FileName, 1, 17)
else
if SameText(Copy(FileName, 1, 8), 'file:///') then
U := ParseURI(FileName);
if (SameText(U.Host, 'localhost') or (U.Host = '')) and SameText(U.Protocol, 'file')
and URIToFileName(FileName, DecodedFileName) then // convert uri of local files to file name
begin
Delete(FileName, 1, 8);
// do not remove UNIX root path
if (Pos(':', FileName) <> 2) and (Pos('/', FileName) <> 1) then
FileName := '/' + FileName;
FileName := DecodedFileName;
end;
// otherwise: protocol and hostname are preserved!

2
lcl/interfaces/gtk/gtkproc.pp
View File

@ -807,7 +807,7 @@ implementation
uses
{$IFDEF StaticXinerama} Xinerama, {$ENDIF}
dynlibs, GtkWSPrivate;
dynlibs, GtkWSPrivate, URIParser;
const
KCINFO_FLAG_SHIFT = $01;