Carbon intf:

- patch #0008537 by Philip J. Hess - Adds basic TOpenDialog, TSaveDialog and TSelectDirectoryDialog
- debug and tracing info, OSError for checking Carbon calls as Philip J. Hess proposed
- started TMainMenu, TPopupMenu, Hints
- TabOrder, TabStop, focusing
- TGraphicControl and TCustomControl descendants improved 

git-svn-id: trunk@10828 -

.gitattributes

@@ -2381,10 +2381,8 @@ lcl/interfaces/carbon/carbonlclintf.inc svneol=native#text/plain
 lcl/interfaces/carbon/carbonlclintfh.inc svneol=native#text/plain
 lcl/interfaces/carbon/carbonobject.inc svneol=native#text/plain
 lcl/interfaces/carbon/carbonprivate.pp svneol=native#text/pascal
-lcl/interfaces/carbon/carbonprivatecheckbox.inc svneol=native#text/plain
 lcl/interfaces/carbon/carbonprivatecommon.inc svneol=native#text/plain
 lcl/interfaces/carbon/carbonprivatecontrol.inc svneol=native#text/pascal
-lcl/interfaces/carbon/carbonprivatehiview.inc svneol=native#text/pascal
 lcl/interfaces/carbon/carbonprivatewindow.inc svneol=native#text/pascal
 lcl/interfaces/carbon/carbonproc.pp svneol=native#text/pascal
 lcl/interfaces/carbon/carbonstrings.pp svneol=native#text/pascal

lcl/interfaces/carbon/carboncanvas.pp

@@ -83,7 +83,6 @@ type
   public
     constructor Create;
     destructor Destroy; override;
-
     procedure Reset; override;
     
     function SaveDC: Integer;
@@ -91,6 +90,8 @@ type
     
     function BeginTextRender(AStr: PChar; ACount: Integer; out ALayout: ATSUTextLayout): Boolean;
     procedure EndTextRender(var ALayout: ATSUTextLayout);
+    
+    procedure SetAntialiasing(AValue: Boolean);
   public
     property Size: TPoint read GetSize;
 
@@ -411,7 +412,7 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  Name:    TCarbonDeviceContext.EndTextRender
+  Method:  TCarbonDeviceContext.EndTextRender
   Params:  ALayout - ATSU layout
   Returns: Nothing
 
@@ -426,6 +427,17 @@ begin
   if ALayout <> nil then ATSUDisposeTextLayout(ALayout);
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonDeviceContext.SetAntialiasing
+  Params:  AValue - If should antialias
+
+  Sets whether device context should antialias
+ ------------------------------------------------------------------------------}
+procedure TCarbonDeviceContext.SetAntialiasing(AValue: Boolean);
+begin
+  CGContextSetShouldAntialias(CGContext, CBool(AValue));
+end;
+
 { TCarbonScreenContext }
 
 function TCarbonScreenContext.GetSize: TPoint;

lcl/interfaces/carbon/carbongdiobjects.pp

@@ -560,7 +560,10 @@ begin
 
   FDataSize := FBytesPerRow * FHeight;
   System.GetMem(FData, FDataSize);
-  if AData <> nil then System.Move(AData^, FData^, FDataSize); // copy data
+  if AData <> nil then
+    System.Move(AData^, FData^, FDataSize) // copy data
+  else
+    FillDWord(FData^, FDataSize shr 2, 0); // clear bitmap
 
 //DebugLn(Format('TCarbonBitmap.Create %d x %d Data: %d RowSize: %d Size: %d',
 //  [AWidth, AHeight, Integer(AData), DataRowSize, FDataSize]));
@@ -804,7 +807,10 @@ end;
 
 procedure TCarbonCursor.Install;
 begin
-  DebugLn('TCarbonCursor.Install type: ', IntToStr(Ord(CursorType)));
+  {$IFDEF VerboseCursor}
+    DebugLn('TCarbonCursor.Install type: ', DbgS(Ord(CursorType)));
+  {$ENDIF}
+  
   case CursorType of
     cctQDHardware:
       if FQDHardwareCursorName <> '' then

lcl/interfaces/carbon/carbonint.pas

@@ -32,6 +32,21 @@ interface
 {$ASSERTIONS ON}
 {$endif}
 
+// Show debug info when tracing:
+
+{off $DEFINE DebugEventLoop}
+
+{off $DEFINE VerboseObject}    // Carbon object
+{off $DEFINE VerboseTimer}
+{off $DEFINE VerboseWinAPI}    // Carbon WinAPI
+{off $DEFINE VerboseLCLIntf}   // Carbon LCLIntf
+{off $DEFINE VerboseMouse}
+{off $DEFINE VerboseCursor}    // Carbon cursor
+{off $DEFINE VerboseKeyboard}
+{off $DEFINE VerbosePaint}
+
+{off $DEFINE VerboseWSClass}       // Carbon WS class
+
 uses
  // rtl+ftl
   Types, Classes, SysUtils, Math, FPCAdds,
@@ -72,6 +87,7 @@ type
     procedure AppRestore; override;
     procedure AppBringToFront; override;
     function  WidgetSetName: string; override;
+    procedure AttachMenuToWindow(AMenuObject: TComponent); Override;
     
     function  DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
     procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
@@ -123,13 +139,14 @@ uses
 // CarbonWSGrids,
 // CarbonWSImgList,
 // CarbonWSMaskEdit,
-// CarbonWSMenus,
+  CarbonWSMenus,
 // CarbonWSPairSplitter,
 // CarbonWSSpin,
   CarbonWSStdCtrls,
 // CarbonWSToolwin,
 ////////////////////////////////////////////////////
   CarbonDef, CarbonPrivate, CarbonProc, CarbonCanvas, CarbonGDIObjects,
+  CarbonMenus,
   Buttons, StdCtrls, PairSplitter, ComCtrls, CListBox, Calendar, Arrow,
   Spin, CommCtrl, ExtCtrls, FileCtrl, LResources;
 

lcl/interfaces/carbon/carbonlclintf.inc

@@ -30,10 +30,19 @@
 
 //##apiwiz##sps##   // Do not remove
 
+{------------------------------------------------------------------------------
+  Method:  CreateStandardCursor
+  Params:  ACursor - Cursor type
+  Returns: Cursor object in Carbon for the specified cursor type
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.CreateStandardCursor(ACursor: SmallInt): hCursor;
 var
   AThemeCursor: ThemeCursor;
 begin
+  {$IFDEF VerboseLCLIntf}
+    DebugLn('TCarbonWidgetSet.CreateStandardCursor ACursor: ' + DbgS(ACursor));
+  {$ENDIF}
+  
   Result := 0;
   if (ACursor >= crLow) and (ACursor <= crHigh) then
   begin
@@ -41,6 +50,10 @@ begin
     if AThemeCursor <> kThemeUndefCursor then
       Result := hCursor(TCarbonCursor.CreateThemed(AThemeCursor));
   end;
+  
+  {$IFDEF VerboseLCLIntf}
+    DebugLn('TCarbonWidgetSet.CreateStandardCursor Result: ' + DbgS(Result));
+  {$ENDIF}
 end;
 
 function TCarbonWidgetSet.DrawSplitter(DC: HDC; const ARect: TRect;
@@ -71,9 +84,25 @@ begin
   Result:=inherited GetControlConstraints(Constraints);
 end;
 
+{------------------------------------------------------------------------------
+  Method:  GetLCLOwnerObject
+  Params:  Handle - Handle of window
+  Returns: LCL control which has the specified widget
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.GetLCLOwnerObject(Handle: HWnd): TObject;
 begin
-  Result:=inherited GetLCLOwnerObject(Handle);
+  {$IFDEF VerboseLCLIntf}
+    DebugLn('TCarbonWidgetSet.GetLCLOwnerObject Handle: ' + DbgS(Handle));
+  {$ENDIF}
+  
+  Result := nil;
+  if not CheckWidget(Handle, 'TCarbonWidgetSet.GetLCLOwnerObject') then Exit;
+  
+  Result := TCarbonWidget(Handle).LCLObject;
+  
+  {$IFDEF VerboseLCLIntf}
+    DebugLn('TCarbonWidgetSet.GetLCLOwnerObject Result: ' + DbgS(Result));
+  {$ENDIF}
 end;
 
 function TCarbonWidgetSet.GetListBoxIndexAtY(ListBox: TComponent; y: integer
@@ -93,6 +122,20 @@ begin
   Result:=true;
 end;
 
+{------------------------------------------------------------------------------
+  Method:  PromptUser
+  Params:  DialogCaption - Dialog caption
+           DialogMessage - Dialog message text
+           DialogType    - Type of dialog
+           Buttons       - Pointer to button types
+           ButtonCount   - Count of passed buttons
+           DefaultIndex  - Index of default button
+           EscapeResult  - Result value of escape
+  Returns: The result value of pushed button
+  
+  Shows modal dialog with the specified caption, message and buttons and prompts
+  user to push one.
+ ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.PromptUser(const DialogCaption : string;
                                      const DialogMessage : string;
                                            DialogType    : LongInt;
@@ -129,7 +172,7 @@ const
   CancelKey = 'Cancel';
   YesKey    = 'Yes';
   NoKey     = 'No';
- {Note: Not using Pointer(kAlertDefaultOKText) or Pointer(kAlertDefaultCancelText)
+{ Note: Not using Pointer(kAlertDefaultOKText) or Pointer(kAlertDefaultCancelText)
   since this just passes in -1, which tells button to use its normal text and
   we need to override with Yes and No. If Localizable.strings file is in app 
   bundle's .lproj folder, will use localized strings for above keys if they
@@ -150,12 +193,35 @@ var
   AlertBtnIdx : DialogItemIndex;
 
 begin
+  {$IFDEF VerboseLCLIntf}
+    DebugLn('TCarbonWidgetSet.PromptUser DialogCaption: ' + DialogCaption +
+      ' DialogMessage: ' + DialogMessage + ' DialogType: ' + DbgS(DialogType) +
+      ' ButtonCount: ' + DbgS(ButtonCount) + ' DefaultIndex: ' +
+      DbgS(DefaultIndex) + ' EscapeResult: ' + DbgS(EscapeResult));
+  {$ENDIF}
+  
   Result := -1;
   
+  if (ButtonCount > 4) or ((ButtonCount = 4) and not HasButton(idButtonHelp)) then
+  begin
+    // if the button count is bigger than 3 + help button we can not use
+    // native alert
+    
+    {$IFDEF VerboseLCLIntf}
+      DebugLn('TCarbonWidgetSet.PromptUser Use LCL standard one.');
+    {$ENDIF}
+    
+    Result := inherited;
+
+    {$IFDEF VerboseLCLIntf}
+      DebugLn('TCarbonWidgetSet.PromptUser LCL Result: ' + DbgS(Result));
+    {$ENDIF}
+  end;
+
   {Initialize record}
   ParamRec.version := kStdCFStringAlertVersionOne;
   ParamRec.movable := True;
-  ParamRec.helpButton := False;
+  ParamRec.helpButton := HasButton(idButtonHelp);
   ParamRec.defaultText := nil;
   ParamRec.cancelText := nil;
   ParamRec.otherText := nil;
@@ -228,7 +294,6 @@ begin
   end;
 
   try
-    DebugLn('TCarbonWidgetSet.PromptUser: CreateStandardAlert');
     CreateStandardAlert(AlertCode, CaptionStr, MessageStr, @ParamRec, AlertRef);
     RunStandardAlert(AlertRef, nil, AlertBtnIdx);
 
@@ -250,6 +315,10 @@ begin
     FreeCFString(CaptionStr);
     FreeCFString(MessageStr);
   end;
+  
+  {$IFDEF VerboseLCLIntf}
+    DebugLn('TCarbonWidgetSet.PromptUser Result: ' + DbgS(Result));
+  {$ENDIF}
 end;  {TCarbonWidgetSet.PromptUser}
 
 function TCarbonWidgetSet.ReplaceBitmapMask(var Image, Mask: HBitmap;

lcl/interfaces/carbon/carbonobject.inc

@@ -60,8 +60,11 @@ function QuitEventHandler(inHandlerCallRef: EventHandlerCallRef;
 begin
   Result := CallNextEventHandler(inHandlerCallRef, inEvent);
   if Result <> noErr then Exit;
+  
   if (Widgetset <> nil) and TCarbonWidgetSet(Widgetset).FTerminating then Exit;
+
   TCarbonWidgetSet(Widgetset).FTerminating := True;
+
   if Application = nil then Exit;
   Application.Terminate;
 end;
@@ -163,6 +166,10 @@ procedure TCarbonWidgetSet.AppInit(var ScreenInfo: TScreenInfo);
 var
   ScreenDC: HDC;
 begin
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.AppInit');
+  {$ENDIF}
+  
   WakeMainThread := @OnWakeMainThread;
   
   // fill the screen info
@@ -194,6 +201,10 @@ var
   EventSpec: EventTypeSpec;
   CurMainEventQueue: EventQueueRef;
 begin
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.AppRun');
+  {$ENDIF}
+  
   DummyEvent := nil;
 
   // Create a UPP for EventLoopEventHandler and QuitEventHandler
@@ -259,6 +270,10 @@ begin
   finally
     DisposeEventHandlerUPP(EventLoopUPP);
   end;
+  
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.AppRun END');
+  {$ENDIF}
 end;
 
 {------------------------------------------------------------------------------
@@ -275,17 +290,24 @@ var
   CurEventClass: TEventInt;
   CurEventKind: TEventInt;
 begin
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.AppProcessMessages');
+  {$ENDIF}
+  
   Target := GetEventDispatcherTarget;
   CurEventClass.Chars[4] := #0;
   CurEventKind.Chars[4] := #0;
   repeat
-    if ReceiveNextEvent(0, nil, kEventDurationNoWait, True, Event) <> noErr then
+    if ReceiveNextEvent(0, nil, kEventDurationNoWait, True,
-      Break;
+      Event) <> noErr then Break;
+      
     CurEventClass.Int := GetEventClass(Event);
     CurEventKind.Int := GetEventKind(Event);
+
     {$IFDEF DebugEventLoop}
     DebugLn('EventClass: "',CurEventClass.Chars,'" EventKind: ',IntToStr(CurEventKind.Int));
     {$ENDIF}
+
     if CurEventClass.Chars=LCLCarbonEventClass then begin
       // internal carbon intf message
       if (CurEventKind.Chars=LCLCarbonEventKindWake) and IsMultiThread then
@@ -297,7 +319,12 @@ begin
 
     SendEventToEventTarget(Event, Target);
     ReleaseEvent(Event);
+    
   until Application.Terminated;
+  
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.AppProcessMessages END');
+  {$ENDIF}
 end;
 
 {------------------------------------------------------------------------------
@@ -311,9 +338,14 @@ procedure TCarbonWidgetSet.AppWaitMessage;
 var
   Event: EventRef;
 begin
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.AppWaitMessage');
+  {$ENDIF}
+  
   // Simply wait forever for the next event.
   // Don't pull it, so we can handle it later.
-  ReceiveNextEvent(0, nil, kEventDurationForever, False, Event);
+  OsError(ReceiveNextEvent(0, nil, kEventDurationForever, False, Event),
+    Self, 'AppWaitMessage', 'ReceiveNextEvent');
 end;
 
 {------------------------------------------------------------------------------
@@ -365,30 +397,43 @@ var
 begin
   if fMainEventQueue=nil then exit;
   
-  //DebuglnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage ');
+  {$IFDEF VerboseObject}
+    DebugLnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage ');
+  {$ENDIF}
+  
   EventSpec := MakeEventSpec(LCLCarbonEventClass,LCLCarbonEventKindWake);
   DummyEvent:=nil;
   try
     if CreateEvent(nil, EventSpec.eventClass, EventSpec.eventKind,
-                       0{GetCurrentEventTime}, kEventAttributeNone,
+      0{GetCurrentEventTime}, kEventAttributeNone, DummyEvent) <> noErr then
-                       DummyEvent) <> noErr
+    begin
-    then begin
+      {$IFDEF VerboseObject}
-      //DebuglnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage create event FAILED');
+        DebugLnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage Create event FAILED');
-      exit;
+      {$ENDIF}
+      
+      Exit;
     end;
     
-    //DebuglnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage GetMainEventQueue='+dbgs(GetMainEventQueue));
+    {$IFDEF VerboseObject}
+      DebugLnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage GetMainEventQueue='+dbgs(GetMainEventQueue));
+    {$ENDIF}
+
     if PostEventToQueue(fMainEventQueue, DummyEvent,
-                        kEventPriorityHigh) <> noErr
+      kEventPriorityHigh) <> noErr then
-    then begin
+    begin
-      //DebuglnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage post event FAILED');
+      {$IFDEF VerboseObject}
-      exit;
+        DebugLnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage Post event FAILED');
+      {$ENDIF}
+      
+      Exit;
     end;
   finally
-    if DummyEvent<>nil then
+    if DummyEvent <> nil then ReleaseEvent(DummyEvent);
-      ReleaseEvent(DummyEvent);
   end;
-  //DebuglnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage END');
+  
+  {$IFDEF VerboseObject}
+    DebugLnThreadLog('TCarbonWidgetSet.SendCheckSynchronizeMessage END');
+  {$ENDIF}
 end;
 
 {------------------------------------------------------------------------------
@@ -411,6 +456,10 @@ end;
 procedure TCarbonWidgetSet.AppTerminate;
 begin
   if FTerminating then Exit;
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.AppTerminate');
+  {$ENDIF}
+  
   QuitApplicationEventLoop;
 end;
 
@@ -423,7 +472,11 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCarbonWidgetSet.AppMinimize;
 begin
-  CollapseAllWindows(True);
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.AppMinimize');
+  {$ENDIF}
+  
+  OSError(CollapseAllWindows(True), Self, 'AppMinimize', 'CollapseAllWindows');
 end;
 
 {------------------------------------------------------------------------------
@@ -435,7 +488,11 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCarbonWidgetSet.AppRestore;
 begin
-  CollapseAllWindows(False);
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.AppRestore');
+  {$ENDIF}
+
+  OSError(CollapseAllWindows(False), Self, 'AppRestore', 'CollapseAllWindows');
 end;
 
 {------------------------------------------------------------------------------
@@ -448,13 +505,19 @@ end;
 procedure TCarbonWidgetSet.AppBringToFront;
 var
   Proc: ProcessSerialNumber;
+const AName = 'AppBringToFront';
 begin
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.AppBringToFront');
+  {$ENDIF}
+  
   (*
     According to Carbon Development Tips & Tricks:
     34. How do I bring all my windows to the front?
   *)
 
-  if GetCurrentProcess(Proc) = noErr then SetFrontProcess(Proc);
+  if OSError(GetCurrentProcess(Proc), Self, AName, 'GetCurrentProcess') then Exit;
+  OSError(SetFrontProcess(Proc), Self, AName, 'SetFrontProcess');
 end;
 
 {------------------------------------------------------------------------------
@@ -467,24 +530,51 @@ begin
   Result := 'carbon';
 end;
 
+{------------------------------------------------------------------------------
+  Method:  TCarbonWidgetSet.AttachMenuToWindow
+  Params:  AMenuObject - Menu
+
+  Attaches the menu of window to menu bar
+  TODO: change menu on activation
+ ------------------------------------------------------------------------------}
+procedure TCarbonWidgetSet.AttachMenuToWindow(AMenuObject: TComponent);
+begin
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.AttachMenuToWindow ' + AMenuObject.Name);
+  {$ENDIF}
+  
+  if (AMenuObject is TMainMenu) and (TMainMenu(AMenuObject).Handle <> 0) then
+  begin
+    if not CheckMenu(TMainMenu(AMenuObject).Handle,
+      'TCarbonWidgetSet.AttachMenuToWindow') then Exit;
+      
+    TCarbonMenu(TMainMenu(AMenuObject).Handle).AttachToMenuBar;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonWidgetSet.DCGetPixel
-  Params:  CanvasHandle - canvas handle to get color from
+  Params:  CanvasHandle - Canvas handle to get color from
-           X, Y         - position
+           X, Y         - Position
   Returns: Color of the specified pixel on the canvas
   Not implemented!
  ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.DCGetPixel(CanvasHandle: HDC; X, Y: integer
   ): TGraphicsColor;
 begin
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.DCGetPixel DC: ' + DbgS(CanvasHandle) + ' X: ' + DbgS(X) + ' Y: ' + DbgS(Y));
+  {$ENDIF}
+  
+  DebugLn('TCarbonWidgetSet.DCGetPixel TODO');
   Result := clNone;
 end;
 
 {------------------------------------------------------------------------------
   Method:  TCarbonWidgetSet.DCSetPixel
-  Params:  CanvasHandle - canvas handle to get color from
+  Params:  CanvasHandle - Canvas handle to get color from
-           X, Y         - position
+           X, Y         - Position
-           AColor       - new color for specified position
+           AColor       - New color for specified position
   Returns: Nothing
 
   Sets the color of the specified pixel on the canvas
@@ -493,29 +583,34 @@ end;
 procedure TCarbonWidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: integer;
   AColor: TGraphicsColor);
 begin
+  {$IFDEF VerboseObject}
+    DebugLn('TCarbonWidgetSet.DCSetPixel DC: ' + DbgS(CanvasHandle) + ' X: ' + DbgS(X) + ' Y: ' + DbgS(Y) + 'Color: ' + DbgS(AColor));
+  {$ENDIF}
   
+  DebugLn('TCarbonWidgetSet.DCSetPixel TODO');
 end;
 
 {------------------------------------------------------------------------------
   Method:  TCarbonWidgetSet.DCReDraw
-  Params:  CanvasHandle - canvas handle to redraw
+  Params:  CanvasHandle - Canvas handle to redraw
   Returns: Nothing
 
   Redraws (the window of) a canvas
  ------------------------------------------------------------------------------}
 procedure TCarbonWidgetSet.DCRedraw(CanvasHandle: HDC);
-var
-  ADC: TCarbonControlContext;
 begin
-  if not (TObject(CanvasHandle) is TCarbonControlContext) then Exit;
+  {$IFDEF VerboseObject}
-  ADC := TCarbonControlContext(CanvasHandle);
+    DebugLn('TCarbonWidgetSet.DCRedraw DC: ' + DbgS(CanvasHandle));
+  {$ENDIF}
   
-  CGContextFlush(ADC.CGContext);
+  if not CheckDC(CanvasHandle, 'DCRedraw') then Exit;
+  
+  CGContextFlush(TCarbonContext(CanvasHandle).CGContext);
 end;
 
 {------------------------------------------------------------------------------
   Method:  TCarbonWidgetSet.SetDesigning
-  Params:  AComponent - component to set designing
+  Params:  AComponent - Component to set designing
   Returns: Nothing
 
   Not implemented!
@@ -541,8 +636,8 @@ end;
 
 {------------------------------------------------------------------------------
   Method:  TimerCallback
-  Params:  inTimer    - timer reference
+  Params:  inTimer    - Timer reference
-           inUserData - user data passed when installing timer
+           inUserData - User data passed when installing timer
   Returns: Nothing
 
   Calls the timer function associated with specified timer
@@ -551,15 +646,25 @@ procedure TimerCallback(inTimer: EventLoopTimerRef; inUserData: UnivPtr);
 var
   TimerFunc: TFNTimerProc;
 begin
+  {$IFDEF VerboseTimer}
+    DebugLn('TimerCallback');
+  {$ENDIF}
+  
   if CarbonWidgetSet = nil then Exit;
-  if CarbonWidgetSet.FTimerMap.GetData(inTimer, TimerFunc)
+  if CarbonWidgetSet.FTimerMap.GetData(inTimer, TimerFunc) then
-  then TimerFunc;
+  begin
+    {$IFDEF VerboseTimer}
+      DebugLn('TimerCallback Timer instaåled, calling func.');
+    {$ENDIF}
+    
+    TimerFunc;
+  end;
 end;
 
 {------------------------------------------------------------------------------
   Method:  TCarbonWidgetSet.CreateTimer
-  Params:  Interval  - new timer interval
+  Params:  Interval  - New timer interval
-           TimerFunc - new timer callback
+           TimerFunc - New timer callback
   Returns: A Timer id
 
   Creates new timer with specified interval and callback function
@@ -568,17 +673,25 @@ function TCarbonWidgetSet.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc
 var
   Timer: EventLoopTimerRef;
 begin
+  {$IFDEF VerboseTimer}
+    DebugLn('TCarbonWidgetSet.CreateTimer Interval: ' + DbgS(Interval));
+  {$ENDIF}
   Result := 0;
+  
   if (Interval > 0) and (TimerFunc <> nil) then
   begin
-    if InstallEventLoopTimer(GetMainEventLoop,
+    if OSError(InstallEventLoopTimer(GetMainEventLoop,
       Interval / 1000, Interval / 1000, // converts msec -> sec
-      EventLoopTimerUPP(@TimerCallback), nil, Timer) = noErr then
+      EventLoopTimerUPP(@TimerCallback), nil, Timer), Self,
-    begin
+      'CreateTimer', 'InstallEventLoopTimer') then Exit;
+      
     FTimerMap.Add(Timer, TimerFunc);
-      Result := THandle(Timer);
+    Result := THandle(Timer)
-    end;
   end;
+  
+  {$IFDEF VerboseTimer}
+    DebugLn('TCarbonWidgetSet.CreateTimer Result: ' + DbgS(Result));
+  {$ENDIF}
 end;
 
 {------------------------------------------------------------------------------
@@ -590,7 +703,13 @@ end;
  ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.DestroyTimer(TimerHandle: THandle): boolean;
 begin
+  {$IFDEF VerboseTimer}
+    DebugLn('TCarbonWidgetSet.DestroyTimer Handle: ' + DbgS(TimerHandle));
+  {$ENDIF}
+
   Result := FTimerMap.Delete(TimerHandle);
-  if Result // valid timer
+  
-  then RemoveEventLoopTimer(EventLoopTimerRef(TimerHandle));
+  if Result then // valid timer
+    OSError(RemoveEventLoopTimer(EventLoopTimerRef(TimerHandle)), Self,
+      'DestroyTimer', 'RemoveEventLoopTimer');
 end;

lcl/interfaces/carbon/carbonprivate.pp

@@ -88,7 +88,7 @@ type
   public
   { Frame:
      = widget in controls without special frame control
-     - frame area control of control or window
+     - frame area control of control
      - determines bounds of control
      - processes only bounds changed event            }
     property Frame: ControlRef read GetFrame;
@@ -126,6 +126,13 @@ type
     function Update: Boolean; override;
   end;
   
+  { TCarbonHintWindow }
+
+  TCarbonHintWindow = class(TCarbonWindow)
+  protected
+    procedure CreateWidget(const AParams: TCreateParams); override;
+  end;
+
   { TCarbonCustomControl }
 
   TCarbonCustomControl = class(TCarbonControl)
@@ -365,6 +372,28 @@ var SavedMouseUpMsg: TLMMouse;
 {$I carbonprivatecontrol.inc}
 {$I carbonprivatewindow.inc}
 
+{ TCarbonHintWindow }
+
+procedure TCarbonHintWindow.CreateWidget(const AParams: TCreateParams);
+var
+  Window: WindowRef;
+  MinSize, MaxSize: HISize;
+begin
+  if CreateNewWindow(kHelpWindowClass,
+    kWindowCompositingAttribute or
+    kWindowHideOnSuspendAttribute or kWindowStandardHandlerAttribute,
+    ParamsToCarbonRect(AParams), Window) = noErr then
+  begin
+    Widget := Window;
+
+    SetWindowProperty(Widget, LAZARUS_FOURCC, WIDGETINFO_FOURCC, SizeOf(Self), @Self);
+    SetControlProperty(Content, LAZARUS_FOURCC, WIDGETINFO_FOURCC, SizeOf(Self), @Self);
+  end
+  else RaiseCreateWidgetError(LCLObject);
+  
+  SetColor(LCLObject.Color);
+end;
+
 { TCarbonCustomControl }
 
 procedure TCarbonCustomControl.CreateWidget(const AParams: TCreateParams);
@@ -1419,5 +1448,6 @@ begin
 end;
 
 
+
 end.
 

lcl/interfaces/carbon/carbonprivatecommon.inc

@@ -245,3 +245,134 @@ begin
     end;
   end;
 end;
+
+function CarbonCommon_ContextualMenuClick(ANextHandler: EventHandlerCallRef;
+  AEvent: EventRef;
+  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
+var
+  Msg: TLMMouse;
+  P: TPoint;
+begin
+  DebugLn('CarbonCommon_ContextualMenuClick: ', DbgSName(AWidget.LCLObject));
+  // Result := CallNextEventHandler(ANextHandler, AEvent);
+
+  P := AWidget.GetMousePos;
+  
+  DebugLn('CarbonCommon_ContextualMenuClick: ', DbgS(P));
+
+  FillChar(Msg, SizeOf(TLMMouse), 0);
+  Msg.Msg := LM_CONTEXTMENU;
+  Msg.Pos.X := P.X;
+  Msg.Pos.Y := P.Y;
+  
+  DeliverMessage(AWidget.LCLObject, Msg);
+  Result := noErr; // do not propagate
+end;
+
+function CarbonCommon_SetFocusPart(ANextHandler: EventHandlerCallRef;
+  AEvent: EventRef;
+  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
+var
+  FocusPart: ControlPartCode;
+begin
+  Result := CallNextEventHandler(ANextHandler, AEvent);
+
+  if GetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode, nil,
+    SizeOf(ControlPartCode), nil, @FocusPart) <> noErr then Exit;
+
+  DebugLn('CarbonCommon_SetFocusPart: ', DbgSName(AWidget.LCLObject), ' ' +
+    IntToStr(Integer(FocusPart)));
+
+  if FocusPart <> kControlFocusNoPart then
+    LCLSendSetFocusMsg(AWidget.LCLObject)
+  else
+    LCLSendKillFocusMsg(AWidget.LCLObject);
+end;
+
+function CarbonCommon_GetNextFocusCandidate(ANextHandler: EventHandlerCallRef;
+  AEvent: EventRef;
+  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
+var
+  StartControl, NextControl: ControlRef;
+  FocusPart: ControlPartCode;
+  TabIndex: Integer;
+  TabList: TFPList;
+  AControl: TCarbonWidget;
+begin
+  DebugLn('CarbonCommon_GetNextFocusCandidate: ', DbgSName(AWidget.LCLObject));
+  //Result := CallNextEventHandler(ANextHandler, AEvent);
+  
+  if GetEventParameter(AEvent, kEventParamStartControl, typeControlRef, nil,
+    SizeOf(ControlRef), nil, @StartControl) <> noErr then Exit;
+  if GetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode, nil,
+    SizeOf(ControlPartCode), nil, @FocusPart) <> noErr then Exit;
+  
+  TabIndex := 0;
+  TabList := TFPList.Create;
+  try
+    (AWidget.LCLObject.GetTopParent as TWinControl).GetTabOrderList(TabList);
+    AControl := GetCarbonWidget(StartControl);
+    
+    if AControl <> nil then
+    begin
+      TabIndex := TabList.IndexOf(AControl.LCLObject);
+      if TabIndex >= 0 then
+      begin
+        if FocusPart = kControlFocusNextPart then
+        begin
+          Inc(TabIndex);
+          if TabIndex >= TabList.Count then TabIndex := 0;
+        end
+        else
+        begin
+          Dec(TabIndex);
+          if TabIndex < 0 then TabIndex := TabList.Count - 1;
+        end;
+      end
+      else TabIndex := 0;
+    end;
+    
+    if TabIndex < TabList.Count then
+      NextControl := AsControlRef(TWinControl(TabList[TabIndex]).Handle)
+    else
+      NextControl := nil;
+    
+    OSError(SetEventParameter(AEvent, kEventParamNextControl, typeControlRef,
+        SizeOf(ControlRef), @NextControl), 'CarbonCommon_GetNextFocusCandidate',
+        'SetEventParameter');
+  finally
+    TabList.Free;
+  end;
+  
+  Result := noErr;
+end;
+
+function CarbonCommon_SetCursor(ANextHandler: EventHandlerCallRef;
+  AEvent: EventRef;
+  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
+var
+{
+  Msg: TLMessage;
+}
+  ACursor: TCursor;
+begin
+  // too much messages in terminal
+  // DebugLn('CarbonCommon_SetCursor: ', AWidget.LCLObject.Name);
+  CallNextEventHandler(ANextHandler, AEvent);
+
+{
+  Paul Ishenin: maybe we should ask control about it cursor via LM_SetCursor ???
+
+  FillChar(Msg, SizeOf(Msg), 0);
+  Msg.msg := LM_SETCURSOR;
+  DeliverMessage(AWidget.LCLObject, Msg);
+}
+
+  ACursor := Screen.Cursor;
+  if ACursor = crDefault then
+  begin
+    ACursor := AWidget.LCLObject.Cursor;
+  end;
+  WidgetSet.SetCursor(Screen.Cursors[ACursor]);
+  Result := noErr; // cursor was setted
+end;

lcl/interfaces/carbon/carbonprivatecontrol.inc

@@ -19,62 +19,6 @@
 // H A N D L E R S 
 // ==================================================================
 
-function CarbonControl_SetFocusPart(ANextHandler: EventHandlerCallRef;
-  AEvent: EventRef;
-  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
-  //Focus: ControlTypeCode;
-begin
-  DebugLn('CarbonControl_SetFocusPart: ', DbgSName(AWidget.LCLObject));
-  Result := CallNextEventHandler(ANextHandler, AEvent);
-  
-  {if GetEventParameter(AEvent, kEventParamControlPart, typeControlPartCode, nil,
-                      SizeOf(Boolean), nil, @Focus) <> noErr then Focus := kControlFocusNoPart;
-                      
-  
-  FillChar(Msg, SizeOf(Msg), 0);
-  if Focus then Msg.msg := LM_SETFOCUS
-  else Msg.msg := LM_FILLFOCUS;
-  DeliverMessage(AWidget.LCLObject, Msg);}
-end;
-
-function CarbonControl_GetNextFocusCandidate(ANextHandler: EventHandlerCallRef;
-  AEvent: EventRef;
-  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
-begin
-  DebugLn('CarbonControl_GetNextFocusCandidate: ', DbgSName(AWidget.LCLObject));
-  Result := CallNextEventHandler(ANextHandler, AEvent);
-end;
-
-function CarbonControl_SetCursor(ANextHandler: EventHandlerCallRef;
-  AEvent: EventRef;
-  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
-var
-{
-  Msg: TLMessage;
-}
-  ACursor: TCursor;
-begin
-  // too much messages in terminal
-  // DebugLn('PrivateHiView_SetCursor: ', AWidget.LCLObject.Name);
-  CallNextEventHandler(ANextHandler, AEvent);
-  
-{
-  Paul Ishenin: maybe we should ask control about it cursor via LM_SetCursor ???
-  
-  FillChar(Msg, SizeOf(Msg), 0);
-  Msg.msg := LM_SETCURSOR;
-  DeliverMessage(AWidget.LCLObject, Msg);
-}
-
-  ACursor := Screen.Cursor;
-  if ACursor = crDefault then
-  begin
-    ACursor := AWidget.LCLObject.Cursor;
-  end;
-  WidgetSet.SetCursor(Screen.Cursors[ACursor]);
-  Result := noErr; // cursor was setted
-end;
-
 {------------------------------------------------------------------------------
   Name: CarbonControl_Hit
   Handles click and LM_MOUSEUP events
@@ -226,6 +170,11 @@ begin
     RegisterEventHandler(@CarbonCommon_BoundsChanged),
     1, @TmpSpec, Pointer(Self), nil);
     
+  TmpSpec := MakeEventSpec(kEventClassControl, kEventControlContextualMenuClick);
+  InstallControlEventHandler(Widget,
+    RegisterEventHandler(@CarbonCommon_ContextualMenuClick),
+    1, @TmpSpec, Pointer(Self), nil);
+    
   TmpSpec := MakeEventSpec(kEventClassControl, kEventControlTrack);
   InstallControlEventHandler(Widget,
     RegisterEventHandler(@CarbonCommon_Track),
@@ -240,19 +189,19 @@ begin
   end;
 
   TmpSpec := MakeEventSpec(kEventClassControl, kEventControlSetFocusPart);
-  InstallControlEventHandler(Widget,
+  InstallControlEventHandler(Content,
-    RegisterEventHandler(@CarbonControl_SetFocusPart),
+    RegisterEventHandler(@CarbonCommon_SetFocusPart),
     1, @TmpSpec, Pointer(Self), nil);
 
   TmpSpec := MakeEventSpec(kEventClassControl, kEventControlGetNextFocusCandidate);
-  InstallControlEventHandler(Widget,
+  InstallControlEventHandler(Content,
-    RegisterEventHandler(@CarbonControl_GetNextFocusCandidate),
+    RegisterEventHandler(@CarbonCommon_GetNextFocusCandidate),
     1, @TmpSpec, Pointer(Self), nil);
     
 // cursor set
   TmpSpec := MakeEventSpec(kEventClassControl, kEventControlSetCursor);
   InstallControlEventHandler(Widget,
-    RegisterEventHandler(@CarbonControl_SetCursor),
+    RegisterEventHandler(@CarbonCommon_SetCursor),
     1, @TmpSpec, Pointer(Self), nil);
 
   if cceHit in Events then
@@ -307,13 +256,16 @@ begin
 
   UnregisterEventHandler(@CarbonCommon_Dispose);
   UnregisterEventHandler(@CarbonCommon_Draw);
+  UnregisterEventHandler(@CarbonCommon_BoundsChanged);
+  UnregisterEventHandler(@CarbonCommon_ContextualMenuClick);
   UnregisterEventHandler(@CarbonCommon_Track);
   if Content <> ControlRef(Widget) then
     UnregisterEventHandler(@CarbonCommon_Track);
-  UnregisterEventHandler(@CarbonCommon_BoundsChanged);
+    
-  UnregisterEventHandler(@CarbonControl_SetFocusPart);
+  UnregisterEventHandler(@CarbonCommon_SetFocusPart);
-  UnregisterEventHandler(@CarbonControl_GetNextFocusCandidate);
+  UnregisterEventHandler(@CarbonCommon_GetNextFocusCandidate);
-  UnregisterEventHandler(@CarbonControl_SetCursor);
+  UnregisterEventHandler(@CarbonCommon_SetCursor);
+  
   if cceHit in Events then
     UnregisterEventHandler(@CarbonControl_Hit);
   if cceValueChanged in Events then
@@ -413,22 +365,18 @@ end;
 
 function TCarbonControl.GetScreenBounds(var ARect: TRect): Boolean;
 var
-  BoundsHIRect: HIRect;
+  BoundsRect: HIRect;
-  BoundsRect: TRect;
   WindowRect: FPCMacOSAll.Rect;
 begin
   Result := False;
 
-  if not GetBounds(BoundsRect) then Exit;
+  if HIViewGetBounds(Frame, BoundsRect) <> noErr then Exit;
-  OffsetRect(BoundsRect, -BoundsRect.Left, -BoundsRect.Left);
+  if HIViewConvertRect(BoundsRect, Frame, nil) <> noErr then Exit;
-  
-  BoundsHIRect := RectToCGRect(BoundsRect);
-  if HIViewConvertRect(BoundsHIRect, Frame, nil) <> noErr then Exit;
   
   if GetWindowBounds(GetTopParentWindow, kWindowStructureRgn,
     WindowRect) <> noErr then Exit;
     
-  ARect := CGRectToRect(BoundsHIRect);
+  ARect := CGRectToRect(BoundsRect);
   OffsetRect(ARect, WindowRect.left, WindowRect.top);
 
   Result := True;

lcl/interfaces/carbon/carbonprivatewindow.inc

@@ -258,6 +258,8 @@ begin
   else
     // the LCL does not want the event propagated
     Result := noErr;
+    
+  NotifyApplicationUserInput(Msg.Message.Msg);
 end;
 
 function CarbonWindow_KeyboardProc(ANextHandler: EventHandlerCallRef;
@@ -787,6 +789,27 @@ begin
     RegisterEventHandler(@CarbonCommon_BoundsChanged),
     1, @TmpSpec, Pointer(Self), nil);
 
+  TmpSpec := MakeEventSpec(kEventClassControl, kEventControlContextualMenuClick);
+  InstallControlEventHandler(Content,
+    RegisterEventHandler(@CarbonCommon_ContextualMenuClick),
+    1, @TmpSpec, Pointer(Self), nil);
+    
+  TmpSpec := MakeEventSpec(kEventClassControl, kEventControlSetFocusPart);
+  InstallControlEventHandler(Content,
+    RegisterEventHandler(@CarbonCommon_SetFocusPart),
+    1, @TmpSpec, Pointer(Self), nil);
+
+  TmpSpec := MakeEventSpec(kEventClassControl, kEventControlGetNextFocusCandidate);
+  InstallControlEventHandler(Content,
+    RegisterEventHandler(@CarbonCommon_GetNextFocusCandidate),
+    1, @TmpSpec, Pointer(Self), nil);
+    
+  // cursor set
+  TmpSpec := MakeEventSpec(kEventClassControl, kEventControlSetCursor);
+  InstallControlEventHandler(Content,
+    RegisterEventHandler(@CarbonCommon_SetCursor),
+    1, @TmpSpec, Pointer(Self), nil);
+	
   // cursor change
   TmpSpec := MakeEventSpec(kEventClassWindow, kEventWindowCursorChange);
   InstallWindowEventHandler(Widget,
@@ -809,6 +832,10 @@ begin
   UnregisterEventHandler(@CarbonCommon_Draw);
   UnregisterEventHandler(@CarbonCommon_Track);
   UnregisterEventHandler(@CarbonCommon_BoundsChanged);
+  UnregisterEventHandler(@CarbonCommon_ContextualMenuClick);
+  UnregisterEventHandler(@CarbonCommon_SetFocusPart);
+  UnregisterEventHandler(@CarbonCommon_GetNextFocusCandidate);
+  UnregisterEventHandler(@CarbonCommon_SetCursor);
   UnregisterEventHandler(@CarbonCommon_CursorChange);
 end;
 

lcl/interfaces/carbon/carbonproc.pp

@@ -25,32 +25,38 @@
 }
 
 unit CarbonProc;
+
 {$mode objfpc}{$H+}
 
 interface
 
 uses
-  FPCMacOSAll, Classes, LCLType, LCLProc, LCLClasses, LMessages,
+  FPCMacOSAll, Classes, Types, LCLType, LCLProc, LCLClasses, LMessages,
   Controls, Forms, Avl_Tree, SysUtils, Graphics, Math, GraphType,
-  CarbonDef, CarbonPrivate;
+  CarbonDef, CarbonPrivate, CarbonMenus;
-  
-type
-  TConvertResult = (trNoError, trNullSrc, trNullDest, trDestExhausted,
-    trInvalidChar, trUnfinishedChar);
-
-  TConvertOption = (toInvalidCharError, toInvalidCharToSymbol,
-    toUnfinishedCharError, toUnfinishedCharToSymbol);
-  TConvertOptions = set of TConvertOption;
-  
-function UTF8ToUTF16(const S: UTF8String): WideString;
 
 function AsControlRef(Handle: HWND): ControlRef; inline;
 function AsWindowRef(Handle: HWND): WindowRef; inline;
+function AsMenuRef(Handle: HMENU): MenuRef; inline;
 
-function CheckWidget(const Handle: HWND; const DbgText: String; AName: String = ''): Boolean;
+function CheckHandle(const AWinControl: TWinControl; const AClass: TClass; const DbgText: String): Boolean;
-function CheckDC(const DC: HDC; const DbgText: String; AName: String = ''): Boolean;
+
-function CheckGDIObject(const GDIObject: HGDIOBJ; const DbgText: String; AName: String = ''): Boolean;
+function CheckWidget(const Handle: HWND; const AMethodName: String; AParamName: String = ''): Boolean;
-function CheckBitmap(const Bitmap: HBITMAP; const DbgText: String; AName: String = ''): Boolean;
+function CheckMenu(const Menu: HMENU; const AMethodName: String; AParamName: String = ''): Boolean;
+
+function CheckDC(const DC: HDC; const AMethodName: String; AParamName: String = ''): Boolean;
+function CheckGDIObject(const GDIObject: HGDIOBJ; const AMethodName: String; AParamName: String = ''): Boolean;
+function CheckBitmap(const Bitmap: HBITMAP; const AMethodName: String; AParamName: String = ''): Boolean;
+function CheckCursor(const Cursor: HCURSOR; const AMethodName: String; AParamName: String = ''): Boolean;
+
+function OSError(AResult: OSStatus; const AMethodName, ACallName: String;
+  const AText: String = ''): Boolean;// inline;
+function OSError(AResult: OSStatus; const AObject: TObject; const AMethodName, ACallName: String;
+  const AText: String = ''): Boolean;// inline;
+function OSError(AResult: OSStatus; const AClass: TClass; const AMethodName, ACallName: String;
+  const AText: String = ''): Boolean;// inline;
+function OSError(AResult: OSStatus; const AObject: TObject; const AMethodName, ACallName: String;
+  const AText: String; AValidResult: OSStatus): Boolean;// inline;
 
 function GetCarbonWidget(AWidget: Pointer): TCarbonWidget;
 function GetCarbonWindow(AWidget: WindowRef): TCarbonWindow;
@@ -75,7 +81,13 @@ function GetCarbonRect(Left, Top, Width, Height: Integer): FPCMacOSAll.Rect;
 function GetCarbonRect(const ARect: TRect): FPCMacOSAll.Rect;
 function ParamsToCarbonRect(const AParams: TCreateParams): FPCMacOSAll.Rect;
 
+type
+  CGRectArray = Array of CGRect;
+
+function ExcludeRect(const A, B: TRect): CGRectArray;
+  
 function GetCGRect(X1, Y1, X2, Y2: Integer): CGRect;
+function GetCGRectSorted(X1, Y1, X2, Y2: Integer): CGRect;
 function RectToCGRect(const ARect: TRect): CGRect;
 function CGRectToRect(const ARect: CGRect): TRect;
 
@@ -86,6 +98,7 @@ function ColorToRGBColor(const AColor: TColor): RGBColor;
 function RGBColorToColor(const AColor: RGBColor): TColor; inline;
 function CreateCGColor(const AColor: TColor): CGColorRef;
 
+function Dbgs(const ASize: TSize): string; overload;
 function Dbgs(const ARect: FPCMacOSAll.Rect): string; overload;
 function Dbgs(const AColor: FPCMacOSAll.RGBColor): string; overload;
 
@@ -93,225 +106,6 @@ implementation
 
 uses CarbonInt, CarbonCanvas, CarbonGDIObjects;
 
-{------------------------------------------------------------------------------
-  Name:    ConvertUTF8ToUTF16
-  Params:  Dest                - Pointer to destination string
-           DestWideCharCount   - Wide char count allocated in destination string
-           Src                 - Pointer to source string
-           SrcCharCount        - Char count allocated in source string
-           Options             - Conversion options, if none is set, both
-             invalid and unfinished UTF-8 chars are skipped
-
-             toInvalidCharError       - Stop on invalid UTF-8 char and report
-                                      error
-             toInvalidCharToSymbol    - Replace invalid UTF-8 chars with '?'
-             toUnfinishedCharError    - Stop on unfinished UTF-8 char and report
-                                      error
-             toUnfinishedCharToSymbol - Replace unfinished UTF-8 char with '?'
-
-           ActualWideCharCount - Actual wide char count converted from source
-                               string to destination string
-  Returns:
-    trNoError        - The string was successfully converted without
-                     any error
-    trNullSrc        - Pointer to source string is nil
-    trNullDest       - Pointer to destination string is nil
-    trDestExhausted  - Destination buffer size is not big enough to hold
-                     converted string
-    trInvalidChar    - Invalid UTF-8 char has occured
-    trUnfinishedChar - Unfinished UTF-8 char has occured
-
-  Converts the specified UTF-8 encoded string to UTF-16 encoded
- ------------------------------------------------------------------------------}
-function ConvertUTF8ToUTF16(Dest: PWideChar; DestWideCharCount: SizeUInt;
-  Src: PChar; SrcCharCount: SizeUInt; Options: TConvertOptions;
-  out ActualWideCharCount: SizeUInt): TConvertResult;
-var
-  DestI, SrcI: SizeUInt;
-  B1, B2, B3, B4: Byte;
-  W: Word;
-  C: Cardinal;
-
-  function UnfinishedCharError: Boolean;
-  begin
-    if toUnfinishedCharToSymbol in Options then
-    begin
-      Dest[DestI] := System.WideChar('?');
-      Inc(DestI);
-      Result := False;
-    end
-    else
-      if toUnfinishedCharError in Options then
-      begin
-        ConvertUTF8ToUTF16 := trUnfinishedChar;
-        Result := True;
-      end
-      else Result := False;
-  end;
-
-  function InvalidCharError(Count: Integer): Boolean; inline;
-  begin
-    if toInvalidCharToSymbol in Options then
-    begin
-      Dest[DestI] := System.WideChar('?');
-      Inc(DestI);
-      Dec(SrcI, Count);
-      Result := False;
-    end
-    else
-      if toInvalidCharError in Options then
-      begin
-        ConvertUTF8ToUTF16 := trUnfinishedChar;
-        Result := True;
-      end
-      else
-      begin
-        Dec(SrcI, Count);
-        Result := False;
-      end;
-  end;
-
-begin
-  ActualWideCharCount := 0;
-
-  if not Assigned(Src) then
-  begin
-    Result := trNullSrc;
-    Exit;
-  end;
-
-  if not Assigned(Dest) then
-  begin
-    Result := trNullDest;
-    Exit;
-  end;
-  SrcI := 0;
-  DestI := 0;
-
-  while (DestI < DestWideCharCount) and (SrcI < SrcCharCount) do
-  begin
-    B1 := Byte(Src[SrcI]);
-    Inc(SrcI);
-
-    if B1 < 128 then // single byte UTF-8 char
-    begin
-      Dest[DestI] := System.WideChar(B1);
-      Inc(DestI);
-    end
-    else
-    begin
-      if SrcI >= SrcCharCount then
-        if UnfinishedCharError then Exit
-        else Break;
-
-      B2 := Byte(Src[SrcI]);
-      Inc(SrcI);
-
-      if (B1 and %11100000) = %11000000 then // double byte UTF-8 char
-      begin
-        if (B2 and %11000000) = %10000000 then
-        begin
-          Dest[DestI] := System.WideChar(((B1 and %00011111) shl 6) or (B2 and %00111111));
-          Inc(DestI);
-        end
-        else // invalid character, assume single byte UTF-8 char
-          if InvalidCharError(1) then Exit;
-      end
-      else
-      begin
-        if SrcI >= SrcCharCount then
-          if UnfinishedCharError then Exit
-          else Break;
-
-        B3 := Byte(Src[SrcI]);
-        Inc(SrcI);
-
-        if (B1 and %11110000) = %11100000 then // triple byte UTF-8 char
-        begin
-          if ((B2 and %11000000) = %10000000) and ((B3 and %11000000) = %10000000) then
-          begin
-            W := ((B1 and %00011111) shl 12) or ((B2 and %00111111) shl 6) or (B3 and %00111111);
-            if W < $D800 then // to single wide char UTF-16 char
-            begin
-              Dest[DestI] := System.WideChar(W);
-              Inc(DestI);
-            end
-            else // to double wide char UTF-16 char
-            begin
-              Dest[DestI] := System.WideChar($D800 or (W shr 10));
-              Inc(DestI);
-              if DestI >= DestWideCharCount then Break;
-              Dest[DestI] := System.WideChar($DC00 or (W and %0000001111111111));
-              Inc(DestI);
-            end;
-          end
-          else // invalid character, assume single byte UTF-8 char
-            if InvalidCharError(2) then Exit;
-        end
-        else
-        begin
-          if SrcI >= SrcCharCount then
-            if UnfinishedCharError then Exit
-            else Break;
-
-          B4 := Byte(Src[SrcI]);
-          Inc(SrcI);
-
-          if ((B1 and %11111000) = %11110000) and ((B2 and %11000000) = %10000000)
-            and ((B3 and %11000000) = %10000000) and ((B4 and %11000000) = %10000000) then
-          begin // 4 byte UTF-8 char
-            C := ((B1 and %00011111) shl 18) or ((B2 and %00111111) shl 12)
-              or ((B3 and %00111111) shl 6)  or (B4 and %00111111);
-            // to double wide char UTF-16 char
-            Dest[DestI] := System.WideChar($D800 or (C shr 10));
-            Inc(DestI);
-            if DestI >= DestWideCharCount then Break;
-            Dest[DestI] := System.WideChar($DC00 or (C and %0000001111111111));
-            Inc(DestI);
-          end
-          else // invalid character, assume single byte UTF-8 char
-            if InvalidCharError(3) then Exit;
-        end;
-      end;
-    end;
-  end;
-
-  if DestI >= DestWideCharCount then
-  begin
-    DestI := DestWideCharCount - 1;
-    Result := trDestExhausted;
-  end
-  else
-    Result := trNoError;
-
-  Dest[DestI] := #0;
-  ActualWideCharCount := DestI + 1;
-end;
-
-{------------------------------------------------------------------------------
-  Name:    UTF8ToUTF16
-  Params:  S - Source UTF-8 string
-  Returns: UTF-16 encoded string
-
-  Converts the specified UTF-8 encoded string to UTF-16 encoded
- ------------------------------------------------------------------------------}
-function UTF8ToUTF16(const S: UTF8String): WideString;
-var
-  L: SizeUInt;
-  R: WideString;
-begin
-  Result := '';
-  if S = '' then Exit;
-
-  SetLength(R, Length(S)); // bytes of UTF-8 string >= wide chars of UTF-16
-  if ConvertUTF8ToUTF16(PWideChar(R), Length(R) + 1, PChar(S), Length(S),
-    [toInvalidCharToSymbol], L) = trNoError then
-  begin
-    SetLength(R, L - 1);
-    Result := R;
-  end;
-end;
-
 {------------------------------------------------------------------------------
   Name:    AsControlRef
   Params:  Handle  - Handle of window control
@@ -323,7 +117,7 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  Name:    AsControlRef
+  Name:    AsWindowRef
   Params:  Handle  - Handle of window
   Returns: Carbon window
  ------------------------------------------------------------------------------}
@@ -332,20 +126,99 @@ begin
   Result := WindowRef(TCarbonWindow(Handle).Widget);
 end;
 
+{------------------------------------------------------------------------------
+  Name:    AsMenuRef
+  Params:  Handle  - Handle of menu
+  Returns: Carbon menu
+ ------------------------------------------------------------------------------}
+function AsMenuRef(Handle: HMENU): MenuRef; inline;
+begin
+  Result := TCarbonMenu(Handle).Menu;
+end;
+
+const
+  CarbonWSPrefix = 'TCarbonWidgetSet.';
+
+{------------------------------------------------------------------------------
+  Name:    CheckHandle
+  Params:  AWinControl  - Handle of window
+           AClass       - Class
+           DbgText      - Text to output on invalid DC
+  Returns: If the wincontrol handle is allocated and valid
+ ------------------------------------------------------------------------------}
+function CheckHandle(const AWinControl: TWinControl; const AClass: TClass;
+  const DbgText: String): Boolean;
+begin
+   if AWinControl <> nil then
+  begin
+    if TObject(AWinControl.Handle) is TCarbonWidget then
+    begin
+      {$IFDEF VerboseWSClass}
+        DebugLn(AClass.ClassName + '.' + DbgText + ' for ' + AWinControl.Name);
+      {$ENDIF}
+
+      Result := True;
+    end
+    else
+    begin
+      Result := False;
+      DebugLn(AClass.ClassName + '.' + DbgText + ' for ' + AWinControl.Name +
+        ' failed: Handle ' + DbgS(Integer(AWinControl.Handle)) + ' is invalid!');
+    end;
+  end
+  else
+  begin
+    Result := False;
+    DebugLn(AClass.ClassName + '.' + DbgText + ' for ' + AWinControl.Name +
+      ' failed: WinControl is nil!');
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Name:    CheckWidget
   Params:  Handle      - Handle of window
-           DbgText - Text to output on invalid DC
+           AMethodName - Method name
-           Name    - Param name
+           AParamName  - Param name
   Returns: If the window is valid
  ------------------------------------------------------------------------------}
-function CheckWidget(const Handle: HWND; const DbgText: String; AName: String): Boolean;
+function CheckWidget(const Handle: HWND; const AMethodName: String;
+  AParamName: String): Boolean;
 begin
   if TObject(Handle) is TCarbonWidget then Result := True
   else
   begin
-    DebugLn(DbgText + Format(' error - invalid widget %s = %d!',
+    if Pos('.', AMethodName) = 0 then
-      [AName, Integer(Handle)]));
+      DebugLn(CarbonWSPrefix + AMethodName + ' Error - invalid widget ' +
+        AParamName + ' = ' + IntToStr(Integer(Handle)) + '!')
+    else
+      DebugLn(AMethodName + ' Error - invalid widget ' + AParamName + ' = ' +
+        IntToStr(Integer(Handle)) + '!');
+        
+    Result := False;
+  end;
+end;
+
+
+{------------------------------------------------------------------------------
+  Name:    CheckMenu
+  Params:  Menu        - Handle of menu
+           AMethodName - Method name
+           AParamName  - Param name
+  Returns: If the menu is valid
+ ------------------------------------------------------------------------------}
+function CheckMenu(const Menu: HMENU; const AMethodName: String;
+  AParamName: String): Boolean;
+begin
+  if TObject(Menu) is TCarbonMenu then Result := True
+  else
+  begin
+    if Pos('.', AMethodName) = 0 then
+      DebugLn(CarbonWSPrefix + AMethodName + ' Error - invalid menu ' +
+        AParamName + ' = ' + IntToStr(Integer(Menu)) + '!')
+    else
+      DebugLn(AMethodName + ' Error - invalid menu ' + AParamName + ' = ' +
+        IntToStr(Integer(Menu)) + '!');
+        
     Result := False;
   end;
 end;
@@ -353,62 +226,190 @@ end;
 {------------------------------------------------------------------------------
   Name:    CheckDC
   Params:  DC          - Handle to a device context (TCarbonDeviceContext)
-           DbgText - Text to output on invalid DC
+           AMethodName - Method name
-           Name    - Param name
+           AParamName  - Param name
   Returns: If the DC is valid
  ------------------------------------------------------------------------------}
-function CheckDC(const DC: HDC; const DbgText: String; AName: String): Boolean;
+function CheckDC(const DC: HDC; const AMethodName: String;
+  AParamName: String): Boolean;
 begin
   if TObject(DC) is TCarbonDeviceContext then Result := True
   else
   begin
-    DebugLn(DbgText + Format(' error - invalid device context %s = %d!',
+    if Pos('.', AMethodName) = 0 then
-      [AName, Integer(DC)]));
+      DebugLn(CarbonWSPrefix + AMethodName + ' Error - invalid DC ' +
+        AParamName + ' = ' + IntToStr(Integer(DC)) + '!')
+    else
+      DebugLn(AMethodName + ' Error - invalid DC ' + AParamName + ' = ' +
+        IntToStr(Integer(DC)) + '!');
+        
     Result := False;
   end;
 end;
 
 {------------------------------------------------------------------------------
   Name:    CheckGDIObject
-  Params:  GDIObject - handle to a GDI Object (TCarbonFont, ...)
+  Params:  GDIObject   - Handle to a GDI Object (TCarbonFont, ...)
-           DbgText   - Text to output on invalid GDIObject
+           AMethodName - Method name
-           Name      - Param name
+           AParamName  - Param name
   Returns: If the GDIObject is valid
 
   Remark: All handles for GDI objects must be pascal objects so we can
  distinguish between them
  ------------------------------------------------------------------------------}
-function CheckGDIObject(const GDIObject: HGDIOBJ; const DbgText: String;
+function CheckGDIObject(const GDIObject: HGDIOBJ; const AMethodName: String;
-  AName: String): Boolean;
+  AParamName: String): Boolean;
 begin
   if TObject(GDIObject) is TCarbonGDIObject then Result := True
   else
   begin
-    DebugLn(DbgText + Format(' error - invalid GDI object %s = %d!',
+    if Pos('.', AMethodName) = 0 then
-      [AName, Integer(GDIObject)]));
+      DebugLn(CarbonWSPrefix + AMethodName + ' Error - invalid GDIObject ' +
+        AParamName + ' = ' + IntToStr(Integer(GDIObject)) + '!')
+    else
+      DebugLn(AMethodName + ' Error - invalid GDIObject ' + AParamName + ' = ' +
+        IntToStr(Integer(GDIObject)) + '!');
+        
     Result := False;
   end;
 end;
 
 {------------------------------------------------------------------------------
   Name:    CheckBitmap
-  Params:  Bitmap  - handle to a bitmap (TCarbonBitmap)
+  Params:  Bitmap      - Handle to a bitmap (TCarbonBitmap)
-           DbgText - Text to output on invalid GDIObject
+           AMethodName - Method name
-           Name    - Param name
+           AParamName  - Param name
   Returns: If the bitmap is valid
  ------------------------------------------------------------------------------}
-function CheckBitmap(const Bitmap: HBITMAP; const DbgText: String;
+function CheckBitmap(const Bitmap: HBITMAP; const AMethodName: String;
-  AName: String): Boolean;
+  AParamName: String): Boolean;
 begin
   if TObject(Bitmap) is TCarbonBitmap then Result := True
   else
   begin
-    DebugLn(DbgText + Format(' error - invalid bitmap %s = %d!',
+    if Pos('.', AMethodName) = 0 then
-      [AName, Integer(Bitmap)]));
+      DebugLn(CarbonWSPrefix + AMethodName + ' Error - invalid bitmap ' +
+        AParamName + ' = ' + IntToStr(Integer(Bitmap)) + '!')
+    else
+      DebugLn(AMethodName + ' Error - invalid bitmap ' + AParamName + ' = ' +
+        IntToStr(Integer(Bitmap)) + '!');
+        
     Result := False;
   end;
 end;
 
+{------------------------------------------------------------------------------
+  Name:    CheckCursor
+  Params:  Cursor      - Handle to a cursor (TCarbonCursor)
+           AMethodName - Method name
+           AParamName  - Param name
+  Returns: If the cursor is valid
+ ------------------------------------------------------------------------------}
+function CheckCursor(const Cursor: HCURSOR; const AMethodName: String;
+  AParamName: String): Boolean;
+begin
+  if TObject(Cursor) is TCarbonCursor then Result := True
+  else
+  begin
+    if Pos('.', AMethodName) = 0 then
+      DebugLn(CarbonWSPrefix + AMethodName + ' Error - invalid cursor ' +
+        AParamName + ' = ' + IntToStr(Integer(Cursor)) + '!')
+    else
+      DebugLn(AMethodName + ' Error - invalid cursor ' + AParamName + ' = ' +
+        IntToStr(Integer(Cursor)) + '!');
+        
+    Result := False;
+  end;
+end;
+
+{------------------------------------------------------------------------------
+  Name:    OSError
+  Params:  AResult     - Result of Carbon function call
+           AMethodName - Parent method name
+           ACallName   - The Carbon function name
+           AText       - Another text useful for debugging (param value, ...)
+  Returns: If an error was the result of calling the specified Carbon function
+ ------------------------------------------------------------------------------}
+function OSError(AResult: OSStatus; const AMethodName, ACallName: String;
+  const AText: String): Boolean;
+begin
+  if AResult = noErr then Result := False
+  else
+  begin
+    Result := True;
+    DebugLn(AMethodName + ' Error: ' + ACallName + ' ' + AText +
+      ' failed with result ' + DbgS(AResult));
+  end;
+end;
+
+{------------------------------------------------------------------------------
+  Name:    OSError
+  Params:  AResult     - Result of Carbon function call
+           AObject     - Method object
+           AMethodName - Parent method name
+           ACallName   - The Carbon function name
+           AText       - Another text useful for debugging (param value, ...)
+  Returns: If an error was the result of calling the specified Carbon function
+ ------------------------------------------------------------------------------}
+function OSError(AResult: OSStatus; const AObject: TObject;
+  const AMethodName, ACallName: String;
+  const AText: String = ''): Boolean;
+begin
+  if AResult = noErr then Result := False
+  else
+  begin
+    Result := True;
+    DebugLn(AObject.ClassName + '.' + AMethodName + ' Error: ' + ACallName +
+      ' ' + AText + ' failed with result ' + DbgS(AResult));
+  end;
+end;
+
+{------------------------------------------------------------------------------
+  Name:    OSError
+  Params:  AResult     - Result of Carbon function call
+           AClass      - Method object
+           AMethodName - Parent method name
+           ACallName   - The Carbon function name
+           AText       - Another text useful for debugging (param value, ...)
+  Returns: If an error was the result of calling the specified Carbon function
+ ------------------------------------------------------------------------------}
+function OSError(AResult: OSStatus; const AClass: TClass;
+  const AMethodName, ACallName: String;
+  const AText: String = ''): Boolean;
+begin
+  if AResult = noErr then Result := False
+  else
+  begin
+    Result := True;
+    DebugLn(AClass.ClassName + '.' + AMethodName + ' Error: ' + ACallName +
+      ' ' + AText + ' failed with result ' + DbgS(AResult));
+  end;
+end;
+
+{------------------------------------------------------------------------------
+  Name:    OSError
+  Params:  AResult      - Result of Carbon function call
+           AObject      - Method object
+           AMethodName  - Parent method name
+           ACallName    - The Carbon function name
+           AText        - Another text useful for debugging (param value, ...)
+           AValidResult - Another result code that is valid like noErr
+  Returns: If an error was the result of calling the specified Carbon function
+ ------------------------------------------------------------------------------}
+function OSError(AResult: OSStatus; const AObject: TObject;
+  const AMethodName, ACallName: String;
+  const AText: String; AValidResult: OSStatus): Boolean;
+begin
+  if (AResult = noErr) or (AResult = AValidResult) then Result := False
+  else
+  begin
+    Result := True;
+    DebugLn(AObject.ClassName + '.' + AMethodName + ' Error: ' + ACallName +
+      ' ' + AText + ' failed with result ' + DbgS(AResult));
+  end;
+end;
+
+
 //=====================================================
 // UPP mamanger
 //=====================================================
@@ -444,6 +445,7 @@ begin
   inherited Destroy;
 end;
 
+
 {------------------------------------------------------------------------------
   Name:    GetCarbonWidget
   Params:  AWidget - Pointer to control or window widget
@@ -544,8 +546,8 @@ end;
 
 {------------------------------------------------------------------------------
   Name:    FindCarbonFontID
-  Params:  FontName - The font name
+  Params:  FontName - The font name, UTF-8 encoded
-  Returns: Carbon font ID of fotn with the specified name
+  Returns: Carbon font ID of font with the specified name
  ------------------------------------------------------------------------------}
 function FindCarbonFontID(const FontName: String): ATSUFontID;
 begin
@@ -553,8 +555,9 @@ begin
 
   if (FontName <> '') and not SameText(FontName, 'default') then
   begin
-    ATSUFindFontFromName(@FontName[1], Length(FontName), kFontFamilyName,
+    ATSUFindFontFromName(@FontName[1], Length(FontName),
-      kFontMacintoshPlatform, kFontRomanScript, kFontEnglishLanguage, Result);
+      kFontFamilyName, kFontMacintoshPlatform, kFontRomanScript,
+      kFontEnglishLanguage, Result);
   end;
 end;
 
@@ -776,11 +779,73 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  Name:    RectToCGRect
+  Name:    ExcludeRect
+  Params:  A - Source rectangle
+           B - Rectangle to be excluded
+  Returns: Array of CGRect, which are product of exclusion rectangle B from
+  rectangle A.
+  Note: The returned rectangles may overlay.
+ ------------------------------------------------------------------------------}
+function ExcludeRect(const A, B: TRect): CGRectArray;
+begin
+  SetLength(Result, 0);
+  if (A.Left >= A.Right) or (A.Top >= A.Bottom) then Exit;
+  
+  SetLength(Result, 1);
+  Result[0] := RectToCGRect(A);
+
+  if (B.Left >= B.Right) or (B.Top >= B.Bottom) then Exit;
+
+  if (B.Left < A.Right) and (B.Right > A.Left)
+    and (B.Top < A.Bottom) and (B.Bottom > A.Top) then
+  begin // rectangles have intersection
+    SetLength(Result, 0);
+
+    if B.Top > A.Top then
+    begin
+      SetLength(Result, Succ(Length(Result)));
+      Result[High(Result)] := GetCGRect(A.Left, A.Top, A.Right, B.Top);
+    end;
+
+    if B.Bottom < A.Bottom then
+    begin
+      SetLength(Result, Succ(Length(Result)));
+      Result[High(Result)] := GetCGRect(A.Left, B.Bottom, A.Right, A.Bottom);
+    end;
+
+    if B.Left > A.Left then
+    begin
+      SetLength(Result, Succ(Length(Result)));
+      Result[High(Result)] := GetCGRect(A.Left, A.Top, B.Left, A.Bottom);
+    end;
+
+    if B.Right < A.Right then
+    begin
+      SetLength(Result, Succ(Length(Result)));
+      Result[High(Result)] := GetCGRect(B.Right, A.Top, A.Right, A.Bottom);
+    end;
+  end;
+end;
+
+{------------------------------------------------------------------------------
+  Name:    GetCGRect
+  Params:  X1, Y1, X2, Y2 - Rectangle coordinates
+  Returns: CGRect
+ ------------------------------------------------------------------------------}
+function GetCGRect(X1, Y1, X2, Y2: Integer): CGRect;
+begin
+  Result.origin.x := X1;
+  Result.size.width := X2 - X1;
+  Result.origin.y := Y1;
+  Result.size.height := Y2 - Y1;
+end;
+
+{------------------------------------------------------------------------------
+  Name:    GetCGRectSorted
   Params:  X1, Y1, X2, Y2 - Rectangle coordinates
   Returns: CGRect, coordinates are sorted
  ------------------------------------------------------------------------------}
-function GetCGRect(X1, Y1, X2, Y2: Integer): CGRect;
+function GetCGRectSorted(X1, Y1, X2, Y2: Integer): CGRect;
 begin
   if X1 <= X2 then
   begin
@@ -908,21 +973,26 @@ begin
   Result := CGColorCreate(RGBColorSpace, @F[0]);
 end;
 
+function Dbgs(const ASize: TSize): string;
+begin
+   Result := 'cx: ' + IntToStr(ASize.cx) + ' cy: ' + IntToStr(ASize.cy);
+end;
+
 function Dbgs(const ARect: FPCMacOSAll.Rect): String;
 begin
-  Result:=IntToStr(ARect.left)+','+IntToStr(ARect.top)
+  Result := IntToStr(ARect.left) + ', ' + IntToStr(ARect.top)
-          +','+IntToStr(ARect.right)+','+IntToStr(ARect.bottom);
+          + ', ' + IntToStr(ARect.right) + ', ' + IntToStr(ARect.bottom);
 end;
 
 function Dbgs(const AColor: FPCMacOSAll.RGBColor): String;
 begin
-  Result := 'R: ' + IntToHex(AColor.Red, 4)
+  Result :=
-    + 'G: ' + IntToHex(AColor.Green, 4)
+    'R: ' + IntToHex(AColor.Red, 4) +
-    + 'B: ' + IntToHex(AColor.Blue, 4);
+    ' G: ' + IntToHex(AColor.Green, 4) +
+    ' B: ' + IntToHex(AColor.Blue, 4);
 end;
 
 finalization
-  if UPPTree <> nil
+  if UPPTree <> nil then FreeAndNil(UPPTree);
-  then FreeAndNil(UPPTree);
 
 end.

lcl/interfaces/carbon/carbonstrings.pp

@@ -46,6 +46,7 @@ type
     constructor Create(AOwner: TCarbonComboBox);
     procedure Clear; override;
     procedure Delete(Index: Integer); override;
+    procedure Sort; override;
   public
     property Owner: TCarbonComboBox read FOwner;
   end;
@@ -212,6 +213,29 @@ begin
   inherited Delete(Index);
   HIComboBoxRemoveItemAtIndex(HIViewRef(FOwner.Widget), Index);
 end;
+{------------------------------------------------------------------------------
+  Method:  TCarbonComboBoxStrings.Sort
+
+  Sorts the strings
+ ------------------------------------------------------------------------------}
+procedure TCarbonComboBoxStrings.Sort;
+var
+  CFString: CFStringRef;
+  I: Integer;
+begin
+  inherited Sort;
+  
+  for I := 0 to Count - 1 do
+  begin
+    CreateCFString(Strings[I], CFString);
+    try
+      if HIComboBoxRemoveItemAtIndex(HIViewRef(FOwner.Widget), I) = noErr then
+        HIComboBoxInsertTextItemAtIndex(HIViewRef(FOwner.Widget), I, CFString);
+    finally
+      FreeCFString(CFString);
+    end;
+  end;
+end;
 
 { TCarbonListBoxStrings }
 

lcl/interfaces/carbon/carbonwinapih.inc

@@ -82,7 +82,7 @@ function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer; override;
 procedure EnterCriticalSection(var CritSection: TCriticalSection); override;
 function EnumFontFamilies(DC: HDC; Family:Pchar; EnumFontFamProc: FontEnumProc; LParam: Lparam): Longint; override;
 function EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; LParam: Lparam; flags: dword): Longint; override;
-function ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer; override;
+function ExcludeClipRect(DC: HDC; Left, Top, Right, Bottom : Integer) : Integer; override;
 function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;  override;
 function ExtSelectClipRGN(dc: hdc; rgn : hrgn; Mode : Longint) : Integer;  override;
 
@@ -162,7 +162,7 @@ function RadialArc(DC: HDC; Left, Top, Right, Bottom, sx, sy, ex, ey: Integer):
 function RadialChord(DC: HDC; x1, y1, x2, y2, sx, sy, ex, ey: Integer): Boolean; override;
 function RealizePalette(DC: HDC): Cardinal; override;
 function Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; override;
-function RectVisible(dc : hdc; const ARect: TRect) : Boolean; override;
+function RectVisible(DC: HDC; const ARect: TRect) : Boolean; override;
 function RegroupMenuItem(hndMenu: HMENU; GroupIndex: integer): Boolean; override;
 function ReleaseCapture : Boolean; override;
 function ReleaseDC(HWnd: HWND; DC: HDC): Integer; override;
@@ -185,7 +185,7 @@ function SetCapture(AHandle: HWND): HWND; override;
 function SetCaretPos(X, Y: Integer): Boolean; override;
 function SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean; override;
 function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; override;
-function SetCursor(hCursor: HICON): HCURSOR; override;
+function SetCursor(ACursor: HCURSOR): HCURSOR; override;
 function SetFocus(HWnd: HWND): HWND; override;
 function SetForegroundWindow(HWnd: HWND): boolean; override;
 function SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean; override;

lcl/interfaces/carbon/carbonwsbuttons.pp

@@ -99,7 +99,7 @@ end;
 class procedure TCarbonWSButton.SetDefault(const AButton: TCustomButton;
   ADefault: Boolean);
 begin
-  if not WSCheckHandleAllocated(AButton, 'SetDefault') then Exit;
+  if not CheckHandle(AButton, Self, 'SetDefault') then Exit;
 
   SetControlData(AsControlRef(AButton.Handle), kControlEntireControl,
     kControlPushButtonDefaultTag, SizeOf(Boolean), @ADefault);
@@ -135,7 +135,7 @@ class procedure TCarbonWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
 var
   ContentInfo: ControlButtonContentInfo;
 begin
-  if not WSCheckHandleAllocated(ABitBtn, 'SetGlyph') then Exit;
+  if not CheckHandle(ABitBtn, Self, 'SetGlyph') then Exit;
   
   ContentInfo.contentType := kControlContentCGImageRef;
   if AValue = nil then
@@ -159,7 +159,7 @@ class procedure TCarbonWSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn;
 var
   Placement: ControlButtonTextPlacement;
 begin
-  if not WSCheckHandleAllocated(ABitBtn, 'SetLayout') then Exit;
+  if not CheckHandle(ABitBtn, Self, 'SetLayout') then Exit;
   
   case AValue of
     blGlyphLeft  : Placement := kControlBevelButtonPlaceToRightOfGraphic;

lcl/interfaces/carbon/carbonwscomctrls.pp

@@ -180,7 +180,7 @@ end;
 class procedure TCarbonWSProgressBar.ApplyChanges(
   const AProgressBar: TCustomProgressBar);
 begin
-  if not WSCheckHandleAllocated(AProgressBar, 'ApplyChanges') then Exit;
+  if not CheckHandle(AProgressBar, Self, 'ApplyChanges') then Exit;
 
   TCarbonCustomBar(AProgressBar.Handle).SetData(AProgressBar.Position,
     AProgressBar.Min, AProgressBar.Max);
@@ -196,7 +196,7 @@ end;
 class procedure TCarbonWSProgressBar.SetPosition(
   const AProgressBar: TCustomProgressBar; const NewPosition: integer);
 begin
-  if not WSCheckHandleAllocated(AProgressBar, 'SetPosition') then Exit;
+  if not CheckHandle(AProgressBar, Self, 'SetPosition') then Exit;
 
   TCarbonCustomBar(AProgressBar.Handle).SetData(AProgressBar.Position);
 end;
@@ -227,7 +227,7 @@ class procedure TCarbonWSTrackBar.ApplyChanges(const ATrackBar: TCustomTrackBar)
 var
   CarbonTrackBar: TCarbonTrackBar;
 begin
-  if not WSCheckHandleAllocated(ATrackBar, 'ApplyChanges') then Exit;
+  if not CheckHandle(ATrackBar, Self, 'ApplyChanges') then Exit;
 
   CarbonTrackBar := TCarbonTrackBar(ATrackBar.Handle);
   
@@ -246,7 +246,7 @@ class function TCarbonWSTrackBar.GetPosition(const ATrackBar: TCustomTrackBar
   ): integer;
 begin
   Result := 0;
-  if not WSCheckHandleAllocated(ATrackBar, 'GetPosition') then Exit;
+  if not CheckHandle(ATrackBar, Self, 'GetPosition') then Exit;
 
   Result := TCarbonTrackBar(ATrackBar.Handle).GetPos;
 end;
@@ -261,7 +261,7 @@ end;
 class procedure TCarbonWSTrackBar.SetPosition(const ATrackBar: TCustomTrackBar;
   const NewPosition: integer);
 begin
-  if not WSCheckHandleAllocated(ATrackBar, 'SetPosition') then Exit;
+  if not CheckHandle(ATrackBar, Self, 'SetPosition') then Exit;
 
   TCarbonTrackBar(ATrackBar.Handle).SetData(ATrackBar.Position);
 end;

lcl/interfaces/carbon/carbonwscontrols.pp

@@ -124,7 +124,7 @@ class procedure TCarbonWSWinControl.GetPreferredSize(const AWinControl: TWinCont
 var
   S: TPoint;
 begin
-  if not WSCheckHandleAllocated(AWinControl, 'GetPreferredSize') then Exit;
+  if not CheckHandle(AWinControl, Self, 'GetPreferredSize') then Exit;
   
   S := TCarbonWidget(AWinControl.Handle).GetPreferredSize;
   PreferredWidth := S.X;
@@ -143,7 +143,7 @@ class function TCarbonWSWinControl.GetText(const AWinControl: TWinControl;
   var AText: String): Boolean;
 begin
   Result := False;
-  if not WSCheckHandleAllocated(AWinControl, 'GetText') then Exit;
+  if not CheckHandle(AWinControl, Self,'GetText') then Exit;
 
   Result := TCarbonWidget(AWinControl.Handle).GetText(AText);
 end;
@@ -159,7 +159,7 @@ end;
 class procedure TCarbonWSWinControl.SetBounds(const AWinControl: TWinControl;
   const ALeft, ATop, AWidth, AHeight: Integer);
 begin
-  if not WSCheckHandleAllocated(AWinControl, 'SetBounds') then Exit;
+  if not CheckHandle(AWinControl, Self, 'SetBounds') then Exit;
 
   TCarbonWidget(AWinControl.Handle).SetBounds(Bounds(ALeft, ATop, AWidth, AHeight));
 end;
@@ -183,8 +183,8 @@ var
   I, StopPos: Integer;
   Child: TWinControl;
 begin
-  if not WSCheckHandleAllocated(AWinControl, 'SetChildZPosition') then Exit;
+  if not CheckHandle(AWinControl, Self, 'SetChildZPosition') then Exit;
-  if not WSCheckHandleAllocated(AChild, 'SetChildZPosition AChild') then Exit;
+  if not CheckHandle(AChild, Self, 'SetChildZPosition AChild') then Exit;
   
   RefView := nil;
   if ANewPos <= 0 then // send behind all
@@ -230,7 +230,7 @@ end;
  ------------------------------------------------------------------------------}
 class procedure TCarbonWSWinControl.SetColor(const AWinControl: TWinControl);
 begin
-  if not WSCheckHandleAllocated(AWinControl, 'SetColor') then Exit;
+  if not CheckHandle(AWinControl, Self, 'SetColor') then Exit;
 
   TCarbonWidget(AWinControl.Handle).SetColor(AWinControl.Color);
 end;
@@ -246,7 +246,7 @@ end;
 class procedure TCarbonWSWinControl.SetFont(const AWinControl: TWinControl;
   const AFont: TFont);
 begin
-  if not WSCheckHandleAllocated(AWinControl, 'SetFont') then Exit;
+  if not CheckHandle(AWinControl, Self, 'SetFont') then Exit;
   
   TCarbonWidget(AWinControl.Handle).SetFont(AFont);
 end;
@@ -262,7 +262,7 @@ end;
 class procedure TCarbonWSWinControl.SetText(const AWinControl: TWinControl;
   const AText: String);
 begin
-  if not WSCheckHandleAllocated(AWinControl, 'SetText') then Exit;
+  if not CheckHandle(AWinControl, Self, 'SetText') then Exit;
   
   //DebugLn('TCarbonWSWinControl.SetText ',dbgsName(AWinControl),' ',AText);
   TCarbonWidget(AWinControl.Handle).SetText(AText);
@@ -277,7 +277,7 @@ end;
  ------------------------------------------------------------------------------}
 class procedure TCarbonWSWinControl.Invalidate(const AWinControl: TWinControl);
 begin
-  if not WSCheckHandleAllocated(AWinControl, 'Invalidate') then Exit;
+  if not CheckHandle(AWinControl, Self, 'Invalidate') then Exit;
 
   TCarbonWidget(AWinControl.Handle).Invalidate;
 end;
@@ -291,7 +291,7 @@ end;
  ------------------------------------------------------------------------------}
 class procedure TCarbonWSWinControl.ShowHide(const AWinControl: TWinControl);
 begin
-  if not WSCheckHandleAllocated(AWinControl, 'ShowHide') then Exit;
+  if not CheckHandle(AWinControl, Self, 'ShowHide') then Exit;
   
   TCarbonWidget(AWinControl.Handle).ShowHide(AWinControl.Visible);
 end;
@@ -305,8 +305,8 @@ end;
  ------------------------------------------------------------------------------}
 class procedure TCarbonWSWinControl.AddControl(const AControl: TControl);
 begin
-  if not WSCheckHandleAllocated(AControl as TWinControl, 'AddControl') then Exit;
+  if not CheckHandle(AControl as TWinControl, Self, 'AddControl') then Exit;
-  if not WSCheckHandleAllocated(AControl.Parent, 'AddControl Parent') then Exit;
+  if not CheckHandle(AControl.Parent, Self, 'AddControl Parent') then Exit;
   
   // add frame control to content area
   HIViewAddSubview(TCarbonWidget(AControl.Parent.Handle).Content,
@@ -322,9 +322,8 @@ end;
  ------------------------------------------------------------------------------}
 class procedure TCarbonWSWinControl.DestroyHandle(const AWinControl: TWinControl);
 begin
-  if not WSCheckHandleAllocated(AWinControl, 'DestroyHandle') then Exit;
+  if not CheckHandle(AWinControl, Self, 'DestroyHandle') then Exit;
 
-  DebugLn('TCarbonWSWinControl.DestroyHandle ', DbgSName(AWinControl));
   TCarbonWidget(AWinControl.Handle).Free;
 end;
 
@@ -340,7 +339,7 @@ class function TCarbonWSWinControl.GetClientBounds(const AWinControl: TWinContro
   var ARect: TRect): Boolean;
 begin
   Result := False;
-  if not WSCheckHandleAllocated(AWinControl, 'GetClientBounds') then Exit;
+  if not CheckHandle(AWinControl, Self, 'GetClientBounds') then Exit;
   
   Result := TCarbonWidget(AWinControl.Handle).GetClientRect(ARect);
 end;
@@ -357,7 +356,7 @@ class function TCarbonWSWinControl.GetClientRect(const AWinControl: TWinControl;
   var ARect: TRect): Boolean;
 begin
   Result := False;
-  if not WSCheckHandleAllocated(AWinControl, 'GetClientRect') then Exit;
+  if not CheckHandle(AWinControl, Self, 'GetClientRect') then Exit;
   
   Result := TCarbonWidget(AWinControl.Handle).GetClientRect(ARect);
   if Result then OffsetRect(ARect, -ARect.Left, -ARect.Top);

lcl/interfaces/carbon/carbonwsdialogs.pp

@@ -36,7 +36,7 @@ uses
   // libs
   FPCMacOSAll,
   // LCL
-  Controls, Dialogs, LCLType, LCLProc,
+  SysUtils, Controls, Dialogs, LCLType, LCLProc,
   // widgetset
   WSLCLClasses, WSProc, WSDialogs,
   // interface
@@ -57,6 +57,7 @@ type
   private
   protected
   public
+    class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
   end;
 
   { TCarbonWSOpenDialog }
@@ -111,6 +112,155 @@ type
 
 implementation
 
+{ TCarbonWSFileDialog }
+
+{------------------------------------------------------------------------------
+  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.
+   TODO: Figure out how to use dialog's InitialDir property.
+   TODO: Figure out how to pass UPP of a custom filter callback function as 
+         inFilterProc to NavCreateGetFileDialog and pass FileDialog as
+         inClientData so callback function can access dialog's Filter property.
+ }
+var
+  FileDialog: TFileDialog;
+  CreationOptions: NavDialogCreationOptions;
+  DialogRef: NavDialogRef;
+  DialogReply: NavReplyRecord;
+  FileCount: Integer;
+  FileIdx: Integer;
+  Keyword: AEKeyword;
+  FileDesc: AEDesc;
+  FileRef: FSRef;
+  FileURL: CFURLRef;
+  FileCFStr: CFStringRef;
+const AName = 'TCarbonWSFileDialog.ShowModal';
+begin
+  {$IFDEF VerboseWSClass}
+    DebugLn('TCarbonWSFileDialog.ShowModal for ' + ACommonDialog.Name);
+  {$ENDIF}
+
+  FileDialog := ACommonDialog as TFileDialog;
+
+  // Initialize record to default values
+  if OSError(NavGetDefaultDialogCreationOptions(CreationOptions),
+    AName, '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
+
+  try
+    if FileDialog is TSaveDialog 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 xor kNavDontConfirmReplacement
+      else
+        CreationOptions.optionFlags :=
+          CreationOptions.optionFlags or kNavDontConfirmReplacement;
+         
+      // Create Save dialog
+      if OSError(NavCreatePutFileDialog(@CreationOptions, 0, 0, nil, nil,
+        DialogRef), AName, 'NavCreatePutFileDialog') then Exit;
+    end
+    else
+      if FileDialog is TSelectDirectoryDialog then // Create Choose folder dialog
+      begin
+        if OSError(NavCreateChooseFolderDialog(@CreationOptions, nil, nil, nil,
+          DialogRef), AName, 'NavCreateChooseFolderDialog') then Exit;
+      end
+      else
+        if FileDialog is TOpenDialog then
+        begin
+          if not (ofAllowMultiSelect in TOpenDialog(FileDialog).Options) then
+            CreationOptions.optionFlags :=
+              CreationOptions.optionFlags xor kNavAllowMultipleFiles
+          else
+            CreationOptions.optionFlags :=
+              CreationOptions.optionFlags or kNavAllowMultipleFiles;
+
+          // Create Open dialog
+          if OSError(NavCreateGetFileDialog(@CreationOptions, nil, nil, nil, nil,
+            nil, DialogRef), AName, 'NavCreateGetFileDialog') then Exit;
+        end;
+
+    try
+      // Display dialog
+      if OSError(NavDialogRun(DialogRef), AName, 'NavDialogRun') then Exit;
+      
+      if NavDialogGetUserAction(DialogRef) <> kNavUserActionCancel then // User OK?
+      begin
+        if OSError(NavDialogGetReply(DialogRef, DialogReply), AName,
+          'NavDialogGetReply') then Exit;  // Get user's selection
+          
+        if OSError(AECountItems(DialogReply.Selection, FileCount), AName,
+          'AECountItems') then Exit;
+          
+        for FileIdx := 1 to FileCount do
+        begin
+          if OSError(AEGetNthDesc(DialogReply.Selection, FileIdx, typeFSRef,
+            @Keyword, FileDesc), AName, 'AEGetNthDesc') then Exit;
+          // Get file reference
+          if OSError(AEGetDescData(FileDesc, @FileRef, SizeOf(FSRef)), AName,
+            'AEGetDescData') then Exit;
+          if OSError(AEDisposeDesc(FileDesc), AName, 'AEDisposeDesc') then Exit;
+          
+          FileURL := CFURLCreateFromFSRef(kCFAllocatorDefault, FileRef); // Get URL
+          FileCFStr := CFURLCopyFileSystemPath(FileURL, kCFURLPOSIXPathStyle); // Get path
+          
+          FileDialog.Files.Add(CFStringToStr(FileCFStr));
+
+          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 is TSaveDialog 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), AName, 'NavDisposeReply') then
+          Exit;
+          
+        FileDialog.UserChoice := mrOK;
+      end;
+    finally
+      NavDialogDispose(DialogRef);  // Dispose of dialog
+    end;
+
+  finally
+    FreeCFString(CreationOptions.windowTitle);
+    FreeCFString(CreationOptions.saveFileName);
+  end;
+
+end;  {TCarbonWSFileDialog.ShowModal}
+
 { TCarbonWSColorDialog }
 
 {------------------------------------------------------------------------------
@@ -126,6 +276,10 @@ var
   ColorInfo: ColorPickerInfo;
   ColorDialog: TColorDialog;
 begin
+  {$IFDEF VerboseWSClass}
+    DebugLn('TCarbonWSColorDialog.ShowModal for ' + ACommonDialog.Name);
+  {$ENDIF}
+  
   ACommonDialog.UserChoice := mrCancel;
   ColorDialog := ACommonDialog as TColorDialog;
   
@@ -141,11 +295,11 @@ begin
   ColorInfo.colorProc := nil;
   // ColorDialog.Title is ignored, ColorInfo.prompt is not shown anywhere
   
-  if PickColor(ColorInfo) = noErr then
+  if OSError(PickColor(ColorInfo), Self, 'ShowModal', 'PickColor') then Exit;
+  
   if ColorInfo.newColorChosen then
   begin
-      ColorDialog.Color := RGBColorToColor(
+    ColorDialog.Color := RGBColorToColor(RGBColor(ColorInfo.theColor.color.rgb));
-        RGBColor(ColorInfo.theColor.color.rgb));
     ACommonDialog.UserChoice := mrOK;
   end;
 end;
@@ -159,7 +313,7 @@ initialization
 // which actually implement something
 ////////////////////////////////////////////////////
 //  RegisterWSComponent(TCommonDialog, TCarbonWSCommonDialog);
-//  RegisterWSComponent(TFileDialog, TCarbonWSFileDialog);
+  RegisterWSComponent(TFileDialog, TCarbonWSFileDialog);
 //  RegisterWSComponent(TOpenDialog, TCarbonWSOpenDialog);
 //  RegisterWSComponent(TSaveDialog, TCarbonWSSaveDialog);
 //  RegisterWSComponent(TSelectDirectoryDialog, TCarbonWSSelectDirectoryDialog);

lcl/interfaces/carbon/carbonwsforms.pp

@@ -27,13 +27,13 @@ unit CarbonWSForms;
 interface
 
 uses
-  // libs
+  // Libs
   FPCMacOSAll, CarbonUtils, CarbonExtra,
   // LCL
   Controls, Forms, Graphics, LCLType, LMessages, LCLProc, Classes,
-  // widgetset
+  // Widgetset
   WSForms, WSLCLClasses, WSProc,
-  // interface
+  // Interface
   CarbonDef, CarbonProc, CarbonPrivate,
   CarbonWSControls;
 
@@ -100,6 +100,7 @@ type
   private
   protected
   public
+    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
   end;
 
   { TCarbonWSScreen }
@@ -146,7 +147,7 @@ end;
  ------------------------------------------------------------------------------}
 class procedure TCarbonWSCustomForm.CloseModal(const ACustomForm: TCustomForm);
 begin
-  if not WSCheckHandleAllocated(ACustomForm, 'CloseModal') then Exit;
+  if not CheckHandle(ACustomForm, Self, 'CloseModal') then Exit;
   
   FPCMacOSAll.SetWindowModality(AsWindowRef(ACustomForm.Handle),
     kWindowModalityNone, nil);
@@ -161,7 +162,7 @@ end;
  ------------------------------------------------------------------------------}
 class procedure TCarbonWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
 begin
-  if not WSCheckHandleAllocated(ACustomForm, 'ShowModal') then Exit;
+  if not CheckHandle(ACustomForm, Self, 'ShowModal') then Exit;
 
   SetWindowModality(AsWindowRef(ACustomForm.Handle),
     kWindowModalityAppModal, nil);
@@ -181,7 +182,7 @@ class procedure TCarbonWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
 var
   AttrsSet, AttrsClear: WindowAttributes;
 begin
-  if not WSCheckHandleAllocated(AForm, 'SetBorderIcons') then Exit;
+  if not CheckHandle(AForm, Self, 'SetBorderIcons') then Exit;
 
   AttrsSet := 0;
   AttrsClear := 0;
@@ -211,6 +212,22 @@ begin
 end;
 
 
+{ TCarbonWSHintWindow }
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSHintWindow.CreateHandle
+  Params:  AWinControl - LCL control
+           AParams     - Creation parameters
+  Returns: Handle to the window in Carbon interface
+
+  Creates new hint window in Carbon interface with the specified parameters
+ ------------------------------------------------------------------------------}
+class function TCarbonWSHintWindow.CreateHandle(const AWinControl: TWinControl;
+  const AParams: TCreateParams): TLCLIntfHandle;
+begin
+  Result := TLCLIntfHandle(TCarbonHintWindow.Create(AWinControl, AParams));
+end;
+
 initialization
 
 ////////////////////////////////////////////////////
@@ -225,7 +242,7 @@ initialization
 //  RegisterWSComponent(TFrame, TCarbonWSFrame);
   RegisterWSComponent(TCustomForm, TCarbonWSCustomForm);
 //  RegisterWSComponent(TForm, TCarbonWSForm);
-//  RegisterWSComponent(THintWindow, TCarbonWSHintWindow);
+  RegisterWSComponent(THintWindow, TCarbonWSHintWindow);
 //  RegisterWSComponent(TScreen, TCarbonWSScreen);
 //  RegisterWSComponent(TApplicationProperties, TCarbonWSApplicationProperties);
 ////////////////////////////////////////////////////

lcl/interfaces/carbon/carbonwsmenus.pp

@@ -35,7 +35,15 @@ uses
 ////////////////////////////////////////////////////
 //  Menus,
 ////////////////////////////////////////////////////
-  WSMenus, WSLCLClasses;
+  // Libs
+  FPCMacOSAll, CarbonUtils, CarbonExtra,
+  // LCL
+  Controls, Forms, Menus, Graphics, LCLType, LMessages, LCLProc, Classes,
+  // Widgetset
+  WSMenus, WSLCLClasses,
+  // Interface
+  CarbonDef, CarbonProc, CarbonMenus,
+  CarbonWSControls;
 
 type
 
@@ -44,7 +52,19 @@ type
   TCarbonWSMenuItem = class(TWSMenuItem)
   private
   protected
+    class function CheckMenuItem(const AMenuItem: TMenuItem;
+      const AMethodName: String; AParamName: String = ''): Boolean;
   public
+    class procedure AttachMenu(const AMenuItem: TMenuItem); override;
+    class function  CreateHandle(const AMenuItem: TMenuItem): HMENU; override;
+    class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
+    class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override;
+    class procedure SetShortCut(const AMenuItem: TMenuItem; const OldShortCut, NewShortCut: TShortCut); override;
+    class procedure SetVisible(const AMenuItem: TMenuItem; const Visible: boolean); override;
+    class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; override;
+    class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override;
+    class function SetRadioItem(const AMenuItem: TMenuItem; const RadioItem: boolean): boolean; override;
+    //class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override;
   end;
 
   { TCarbonWSMenu }
@@ -53,6 +73,7 @@ type
   private
   protected
   public
+    class function  CreateHandle(const AMenu: TMenu): HMENU; override;
   end;
 
   { TCarbonWSMainMenu }
@@ -69,11 +90,253 @@ type
   private
   protected
   public
+    class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: Integer); override;
   end;
 
 
 implementation
 
+{ TCarbonWSMenu }
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSMenu.CreateHandle
+  Params:  AMenu - LCL menu
+  Returns: Handle to the menu in Carbon interface
+
+  Creates new menu in Carbon interface
+ ------------------------------------------------------------------------------}
+class function TCarbonWSMenu.CreateHandle(const AMenu: TMenu): HMENU;
+begin
+  Result := HMENU(TCarbonMenu.Create(AMenu.Items, True));
+end;
+
+{ TCarbonWSMenuItem }
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSMenu.CheckMenuItem
+  Params:  AMenuItem   - LCL menu item
+           AMethodName - Method name
+           AParamName  - Param name
+  Returns: If the menu item is valid
+ ------------------------------------------------------------------------------}
+class function TCarbonWSMenuItem.CheckMenuItem(const AMenuItem: TMenuItem;
+  const AMethodName: String; AParamName: String): Boolean;
+begin
+  if AMenuItem <> nil then
+  begin
+    if TObject(AMenuItem.Handle) is TCarbonMenu then
+    begin
+      {$IFDEF VerboseWSClass}
+        DebugLn(Self.ClassName + '.' + DbgText + ' ' + AParamName + ' for ' + AMenuItem.Name);
+      {$ENDIF}
+
+      Result := True;
+    end
+    else
+    begin
+      Result := False;
+      DebugLn(Self.ClassName + '.' + AMethodName + ' ' + AParamName + ' for ' +
+        AMenuItem.Name + ' failed: Handle ' +
+        DbgS(Integer(AMenuItem.Handle)) + ' is invalid!');
+    end;
+  end
+  else
+  begin
+    Result := False;
+    DebugLn(Self.ClassName + '.' + AMethodName + ' ' + AParamName + ' for ' +
+      AMenuItem.Name + ' failed: MenuItem is nil!');
+  end;
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSMenuItem.AttachMenu
+  Params:  AMenuItem - LCL menu item
+  Returns: Nothinh
+
+  Attaches menu item to its parent menu in Carbon interface
+ ------------------------------------------------------------------------------}
+class procedure TCarbonWSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
+begin
+  if not CheckMenuItem(AMenuItem, 'AttachMenu') then Exit;
+  if not CheckMenuItem(AMenuItem.Parent, 'AttachMenu', 'Parent') then Exit;
+  
+  TCarbonMenu(AMenuItem.Parent.Handle).Add(TCarbonMenu(AMenuItem.Handle));
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSMenuItem.CreateHandle
+  Params:  AMenuItem - LCL menu item
+  Returns: Handle to the menu item in Carbon interface
+
+  Creates new menu item in Carbon interface
+ ------------------------------------------------------------------------------}
+class function TCarbonWSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU;
+begin
+  Result := HMENU(TCarbonMenu.Create(AMenuItem));
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSMenuItem.DestroyHandle
+  Params:  AMenuItem - LCL menu item
+  Returns: Nothing
+
+  Destroys menu item in Carbon interface
+ ------------------------------------------------------------------------------}
+class procedure TCarbonWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
+begin
+  if not CheckMenuItem(AMenuItem, 'DestroyHandle') then Exit;
+  
+  TCarbonMenu(AMenuItem.Handle).Free;
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSMenuItem.SetCaption
+  Params:  AMenuItem - LCL menu item
+           ACaption  - Menu item caption
+  Returns: Nothing
+
+  Sets the caption of menu item in Carbon interface
+ ------------------------------------------------------------------------------}
+class procedure TCarbonWSMenuItem.SetCaption(const AMenuItem: TMenuItem;
+  const ACaption: string);
+begin
+  if not CheckMenuItem(AMenuItem, 'SetCaption') then Exit;
+  if not CheckMenuItem(AMenuItem.Parent, 'SetCaption', 'Parent') then Exit;
+
+  TCarbonMenu(AMenuItem.Handle).SetCaption(ACaption);
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSMenuItem.SetShortCut
+  Params:  AMenuItem   - LCL menu item
+           OldShortCut - Old shortcut
+           NewShortCut - New shortcut
+  Returns: Nothing
+
+  Sets the shortcut of menu item in Carbon interface
+  NOTE: only Command Key (ssCtrl) is supported
+ ------------------------------------------------------------------------------}
+class procedure TCarbonWSMenuItem.SetShortCut(const AMenuItem: TMenuItem;
+  const OldShortCut, NewShortCut: TShortCut);
+var
+  Shift: TShiftState;
+  Key: Word;
+begin
+  if not CheckMenuItem(AMenuItem, 'SetShortCut') then Exit;
+  if not CheckMenuItem(AMenuItem.Parent, 'SetShortCut', 'Parent') then Exit;
+  
+  ShortCutToKey(NewShortCut, Key, Shift);
+  
+  if not (ssCtrl in Shift) then
+    DebugLn('Note: Carbon menus supports only shortcuts with Ctrl!');
+    
+  SetMenuItemCommandKey(AsMenuRef(AMenuItem.Parent.Handle),
+    AMenuItem.MenuIndex + 1, False, Key);
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSMenuItem.SetVisible
+  Params:  AMenuItem - LCL menu item
+           Visible   - Menu item visibility
+  Returns: Nothing
+
+  Sets the visibility of menu item in Carbon interface
+ ------------------------------------------------------------------------------}
+class procedure TCarbonWSMenuItem.SetVisible(const AMenuItem: TMenuItem;
+  const Visible: boolean);
+begin
+  if not CheckMenuItem(AMenuItem, 'SetVisible') then Exit;
+  if not CheckMenuItem(AMenuItem.Parent, 'SetVisible', 'Parent') then Exit;
+
+  TCarbonMenu(AMenuItem.Handle).SetVisible(Visible);
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSMenuItem.SetCheck
+  Params:  AMenuItem - LCL menu item
+           Checked   - Menu item checked
+  Returns: If the function succeeds
+
+  Sets the check of menu item in Carbon interface
+ ------------------------------------------------------------------------------}
+class function TCarbonWSMenuItem.SetCheck(const AMenuItem: TMenuItem;
+  const Checked: boolean): boolean;
+begin
+  Result := False;
+  if not CheckMenuItem(AMenuItem, 'SetCheck') then Exit;
+  if not CheckMenuItem(AMenuItem.Parent, 'SetCheck', 'Parent') then Exit;
+  
+  if AMenuItem.Checked then
+  begin
+    {if AMenuItem.RadioItem then
+      SetItemMark(AsMenuRef(AMenuItem.Parent.Handle), AMenuItem.MenuIndex + 1,
+        Char(kDiamondCharCode)) // or kBulletCharCode
+    else
+      SetItemMark(AsMenuRef(AMenuItem.Parent.Handle), AMenuItem.MenuIndex + 1,
+        Char(kCheckCharCode));}
+  end
+  else
+    if AMenuItem.Count = 0 then
+      SetItemMark(AsMenuRef(AMenuItem.Parent.Handle), AMenuItem.MenuIndex + 1, #0);
+  FPCMacOSAll.CheckMenuItem(AsMenuRef(AMenuItem.Parent.Handle), AMenuItem.MenuIndex + 1,
+    AMenuItem.Checked);
+
+  Result := True;
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSMenuItem.SetEnable
+  Params:  AMenuItem - LCL menu item
+           Enabled   - Menu item enabled
+  Returns: If the function succeeds
+
+  Sets the enabled of menu item in Carbon interface
+  TODO: disable menu bar items
+ ------------------------------------------------------------------------------}
+class function TCarbonWSMenuItem.SetEnable(const AMenuItem: TMenuItem;
+  const Enabled: boolean): boolean;
+begin
+  Result := False;
+  if not CheckMenuItem(AMenuItem, 'SetEnable') then Exit;
+  if not CheckMenuItem(AMenuItem.Parent, 'SetEnable', 'Parent') then Exit;
+
+  TCarbonMenu(AMenuItem.Handle).SetEnable(Enabled);
+  
+  Result := True;
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSMenuItem.SetRadioItem
+  Params:  AMenuItem - LCL menu item
+           RadioItem - Menu item has radio
+  Returns: If the function succeeds
+
+  Sets the radio behaviour of menu item in Carbon interface
+ ------------------------------------------------------------------------------}
+class function TCarbonWSMenuItem.SetRadioItem(const AMenuItem: TMenuItem;
+  const RadioItem: boolean): boolean;
+begin
+  Result := SetCheck(AMenuItem, AMenuItem.Checked);
+end;
+
+{ TCarbonWSPopupMenu }
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSPopupMenu.Popup
+  Params:  APopupMenu - LCL popup menu
+           X, Y       - Screen coordinates to popup
+  Returns: Nothing
+
+  Creates new menu in Carbon interface
+ ------------------------------------------------------------------------------}
+class procedure TCarbonWSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X,
+  Y: integer);
+begin
+  if not CheckMenu(APopupMenu.Handle, 'TCarbonWSPopupMenu.Popup') then Exit;
+  
+  PopUpMenuSelect(AsMenuRef(APopupMenu.Handle), Y, X, 0);
+end;                                         // ^- order top, left is correct!
+
 initialization
 
 ////////////////////////////////////////////////////
@@ -82,9 +345,9 @@ initialization
 // To improve speed, register only classes
 // which actually implement something
 ////////////////////////////////////////////////////
-//  RegisterWSComponent(TMenuItem, TCarbonWSMenuItem);
+  RegisterWSComponent(TMenuItem, TCarbonWSMenuItem);
-//  RegisterWSComponent(TMenu, TCarbonWSMenu);
+  RegisterWSComponent(TMenu, TCarbonWSMenu);
 //  RegisterWSComponent(TMainMenu, TCarbonWSMainMenu);
-//  RegisterWSComponent(TPopupMenu, TCarbonWSPopupMenu);
+  RegisterWSComponent(TPopupMenu, TCarbonWSPopupMenu);
 ////////////////////////////////////////////////////
 end.

lcl/interfaces/carbon/carbonwsstdctrls.pp

@@ -286,7 +286,7 @@ end;
  ------------------------------------------------------------------------------}
 class procedure TCarbonWSScrollBar.SetParams(const AScrollBar: TCustomScrollBar);
 begin
-  if not WSCheckHandleAllocated(AScrollBar, 'SetParams') then Exit;
+  if not CheckHandle(AScrollBar, Self, 'SetParams') then Exit;
   
   TCarbonCustomBar(AScrollBar.Handle).SetData(AScrollBar.Position,
     AScrollBar.Min, AScrollBar.Max, AScrollBar.PageSize);
@@ -333,7 +333,7 @@ class function TCarbonWSCustomComboBox.GetSelStart(
   const ACustomComboBox: TCustomComboBox): integer;
 begin
   Result := 0;
-  if not WSCheckHandleAllocated(ACustomComboBox, 'GetSelStart') then Exit;
+  if not CheckHandle(ACustomComboBox, Self, 'GetSelStart') then Exit;
 
   TCarbonComboBox(ACustomComboBox.Handle).GetSelStart(Result);
 end;
@@ -347,7 +347,7 @@ class function TCarbonWSCustomComboBox.GetSelLength(
   const ACustomComboBox: TCustomComboBox): integer;
 begin
   Result := 0;
-  if not WSCheckHandleAllocated(ACustomComboBox, 'GetSelLength') then Exit;
+  if not CheckHandle(ACustomComboBox, Self, 'GetSelLength') then Exit;
 
   TCarbonComboBox(ACustomComboBox.Handle).GetSelLength(Result);
 end;
@@ -361,7 +361,7 @@ class function TCarbonWSCustomComboBox.GetItemIndex(
   const ACustomComboBox: TCustomComboBox): integer;
 begin
   Result := -1;
-  if not WSCheckHandleAllocated(ACustomComboBox, 'GetItemIndex') then Exit;
+  if not CheckHandle(ACustomComboBox, Self, 'GetItemIndex') then Exit;
 
   Result := TCarbonComboBox(ACustomComboBox.Handle).GetItemIndex;
 end;
@@ -375,7 +375,7 @@ class function TCarbonWSCustomComboBox.GetMaxLength(
   const ACustomComboBox: TCustomComboBox): integer;
 begin
   Result := 0;
-  if not WSCheckHandleAllocated(ACustomComboBox, 'GetMaxLength') then Exit;
+  if not CheckHandle(ACustomComboBox, Self, 'GetMaxLength') then Exit;
 
   Result := TCarbonComboBox(ACustomComboBox.Handle).MaxLength;
 end;
@@ -391,7 +391,7 @@ end;
 class procedure TCarbonWSCustomComboBox.SetSelStart(
   const ACustomComboBox: TCustomComboBox; NewStart: integer);
 begin
-  if not WSCheckHandleAllocated(ACustomComboBox, 'SetSelStart') then Exit;
+  if not CheckHandle(ACustomComboBox, Self, 'SetSelStart') then Exit;
 
   TCarbonComboBox(ACustomComboBox.Handle).SetSelStart(NewStart);
 end;
@@ -407,7 +407,7 @@ end;
 class procedure TCarbonWSCustomComboBox.SetSelLength(
   const ACustomComboBox: TCustomComboBox; NewLength: integer);
 begin
-    if not WSCheckHandleAllocated(ACustomComboBox, 'SetSelLength') then Exit;
+    if not CheckHandle(ACustomComboBox, Self, 'SetSelLength') then Exit;
 
   TCarbonComboBox(ACustomComboBox.Handle).SetSelLength(NewLength);
 end;
@@ -423,7 +423,7 @@ end;
 class procedure TCarbonWSCustomComboBox.SetItemIndex(
   const ACustomComboBox: TCustomComboBox; NewIndex: integer);
 begin
-  if not WSCheckHandleAllocated(ACustomComboBox, 'SetItemIndex') then Exit;
+  if not CheckHandle(ACustomComboBox, Self, 'SetItemIndex') then Exit;
 
   TCarbonComboBox(ACustomComboBox.Handle).SetItemIndex(NewIndex);
 end;
@@ -439,7 +439,7 @@ end;
 class procedure TCarbonWSCustomComboBox.SetMaxLength(
   const ACustomComboBox: TCustomComboBox; NewLength: integer);
 begin
-  if not WSCheckHandleAllocated(ACustomComboBox, 'SetMaxLength') then Exit;
+  if not CheckHandle(ACustomComboBox, Self, 'SetMaxLength') then Exit;
 
   // text is cropped in callback
   TCarbonComboBox(ACustomComboBox.Handle).MaxLength := NewLength;
@@ -454,7 +454,7 @@ class function TCarbonWSCustomComboBox.GetItems(
   const ACustomComboBox: TCustomComboBox): TStrings;
 begin
   Result := nil;
-  if not WSCheckHandleAllocated(ACustomComboBox, 'GetItems') then Exit;
+  if not CheckHandle(ACustomComboBox, Self, 'GetItems') then Exit;
 
   Result := TCarbonComboBoxStrings.Create(TCarbonComboBox(ACustomComboBox.Handle));
 end;
@@ -471,7 +471,7 @@ end;
 class procedure TCarbonWSCustomComboBox.Sort(
   const ACustomComboBox: TCustomComboBox; AList: TStrings; IsSorted: boolean);
 begin
-  if not WSCheckHandleAllocated(ACustomComboBox, 'Sort') then Exit;
+  if not CheckHandle(ACustomComboBox, Self, 'Sort') then Exit;
   
   TCarbonComboBoxStrings(AList).Sorted := IsSorted;
 end;
@@ -505,7 +505,7 @@ var
   List: ListHandle;
 begin
   Result := 0;
-  if not WSCheckHandleAllocated(ACustomListBox, 'GetSelCount') then Exit;
+  if not CheckHandle(ACustomListBox, Self, 'GetSelCount') then Exit;
   
   List := TCarbonListBox(ACustomListBox.Handle).List;
   Item.h := 0;
@@ -529,7 +529,7 @@ var
   Item: Cell;
 begin
   Result := False;
-  if not WSCheckHandleAllocated(ACustomListBox, 'GetSelected') then Exit;
+  if not CheckHandle(ACustomListBox, Self, 'GetSelected') then Exit;
 
   Item.h := 0;
   Item.v := AIndex;
@@ -545,7 +545,7 @@ class function TCarbonWSCustomListBox.GetStrings(
   const ACustomListBox: TCustomListBox): TStrings;
 begin
   Result := nil;
-  if not WSCheckHandleAllocated(ACustomListBox, 'GetStrings') then Exit;
+  if not CheckHandle(ACustomListBox, Self, 'GetStrings') then Exit;
   
   Result := TCarbonListBoxStrings.Create(TCarbonListBox(ACustomListBox.Handle));
 end;
@@ -559,7 +559,7 @@ class function TCarbonWSCustomListBox.GetItemIndex(
   const ACustomListBox: TCustomListBox): integer;
 begin
   Result := -1;
-  if not WSCheckHandleAllocated(ACustomListBox, 'GetItemIndex') then Exit;
+  if not CheckHandle(ACustomListBox, Self, 'GetItemIndex') then Exit;
   
   Result := TCarbonListBox(ACustomListBox.Handle).GetItemIndex;
 end;
@@ -575,7 +575,7 @@ var
   Bounds: FPCMacOSAll.Rect;
 begin
   Result := 0;
-  if not WSCheckHandleAllocated(ACustomListBox, 'GetTopIndex') then Exit;
+  if not CheckHandle(ACustomListBox, Self, 'GetTopIndex') then Exit;
 
   if GetListViewBounds(TCarbonListBox(ACustomListBox.Handle).List,
     Bounds) <> nil then Result := Bounds.top;
@@ -596,7 +596,7 @@ class procedure TCarbonWSCustomListBox.SelectItem(
 var
   Item: Cell;
 begin
-  if not WSCheckHandleAllocated(ACustomListBox, 'SelectItem') then Exit;
+  if not CheckHandle(ACustomListBox, Self, 'SelectItem') then Exit;
 
   Item.h := 0;
   Item.v := AIndex;
@@ -614,7 +614,7 @@ end;
 class procedure TCarbonWSCustomListBox.SetItemIndex(
   const ACustomListBox: TCustomListBox; const AIndex: integer);
 begin
-  if not WSCheckHandleAllocated(ACustomListBox, 'SetItemIndex') then Exit;
+  if not CheckHandle(ACustomListBox, Self, 'SetItemIndex') then Exit;
 
   TCarbonListBox(ACustomListBox.Handle).SetItemIndex(AIndex);
 end;
@@ -634,7 +634,7 @@ class procedure TCarbonWSCustomListBox.SetSelectionMode(
 var
   Options: OptionBits;
 begin
-  if not WSCheckHandleAllocated(ACustomListBox, 'SetSelectionMode') then Exit;
+  if not CheckHandle(ACustomListBox, Self, 'SetSelectionMode') then Exit;
 
   if AMultiSelect then
   begin
@@ -671,7 +671,7 @@ end;
 class procedure TCarbonWSCustomListBox.SetSorted(
   const ACustomListBox: TCustomListBox; AList: TStrings; ASorted: boolean);
 begin
-  if not WSCheckHandleAllocated(ACustomListBox, 'SetSorted') then Exit;
+  if not CheckHandle(ACustomListBox, Self, 'SetSorted') then Exit;
   
   TCarbonListBoxStrings(AList).Sorted := ASorted;
 end;
@@ -689,7 +689,7 @@ class procedure TCarbonWSCustomListBox.SetTopIndex(
 var
   Bounds: FPCMacOSAll.Rect;
 begin
-  if not WSCheckHandleAllocated(ACustomListBox, 'SetTopIndex') then Exit;
+  if not CheckHandle(ACustomListBox, Self, 'SetTopIndex') then Exit;
 
   if GetListViewBounds(TCarbonListBox(ACustomListBox.Handle).List,
     Bounds) <> nil then
@@ -724,7 +724,7 @@ end;
 class function TCarbonWSCustomEdit.GetSelStart(const ACustomEdit: TCustomEdit): integer;
 begin
   Result := 0;
-  if not WSCheckHandleAllocated(ACustomEdit, 'GetSelStart') then Exit;
+  if not CheckHandle(ACustomEdit, Self, 'GetSelStart') then Exit;
 
   TCarbonEdit(ACustomEdit.Handle).GetSelStart(Result);
 end;
@@ -737,7 +737,7 @@ end;
 class function TCarbonWSCustomEdit.GetSelLength(const ACustomEdit: TCustomEdit): integer;
 begin
   Result := 0;
-  if not WSCheckHandleAllocated(ACustomEdit, 'GetSelLength') then Exit;
+  if not CheckHandle(ACustomEdit, Self, 'GetSelLength') then Exit;
 
   TCarbonEdit(ACustomEdit.Handle).GetSelLength(Result);
 end;
@@ -781,7 +781,7 @@ end;
 class procedure TCarbonWSCustomEdit.SetMaxLength(const ACustomEdit: TCustomEdit;
   NewLength: integer);
 begin
-  if not WSCheckHandleAllocated(ACustomEdit, 'SetMaxLength') then Exit;
+  if not CheckHandle(ACustomEdit, Self, 'SetMaxLength') then Exit;
 
   // text is cropped in callback
   TCarbonEdit(ACustomEdit.Handle).MaxLength := NewLength;
@@ -798,7 +798,7 @@ end;
 class procedure TCarbonWSCustomEdit.SetPasswordChar(const ACustomEdit: TCustomEdit;
   NewChar: char);
 begin
-  if not WSCheckHandleAllocated(ACustomEdit, 'SetPasswordChar') then Exit;
+  if not CheckHandle(ACustomEdit, Self, 'SetPasswordChar') then Exit;
 
   if TCarbonEdit(ACustomEdit.Handle).IsPassword <> (NewChar <> #0) then
     RecreateWnd(ACustomEdit);
@@ -815,7 +815,7 @@ end;
 class procedure TCarbonWSCustomEdit.SetReadOnly(const ACustomEdit: TCustomEdit;
   NewReadOnly: boolean);
 begin
-  if not WSCheckHandleAllocated(ACustomEdit, 'SetReadOnly') then Exit;
+  if not CheckHandle(ACustomEdit, Self, 'SetReadOnly') then Exit;
 
   SetControlData(AsControlRef(ACustomEdit.Handle), kControlEntireControl,
     kControlEditTextLockedTag, SizeOf(Boolean), @NewReadOnly);
@@ -832,7 +832,7 @@ end;
 class procedure TCarbonWSCustomEdit.SetSelStart(const ACustomEdit: TCustomEdit;
   NewStart: integer);
 begin
-  if not WSCheckHandleAllocated(ACustomEdit, 'SetSelStart') then Exit;
+  if not CheckHandle(ACustomEdit, Self, 'SetSelStart') then Exit;
 
   TCarbonEdit(ACustomEdit.Handle).SetSelStart(NewStart);
 end;
@@ -848,7 +848,7 @@ end;
 class procedure TCarbonWSCustomEdit.SetSelLength(const ACustomEdit: TCustomEdit;
   NewLength: integer);
 begin
-  if not WSCheckHandleAllocated(ACustomEdit, 'SetSelLength') then Exit;
+  if not CheckHandle(ACustomEdit, Self, 'SetSelLength') then Exit;
 
   TCarbonEdit(ACustomEdit.Handle).SetSelLength(NewLength);
 end;
@@ -878,7 +878,7 @@ class function TCarbonWSCustomMemo.GetStrings(const ACustomMemo: TCustomMemo
   ): TStrings;
 begin
   Result := nil;
-  if not WSCheckHandleAllocated(ACustomMemo, 'GetStrings') then Exit;
+  if not CheckHandle(ACustomMemo, Self, 'GetStrings') then Exit;
 
   Result := TCarbonMemoStrings.Create(TCarbonMemo(ACustomMemo.Handle));
 end;
@@ -896,7 +896,7 @@ class procedure TCarbonWSCustomMemo.AppendText(const ACustomMemo: TCustomMemo;
 var
   S: String;
 begin
-  if not WSCheckHandleAllocated(ACustomMemo, 'AppendText') then Exit;
+  if not CheckHandle(ACustomMemo, Self, 'AppendText') then Exit;
 
   if Length(AText) > 0 then
   begin
@@ -916,7 +916,7 @@ end;
 class procedure TCarbonWSCustomMemo.SetPasswordChar(
   const ACustomEdit: TCustomEdit; NewChar: char);
 begin
-  if not WSCheckHandleAllocated(ACustomEdit, 'SetPasswordChar') then Exit;
+  if not CheckHandle(ACustomEdit, Self, 'SetPasswordChar') then Exit;
 
   TXNEchoMode(HITextViewGetTXNObject(AsControlRef(ACustomEdit.Handle)),
     UniChar(NewChar), CreateTextEncoding(kTextEncodingUnicodeDefault,
@@ -936,7 +936,7 @@ end;
 class procedure TCarbonWSCustomMemo.SetScrollbars(
   const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle);
 begin
-  if not WSCheckHandleAllocated(ACustomMemo, 'SetScrollbars') then Exit;
+  if not CheckHandle(ACustomMemo, Self, 'SetScrollbars') then Exit;
   
   TCarbonMemo(ACustomMemo.Handle).ScrollBars := NewScrollbars;
 end;
@@ -955,7 +955,7 @@ var
   Tag: TXNControlTag;
   Data: TXNControlData;
 begin
-  if not WSCheckHandleAllocated(ACustomEdit, 'SetReadOnly') then Exit;
+  if not CheckHandle(ACustomEdit, Self, 'SetReadOnly') then Exit;
 
   Tag := kTXNNoUserIOTag;
   if NewReadOnly then
@@ -981,7 +981,7 @@ var
   Tag: TXNControlTag;
   Data: TXNControlData;
 begin
-  if not WSCheckHandleAllocated(ACustomMemo, 'SetWordWrap') then Exit;
+  if not CheckHandle(ACustomMemo, Self, 'SetWordWrap') then Exit;
 
   Tag := kTXNWordWrapStateTag;
   if NewWordWrap then
@@ -1022,7 +1022,7 @@ class function TCarbonWSCustomCheckBox.RetrieveState(
   const ACustomCheckBox: TCustomCheckBox): TCheckBoxState;
 begin
   Result := cbUnchecked;
-  if not WSCheckHandleAllocated(ACustomCheckBox, 'RetrieveState') then Exit;
+  if not CheckHandle(ACustomCheckBox, Self, 'RetrieveState') then Exit;
 
   case GetControl32BitValue(AsControlRef(ACustomCheckBox.Handle)) of
     kControlCheckBoxCheckedValue   : Result := cbChecked;
@@ -1044,7 +1044,7 @@ class procedure TCarbonWSCustomCheckBox.SetState(
 var
   Value: UInt32;
 begin
-  if not WSCheckHandleAllocated(ACustomCheckBox, 'SetState') then Exit;
+  if not CheckHandle(ACustomCheckBox, Self, 'SetState') then Exit;
 
   case NewState of
     cbChecked  : Value := kControlCheckBoxCheckedValue;
@@ -1117,7 +1117,7 @@ class procedure TCarbonWSCustomStaticText.SetAlignment(
 var
   FontStyle: ControlFontStyleRec;
 begin
-  if not WSCheckHandleAllocated(ACustomStaticText, 'SetAlignment') then Exit;
+  if not CheckHandle(ACustomStaticText, Self, 'SetAlignment') then Exit;
 
   // get static text font style and change only justification
   GetControlData(AsControlRef(ACustomStaticText.Handle), kControlEntireControl,