paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 17:19:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

Carbon: Fix TOpenDialog behavior. Issue #30533, patch from C Western.

Browse Source 
git-svn-id: trunk@54800 -
This commit is contained in:
juha 2017-05-02 17:50:42 +00:00
parent 89b56c31b3
commit 037e28a92d
1 changed files with 17 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lcl/interfaces/carbon/carbonwsdialogs.pp
View File

@ -319,10 +319,11 @@ var
FilterUPP: NavObjectFilterUPP; FilterUPP: NavObjectFilterUPP;
NavDialogUPP: NavEventUPP; NavDialogUPP: NavEventUPP;
DialogRef: NavDialogRef; DialogRef: NavDialogRef;
ReplyRecord: NavReplyRecord;
I: Integer; I: Integer;
ParsedFilter: TParseStringList; ParsedFilter: TParseStringList;
M: TMaskList; M: TMaskList;
filterext, InitDir: String; filterext: String;
supportPackages: Boolean; //todo: select packages by name supportPackages: Boolean; //todo: select packages by name
begin begin
{$IFDEF VerboseWSClass} {$IFDEF VerboseWSClass}
@ -331,15 +332,13 @@ begin
FileDialog := ACommonDialog as TFileDialog; FileDialog := ACommonDialog as TFileDialog;
// two sources of init dir
InitDir := FileDialog.InitialDir;
if InitDir = '' then
InitDir := ExtractFileDir(FileDialog.FileName);
// Initialize record to default values // Initialize record to default values
if OSError(NavGetDefaultDialogCreationOptions(CreationOptions{%H-}), if OSError(NavGetDefaultDialogCreationOptions(CreationOptions{%H-}),
Self, SShowModal, 'NavGetDefaultDialogCreationOptions') then Exit; Self, SShowModal, 'NavGetDefaultDialogCreationOptions') then Exit;
CreationOptions.preferenceKey := 272829; // The default of zero seems to cause setting the initial directory
// to fail half the time on Sierra at least, so set to an arbitrary
// non-zero value
if FileDialog.Title <> '' then // Override dialog's default title? if FileDialog.Title <> '' then // Override dialog's default title?
CreateCFString(FileDialog.Title, CreationOptions.windowTitle); CreateCFString(FileDialog.Title, CreationOptions.windowTitle);
@ -356,6 +355,8 @@ begin
begin begin
try try
filterext:=ParsedFilter[I * 2 - 1]; filterext:=ParsedFilter[I * 2 - 1];
{ Spaces in filters cause problems }
filterext := StringReplace(filterext, ' ', '', [rfReplaceAll]);
if (filterext = '*') or (filterext = '*.*') or (ExtractFileExt(filterext) = '.app') then if (filterext = '*') or (filterext = '*.*') or (ExtractFileExt(filterext) = '.app') then
supportPackages := true; supportPackages := true;
M := TMaskList.Create(filterext); M := TMaskList.Create(filterext);
@ -424,14 +425,17 @@ begin
if NavDialogGetUserAction(DialogRef) <> kNavUserActionCancel then // User OK? if NavDialogGetUserAction(DialogRef) <> kNavUserActionCancel then // User OK?
begin begin
if OSError(NavDialogGetReply(DialogRef, ReplyRecord), Self, SShowModal, 'NavDialogGetReply') then
Exit;
try
if not ReplyRecord.validRecord then
Exit;
DescListToFiles(@ReplyRecord.selection, FileDialog);
if FileDialog.FCompStyle=csSaveFileDialog then if FileDialog.FCompStyle=csSaveFileDialog then
FileDialog.FileName := InitDir + PathDelim + FileDialog.FileName := FileDialog.FileName + PathDelim + CFStringToStr(ReplyRecord.saveFileName);
CFStringToStr(NavDialogGetSaveFileName(DialogRef)); finally
{Note: Not at all clear from Apple docs that NavReplyRecord.Selection NavDisposeReply(ReplyRecord);
returns only path to file's folder with Save dialog. Also, what they end;
mean by the "full file name" returned by NavDialogGetSaveFileName
must mean extension and not path to file's folder.}
FileDialog.UserChoice := mrOK; FileDialog.UserChoice := mrOK;
end; end;
finally finally