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

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

View File

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

View File

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