lazarus/lcl/interfaces/carbon/carbonwsdialogs.pp

{
 *****************************************************************************
 *                              CarbonWSDialogs.pp                           * 
 *                              --------------                               * 
 *                                                                           *
 *                                                                           *
 *****************************************************************************

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}
unit CarbonWSDialogs;

{$mode objfpc}{$H+}

interface

// defines
{$I carbondefines.inc}

uses
  // libs
  MacOSAll,
  // LCL
  Classes, SysUtils, FileUtil, Controls, Dialogs, LCLType, LCLProc, Masks, Graphics,
  // widgetset
  WSLCLClasses, WSDialogs,
  // LCL Carbon
  CarbonDef;
  
type

  { TCarbonWSCommonDialog }

  TCarbonWSCommonDialog = class(TWSCommonDialog)
  published
  end;

  { TCarbonWSFileDialog }

  TCarbonWSFileDialog = class(TWSFileDialog)
  published
    class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
  end;

  { TCarbonWSOpenDialog }

  TCarbonWSOpenDialog = class(TWSOpenDialog)
  published
  end;

  { TCarbonWSSaveDialog }

  TCarbonWSSaveDialog = class(TWSSaveDialog)
  published
  end;

  { TCarbonWSSelectDirectoryDialog }

  TCarbonWSSelectDirectoryDialog = class(TWSSelectDirectoryDialog)
  published
  end;

  { TCarbonWSColorDialog }

  TCarbonWSColorDialog = class(TWSColorDialog)
  published
    class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
  end;

  { TCarbonWSColorButton }

  TCarbonWSColorButton = class(TWSColorButton)
  published
  end;

  { TCarbonWSFontDialog }

  TCarbonWSFontDialog = class(TWSFontDialog)
  published
    class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
  end;


implementation

uses
  CarbonProc, CarbonDbgConsts, CarbonInt, CarbonUtils, CarbonGDIObjects;

{ TCarbonWSFileDialog }

var
  Filters: TStringList; // filter text + TMaskList in object

procedure DescListToFiles(DescList: AEDescListPtr; FileDialog: TFileDialog);
var
  FileCount, FileIdx: Integer;
  Keyword: AEKeyword;
  FileDesc: AEDesc;
  FileRef: FSRef;
  FileURL: CFURLRef;
  FileCFStr: CFStringRef;
  FileName: string;
begin
  //DebugLnEnter('DescListToFiles INIT');
  //if OSError(NavDialogGetReply(DialogRef, DialogReply{%H-}), Self, SShowModal,
  //  'NavDialogGetReply') then Exit;  // Get user's selection
  //
  FileDialog.Files.Clear;

  if DescList=nil then begin
    DebugLnExit('DescList is nil, EXIT');
    exit;
  end;

  if (DescList=nil) or OSError(AECountItems(DescList^, FileCount{%H-}), FileDialog,
    SShowModal, 'AECountItems') then Exit;

  for FileIdx := 1 to FileCount do
  begin
    if OSError(AEGetNthDesc(DescList^, FileIdx, typeFSRef,
      @Keyword, FileDesc{%H-}), FileDialog, SShowModal, 'AEGetNthDesc') then Exit;

    // Get file reference
    if OSError(AEGetDescData(FileDesc, @FileRef, SizeOf(FSRef)), FileDialog,
      SShowModal, 'AEGetDescData') then Exit;

    if OSError(AEDisposeDesc(FileDesc), FileDialog, SShowModal,
      'AEDisposeDesc') then Exit;

    FileURL := CFURLCreateFromFSRef(kCFAllocatorDefault, FileRef); // Get URL
    FileCFStr := CFURLCopyFileSystemPath(FileURL, kCFURLPOSIXPathStyle); // Get path
    FileName := CFStringToStr(FileCFStr);
    //DebugLn('%d/%d FileName=%s',[FileIdx, FileCount, FileName]);
    FileDialog.Files.Add(FileName);

    FreeCFString(FileURL);
    FreeCFString(FileCFStr);
    // Note: Previous 5 lines replace next 2 lines and eliminate need
    //   to decide what size to make FileBuf array.
    //   See http://developer.apple.com/technotes/tn2002/tn2078.html
    //  FSRefMakePath(FileRef, @FileBuf, SizeOf(FileBuf));  {Get file path}
    //  FileDialog.Files.Add(string(FileBuf));  //FileBuf contains UTF8 C string
  end;

  FileDialog.FileName := FileDialog.Files.Strings[0];

  //if FileDialog.FCompStyle=csSaveFileDialog then
  //  FileDialog.FileName := FileDialog.FileName + PathDelim +
  //    CFStringToStr(NavDialogGetSaveFileName(DialogRef));
  //    {Note: Not at all clear from Apple docs that NavReplyRecord.Selection
  //      returns only path to file's folder with Save dialog. Also, what they
  //      mean by the "full file name" returned by NavDialogGetSaveFileName
  //      must mean extension and not path to file's folder.}


  // Dispose of data that record points to (?)
  //if OSError(NavDisposeReply(DialogReply), FileDialog, SShowModal,
  //  'NavDisposeReply') then Exit;

  //FileDialog.FilterIndex := FilterIndex + 1;
  //DebugLnExit('DescListToFiles END Files.Count=%d',[FileDialog.Files.Count]);
end;

function FilterCallback(var theItem: AEDesc; info: NavFileOrFolderInfoPtr;
 callbackUD: UnivPtr; {%H-}filterMode: NavFilterModes): Boolean; mwpascal;
 {Custom filter callback function. Pointer to this function is passed as
   inFilterProc to NavCreateGetFileDialog and NavCreateChooseFolderDialog.
  If theItem file should be highlighted in file dialog, return True;
   if it should be dimmed in file dialog, return False.
  The callbackUD param contains file dialog object passed as inClientData
   to NavCreateGetFileDialog and NavCreateChooseFolderDialog.}
var
  FileRef: FSRef;
  FileURL: CFURLRef;
  FileCFStr: CFStringRef;
  FilePath: string;
  FilterMask: TMaskList;
  FileDialog: TFileDialog;
  AIndex: Integer;
begin
  Result := True;
  FileDialog := TFileDialog(CallbackUD);
  if (FileDialog = nil) or (FileDialog.Filter='') then  // No user data passed?
    Exit;

  if FileDialog is TOpenDialog then
  begin
    if info^.isFolder then  // Don't dim folder?
      Exit;
  end
  else  {Must be TSelectDirectoryDialog}
  begin
    if not info^.isFolder then  // Dim file?
    begin
      Result := False;
      Exit;
    end;
  end;

  if OSError(AEGetDescData(theItem, @FileRef, SizeOf(FSRef)), 
             'FilterByExtCallback', '', 'AEGetDescData') then Exit;
                     
  FileURL := CFURLCreateFromFSRef(kCFAllocatorDefault, FileRef);
  FileCFStr := CFURLCopyFileSystemPath(FileURL, kCFURLPOSIXPathStyle);
          
  FilePath := CFStringToStr(FileCFStr);

  FreeCFString(FileURL);
  FreeCFString(FileCFStr);

  FilterMask := nil;
  AIndex := FileDialog.FilterIndex - 1;
  if (AIndex >= 0) and (AIndex < Filters.Count) then
    FilterMask := TMaskList(Filters.Objects[AIndex]);

  Result := (FilterMask = nil) or FilterMask.Matches(ExtractFilename(FilePath));
  //DebugLn('FilterCallback ' + DbgS(FilterMask) + ' ' + ExtractFilename(FilePath) + ' ' + DbgS(Result));
end;  {FilterCallback}

procedure NavDialogCallback(CallBackSelector: NavEventCallbackMessage;
  CallBackParms: NavCBRecPtr; CallBackUD: UnivPtr); mwpascal;
var
  Dir: AEDesc;
  DirRef: FSRef;
  DirURL: CFURLRef;
  DirCFStr: CFStringRef;
  PMenuSpec: NavMenuItemSpecPtr;
  MenuSpec: NavMenuItemSpec;
  AEDescList: AEDescListPtr;
  FileDialog: TFileDialog;
const
  SName = 'NavDialogCallback';
begin
  //DebugLnEnter(['NavDialogCallback INIT selector=',CallbackSelector]);
  if CallbackUD = nil then  // No user data passed?
    Exit;
  FileDialog := TFileDialog(CallbackUD);
    
  case CallBackSelector of
  kNavCBStart:
    begin

      // Set InitialDir
      if DirectoryExistsUTF8(FileDialog.InitialDir) then
      begin
        //DebugLn('Set InitialDir ' + TFileDialog(CallbackUD).InitialDir);
        CreateCFString(FileDialog.InitialDir, DirCFStr);
        try
          DirURL := CFURLCreateWithFileSystemPath(nil, DirCFStr,
            kCFURLPOSIXPathStyle, True);
        finally
          FreeCFString(DirCFStr);
        end;

        if DirURL <> nil then
          if CFURLGetFSRef(DirURL, DirRef{%H-}) then
            if not OSError(AECreateDesc(typeFSRef, @DirRef, SizeOf(FSRef), Dir{%H-}),
              SName, 'AECreateDesc') then
              OSError(NavCustomControl(CallBackParms^.context, kNavCtlSetLocation, @Dir),
                SName, 'NavCustomControl', 'InitialDir');
      end;

      // set initial filter index
      MenuSpec.version := kNavMenuItemSpecVersion;
      MenuSpec.menuCreator := kExtensionFolderType;
      MenuSpec.menuType := OSType(FileDialog.FilterIndex-1);
      MenuSpec.menuItemName := '';
      OSError(NavCustomControl(CallBackParms^.context, kNavCtlSelectCustomType, @MenuSpec),
                SName, 'NavCustomControl', 'FilterIndex');
    
    end;
  kNavCBPopupMenuSelect: // user has changed filter
    begin
      if CallBackParms = nil then Exit;
      PMenuSpec := NavMenuItemSpecPtr(CallBackParms^.eventData.eventDataParms.param);
      if PMenuSpec = nil then Exit;
      FileDialog.FilterIndex:= PMenuSpec^.menuType + 1;
      FileDialog.DoTypeChange;
    end;
  kNavCBSelectEntry:   // user has selected something
    begin
      if CallbackParms = nil then exit;
      AEDescList := AEDescListPtr(CallBackParms^.eventData.eventDataParms.param);
      DescListToFiles(AEDescList, FileDialog);
      //DebugLn(['kNavCBSelectEntry IsOpenDialog=',FileDialog is TOpenDialog]);
      if FileDialog is TOpenDialog then
        TOpenDialog(FileDialog).DoSelectionChange;
    end;
  kNavCBNewLocation:  // user has changed folder
    if FileDialog is TOpenDialog then
      TOpenDialog(FileDialog).DoFolderChange;
  end;

  //DebugLnExit('NavDialogCallback DONE');
end;


{------------------------------------------------------------------------------
  Method:  TCarbonWSFileDialog.ShowModal
  Params:  ACommonDialog - LCL common dialog
  
  Shows a file dialog (open, save, slect directory) in Carbon interface. Sets
  ACommonDialog.UserChoice to mrOK or mrCancel. If mrOK, also sets
  ACommonDialog.FileName to first file selected and adds file(s) selected to
  ACommonDialog.Files.
 ------------------------------------------------------------------------------}
class procedure TCarbonWSFileDialog.ShowModal(const ACommonDialog: TCommonDialog);
 {
  Called by Execute method of TOpenDialog, TSaveDialog and TSelectDirectoryDialog.
 }
var
  FileDialog: TFileDialog;
  CreationOptions: NavDialogCreationOptions;
  FilterUPP: NavObjectFilterUPP;
  NavDialogUPP: NavEventUPP;
  DialogRef: NavDialogRef;
  I: Integer;
  ParsedFilter: TParseStringList;
  M: TMaskList;
  filterext: String;
  supportPackages: Boolean; //todo: select packages by name
begin
  {$IFDEF VerboseWSClass}
    DebugLn('TCarbonWSFileDialog.ShowModal for ' + ACommonDialog.Name);
  {$ENDIF}

  FileDialog := ACommonDialog as TFileDialog;

  // Initialize record to default values
  if OSError(NavGetDefaultDialogCreationOptions(CreationOptions{%H-}),
    Self, SShowModal, 'NavGetDefaultDialogCreationOptions') then Exit;

  if FileDialog.Title <> '' then  // Override dialog's default title?
    CreateCFString(FileDialog.Title, CreationOptions.windowTitle);

  FileDialog.UserChoice := mrCancel; // Return this if user cancels or we need to exit

  FilterUPP := NewNavObjectFilterUPP(NavObjectFilterProcPtr(@FilterCallback));
  NavDialogUPP := NewNavEventUPP(NavEventProcPtr(@NavDialogCallback));

  Filters := TStringList.Create;
  // parse filters to popup menu - filter text + TMaskList
  ParsedFilter := TParseStringList.Create(FileDialog.Filter, '|');
  try
    for I := 1 to ParsedFilter.Count div 2 do
    begin
      try
        filterext:=ParsedFilter[I * 2 - 1];
        if (filterext = '*') or (filterext = '*.*') or (ExtractFileExt(filterext) = '.app') then
          supportPackages := true;
        M := TMaskList.Create(filterext);
      except
        FreeAndNil(M);
      end;
      //DebugLn('Filter ' + ParsedFilter[I * 2 - 1]);
      Filters.AddObject(ParsedFilter[I * 2 - 2], M);
    end;
  finally
    ParsedFilter.Free;
  end;
  supportPackages:=supportPackages or (Filters.Count=0);

  CreationOptions.popupExtension := StringsToCFArray(Filters);
  if supportPackages then
    CreationOptions.optionFlags := CreationOptions.optionFlags or kNavSupportPackages;
  try
    if FileDialog.FCompStyle=csSaveFileDialog then
    begin  // Checking for TSaveDialog first since it's descendent of TOpenDialog
      CreateCFString(ExtractFileName(FileDialog.FileName),
        CreationOptions.saveFileName);  // Note doesn't like path
        
      if ofOverwritePrompt in TOpenDialog(FileDialog).Options then
        CreationOptions.optionFlags :=
           CreationOptions.optionFlags and (not kNavDontConfirmReplacement)
      else
        CreationOptions.optionFlags :=
          CreationOptions.optionFlags or kNavDontConfirmReplacement;
         
      // Create Save dialog
      if OSError(
        NavCreatePutFileDialog(@CreationOptions, 0, 0, NavDialogUPP,
           UnivPtr(FileDialog), DialogRef{%H-}),
         Self, SShowModal, 'NavCreatePutFileDialog') then Exit;
    end
    else
      if FileDialog is TSelectDirectoryDialog then // Create Choose folder dialog
      begin
        if OSError(
          NavCreateChooseFolderDialog(@CreationOptions, NavDialogUPP,
           FilterUPP, UnivPtr(FileDialog), DialogRef),
           Self, SShowModal, 'NavCreateChooseFolderDialog') then Exit;
      end
      else
        if FileDialog is TOpenDialog then
        begin
          if not (ofAllowMultiSelect in TOpenDialog(FileDialog).Options) then
            CreationOptions.optionFlags :=
              CreationOptions.optionFlags and (not kNavAllowMultipleFiles)
          else
            CreationOptions.optionFlags :=
              CreationOptions.optionFlags or kNavAllowMultipleFiles;

          // Create Open dialog
          if OSError(
            NavCreateGetFileDialog(@CreationOptions, nil, NavDialogUPP, nil,
             FilterUPP, UnivPtr(FileDialog), DialogRef),
             Self, SShowModal, 'NavCreateGetFileDialog') then Exit;
        end;

    try
      // Display dialog
      if OSError(NavDialogRun(DialogRef), Self, SShowModal, 'NavDialogRun') then Exit;
      
      if NavDialogGetUserAction(DialogRef) <> kNavUserActionCancel then // User OK?
      begin
        if FileDialog.FCompStyle=csSaveFileDialog then
          FileDialog.FileName := FileDialog.FileName + PathDelim +
            CFStringToStr(NavDialogGetSaveFileName(DialogRef));
            {Note: Not at all clear from Apple docs that NavReplyRecord.Selection
              returns only path to file's folder with Save dialog. Also, what they
              mean by the "full file name" returned by NavDialogGetSaveFileName
              must mean extension and not path to file's folder.}

        FileDialog.UserChoice := mrOK;
      end;
    finally
      NavDialogDispose(DialogRef);  // Dispose of dialog
    end;

  finally
    CFRelease(CreationOptions.popupExtension);
    for I := 0 to Filters.Count - 1 do
      if Filters.Objects[I] <> nil then Filters.Objects[I].Free;
    Filters.Free;

    DisposeNavObjectFilterUPP(FilterUPP);
    DisposeNavEventUPP(NavDialogUPP);
    FreeCFString(CreationOptions.windowTitle);
    FreeCFString(CreationOptions.saveFileName);
  end;
end;  {TCarbonWSFileDialog.ShowModal}

{ TCarbonWSColorDialog }

{------------------------------------------------------------------------------
  Method:  TCarbonWSColorDialog.ShowModal
  Params:  ACommonDialog - LCL color dialog

  Shows Carbon interface color picker
 ------------------------------------------------------------------------------}
class procedure TCarbonWSColorDialog.ShowModal(
  const ACommonDialog: TCommonDialog);
var
  ColorInfo: NColorPickerInfo;
  ColorDialog: TColorDialog;
  Profile: CMProfileRef;
begin
  {$IFDEF VerboseWSClass}
    DebugLn('TCarbonWSColorDialog.ShowModal for ' + ACommonDialog.Name);
  {$ENDIF}
  
  ACommonDialog.UserChoice := mrCancel;
  ColorDialog := ACommonDialog as TColorDialog;
  
  CMGetDefaultProfileBySpace(cmRGBData, Profile{%H-});
  FillChar(ColorInfo{%H-}, SizeOf(ColorPickerInfo), 0);
  ColorInfo.theColor.color.rgb := CMRGBColor(ColorToRGBColor(ColorDialog.Color));
  ColorInfo.theColor.profile := Profile;
  ColorInfo.dstProfile := Profile;
  ColorInfo.flags := kColorPickerDialogIsModal or
                     kColorPickerDialogIsMoveable;
  ColorInfo.placeWhere :=  kCenterOnMainScreen;
  ColorInfo.pickerType := 0; // use last picker subtype
  ColorInfo.eventProc := nil;
  ColorInfo.colorProc := nil;
  ColorInfo.prompt := ColorDialog.Title;  // ColorDialog.Title is ignored, ColorInfo.prompt is not shown anywhere
  
  if OSError(NPickColor(ColorInfo), Self, SShowModal, 'PickColor') then Exit;
  
  if ColorInfo.newColorChosen then
  begin
    ColorDialog.Color := RGBColorToColor(RGBColor(ColorInfo.theColor.color.rgb));
    ACommonDialog.UserChoice := mrOK;
  end;
end;

var
  FontDialog: TFontDialog;

{ TCarbonWSFontDialog }

function CarbonFontDialog_Selection(ANextHandler: EventHandlerCallRef;
  AEvent: EventRef;
  {%H-}AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
  ID: ATSUFontID;
  Size: Fixed;
  Color: RGBColor;
  Style: FMFontStyle;
begin
  {$IFDEF VerboseWSClass}
    DebugLn('CarbonFontDialog_Selection: ', DbgSName(FontDialog));
  {$ENDIF}

  Result := CallNextEventHandler(ANextHandler, AEvent);

  // get font panel settings
    
  if GetEventParameter(AEvent, kEventParamATSUFontID, typeATSUFontID,
    nil, SizeOf(ID), nil, @ID) = noErr then
  begin
    //DebugLn('ID: ' + DbgS(ID));
    FontDialog.Font.Name := CarbonFontIDToFontName(ID);
  end;
  
  if GetEventParameter(AEvent, kEventParamATSUFontSize, typeATSUSize,
    nil, SizeOf(Size), nil, @Size) = noErr then
  begin
    //DebugLn('Size: ' + DbgS(RoundFixed(Size)));
    FontDialog.Font.Size := RoundFixed(Size);
  end;
  
  if GetEventParameter(AEvent, kEventParamFontColor, typeFontColor,
    nil, SizeOf(Color), nil, @Color) = noErr then
  begin
    //DebugLn('Color: ' + DbgS(RGBColorToColor(Color)));
    FontDialog.Font.Color := RGBColorToColor(Color);
  end;
  
  if GetEventParameter(AEvent, kEventParamFMFontStyle, typeFMFontStyle,
    nil, SizeOf(Style), nil, @Style) = noErr then
  begin
    //DebugLn('Style: ' + DbgS(Style));
    FontDialog.Font.Style := [];
    if (Style and MacOSAll.bold) > 0 then
      FontDialog.Font.Style := FontDialog.Font.Style + [fsBold];
    if (Style and MacOSAll.italic) > 0 then
      FontDialog.Font.Style := FontDialog.Font.Style + [fsItalic];
    if (Style and MacOSAll.underline) > 0 then
      FontDialog.Font.Style := FontDialog.Font.Style + [fsUnderline];
  end;
  
  // TODO: fsStrikeOut
    
  FontDialog.UserChoice := mrOK;
end;

function CarbonFontDialog_Close(ANextHandler: EventHandlerCallRef;
  AEvent: EventRef;
  {%H-}AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
begin
  {$IFDEF VerboseWSClass}
    DebugLn('CarbonFontDialog_Close: ', DbgSName(FontDialog));
  {$ENDIF}

  Result := CallNextEventHandler(ANextHandler, AEvent);
  
  CarbonWidgetSet.SetMainMenuEnabled(True);
  
  // hide font panel
  if FPIsFontPanelVisible then
    OSError(FPShowHideFontPanel, 'CarbonFontDialog_Close', 'FPShowHideFontPanel');
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWSFontDialog.ShowModal
  Params:  ACommonDialog - LCL font dialog

  Shows Carbon interface font panel
 ------------------------------------------------------------------------------}
class procedure TCarbonWSFontDialog.ShowModal(const ACommonDialog: TCommonDialog);
var
  AFontDialog: TFontDialog;
  TmpSpec: EventTypeSpec;
  Dialog: WindowRef;
  Style: ATSUStyle;
  ID: ATSUFontID;
  M: ATSUTextMeasurement;
  C: RGBColor;
  Attr: ATSUAttributeTag;
  S: ByteCount;
  A: ATSUAttributeValuePtr;
begin
  {$IFDEF VerboseWSClass}
    DebugLn('TCarbonWSFontDialog.ShowModal for ' + ACommonDialog.Name);
  {$ENDIF}
  
  AFontDialog := ACommonDialog as TFontDialog;
  AFontDialog.UserChoice := mrCancel;

  if OSError(
    CreateNewWindow(kModalWindowClass,
      kWindowCompositingAttribute or kWindowStandardHandlerAttribute, GetCarbonRect(0, 0, 0, 0), Dialog{%H-}),
    Self, SShowModal, 'CreateNewWindow') then Exit;
    
  try
    TmpSpec := MakeEventSpec(kEventClassFont, kEventFontPanelClosed);
    InstallWindowEventHandler(Dialog,
      RegisterEventHandler(@CarbonFontDialog_Close),
      1, @TmpSpec, nil, nil);

    TmpSpec := MakeEventSpec(kEventClassFont, kEventFontSelection);
    InstallWindowEventHandler(Dialog,
      RegisterEventHandler(@CarbonFontDialog_Selection),
      1, @TmpSpec, nil, nil);


    OSError(ATSUCreateAndCopyStyle(TCarbonFont(AFontDialog.Font.Reference.Handle).Style, Style{%H-}),
      Self, SShowModal, 'ATSUCreateAndCopyStyle');
      
    // force set font ID
    if ATSUGetAttribute(Style, kATSUFontTag, SizeOf(ID), @ID, nil) = kATSUNotSetErr then
    begin
      Attr := kATSUFontTag;
      A := @ID;
      S := SizeOf(ID);
      OSError(ATSUSetAttributes(Style, 1, @Attr, @S, @A), Self, SShowModal,
        'ATSUSetAttributes', 'kATSUFontTag');
    end;
    
    // force set font size
    if ATSUGetAttribute(Style, kATSUSizeTag, SizeOf(M), @M, nil) = kATSUNotSetErr then
    begin
      Attr := kATSUSizeTag;
      A := @M;
      S := SizeOf(M);
      OSError(ATSUSetAttributes(Style, 1, @Attr, @S, @A), Self, SShowModal,
        'ATSUSetAttributes', 'kATSUSizeTag');
    end;
    
    // force set font color
    if ATSUGetAttribute(Style, kATSUColorTag, SizeOf(C), @C, nil) = kATSUNotSetErr then
    begin
      Attr := kATSUColorTag;
      A := @C;
      S := SizeOf(C);
      OSError(ATSUSetAttributes(Style, 1, @Attr, @S, @A), Self, SShowModal,
        'ATSUSetAttributes', 'kATSUSizeTag');
    end;

    if OSError(SetFontInfoForSelection(kFontSelectionATSUIType, 1,
      @Style, GetWindowEventTarget(Dialog)),
      Self, SShowModal, 'SetFontInfoForSelection') then Exit;

    CarbonWidgetSet.SetMainMenuEnabled(False);

    FontDialog := AFontDialog;
    MacOSAll.ShowWindow(Dialog);

    // show font panel
    if not FPIsFontPanelVisible then
      OSError(FPShowHideFontPanel, Self, SShowModal, 'FPShowHideFontPanel');
      
    while FPIsFontPanelVisible do
      CarbonWidgetSet.AppProcessMessages;

  finally
    DisposeWindow(Dialog);
    CarbonWidgetSet.SetMainMenuEnabled(True);
  end;
end;

end.