Merge branch 'main' into 'main'

Solved GTK2 TMenuItem.Default property does not works #41528

See merge request freepascal.org/lazarus/lazarus!449

lcl/include/menuitem.inc

@@ -1309,9 +1309,12 @@ begin
     // Only one item in a menu or submenu can be default.
     for i:=0 to FParent.Count-1 do
       if FParent[i].Default then
-        FParent[i].FDefault := False;
+        FParent[i].Default := False;
   FDefault:= AValue;
-  MenuChanged(True);
+  if HandleAllocated and not (csReading in ComponentState) and ((FParent <> nil) or (FMenu = nil)) then
+    TWSMenuItemClass(WidgetSetClass).SetDefault(Self, AValue);
+  MenuChanged(False);
+  OwnerFormDesignerModified(Self);
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/gtk2/gtk2int.pas

@@ -302,7 +302,9 @@ type
     procedure _SetCallbackEx(const AMsg: LongInt; const AGTKObject: PGTKObject; const ALCLObject: TObject; Direct: Boolean);
     procedure SetCallbackEx(const AMsg: LongInt; const AGTKObject: PGTKObject; const ALCLObject: TObject; Direct: Boolean);
     procedure SetCommonCallbacks(const AGTKObject: PGTKObject; const ALCLObject: TObject);
-    procedure SetLabelCaption(const ALabel: PGtkLabel; const ACaption: String);
+    function SetLabelCaption(const ALabel: PGtkLabel; const ACaption: String): String;
+    function SetLabelCaptionMarkup(const ALabel: PGtkLabel; const ACaption: String;
+                                   AmpersandsEscape: Boolean=True; MarkupsEscape: Boolean=True): String;
     procedure SetSelectionMode(Sender: TObject; Widget: PGtkWidget;
       MultiSelect, {%H-}ExtendedSelect: Boolean);
     function ForceLineBreaks(DC : hDC; Src: PChar; MaxWidthInPixels : Longint;

lcl/interfaces/gtk2/gtk2proc.inc

@@ -6023,11 +6023,17 @@ var
     MenuItemWidget: PGtkWidget);
   var
     LabelWidget: PGtkLabel;
+    s: String;
   begin
     if (MenuItemWidget = nil) or (LCLMenuItem = nil) then
       Exit;
     LabelWidget := g_object_get_data(PGObject(MenuItemWidget), 'LCLLabel');
-    Gtk2Widgetset.SetLabelCaption(LabelWidget, LCLMenuItem.Caption);
+    if LCLMenuItem.Default then
+         Gtk2Widgetset.SetLabelCaptionMarkup(LabelWidget,
+                          '<b>'+EscapeMarkups(Ampersands2Underscore(LCLMenuItem.Caption))+'</b>',
+                          False, False)
+    else Gtk2Widgetset.SetLabelCaption(LabelWidget, LCLMenuItem.Caption);
+
     gtk_widget_set_direction(PGtkWidget(LabelWidget), WidgetDirection[UseRTL]);
   end;
   
@@ -6057,15 +6063,24 @@ var
       if LabelWidget = nil then
       begin
         // create a label for the ShortCut
-        LabelWidget := PGtkLabel(gtk_label_new(PChar(Pointer(s))));
+        LabelWidget := PGtkLabel(gtk_label_new(''));
         g_object_set_data(PGObject(MenuItemWidget), 'LCLShortCutLabel', LabelWidget);
+        gtk_label_set_use_markup(LabelWidget, True);
         gtk_container_add(GTK_CONTAINER(HBoxWidget), PGtkWidget(LabelWidget));
+
+        if LCLMenuItem.Default then
+             gtk_label_set_markup(LabelWidget, PChar('<b>'+EscapeMarkups(s)+'</b>'))
+        else gtk_label_set_text(LabelWidget, PChar(s));
+
         gtk_widget_show(PGtkWidget(LabelWidget));
       end
       else
       begin
-        gtk_label_set_text(LabelWidget, PChar(Pointer(s)));
+        if LCLMenuItem.Default then
+             gtk_label_set_markup(LabelWidget, PChar('<b>'+EscapeMarkups(s)+'</b>'))
+        else gtk_label_set_text(LabelWidget, PChar(s));
       end;
+
       gtk_widget_set_direction(PGtkWidget(LabelWidget), GTK_TEXT_DIR_LTR); //Shortcut always LTR
       if UseRTL then
         gtk_misc_set_alignment(GTK_MISC(LabelWidget), 0.0, 0.5)
@@ -6114,6 +6129,8 @@ var
     gtk_container_add(GTK_CONTAINER(HBoxWidget), PGtkWidget(LabelWidget));
     SetMenuItemLabelText(LCLMenuItem, MenuItemWidget);
     //gtk_accel_label_set_accel_widget(GTK_ACCEL_LABEL(LabelWidget), MenuItemWidget);
+    gtk_label_set_use_underline(LabelWidget, True);
+    gtk_label_set_use_markup(LabelWidget, True);
     gtk_widget_show(PGtkWidget(LabelWidget));
   end;
   
@@ -9162,6 +9179,19 @@ begin
   end;
 end;
 
+function EscapeMarkups(const Str: String): String;
+var
+  s_escaped: Pgchar;
+
+begin
+  s_escaped:= g_markup_escape_text(PChar(Str), Length(Str));
+
+  //MaxM: maybe #95 but even with the escape it is seen as _ and treated as mnemonic
+  Result:= StringReplace(s_escaped, '__', '&#32;', [rfReplaceAll]);
+
+  g_free(s_escaped);
+end;
+
 {-------------------------------------------------------------------------------
   Creates a new PChar. Deletes escaping ampersands, replaces the first single
   ampersand with an underscore and deletes all other single ampersands.
@@ -9182,30 +9212,32 @@ end;
 -------------------------------------------------------------------------------}
 function Ampersands2Underscore(const ASource: String): String;
 var
-  n: Integer;
+  n, len: Integer;
   FirstFound: Boolean;
+  s: String;
 begin
   //TODO: escape underscores
   FirstFound := False;
-  Result := ASource;
   n := 1;
-  while n <= Length(Result) do
+  Result:= '';
+  len:= Length(ASource);
+  while n <= len do
   begin
-    if Result[n] = '&' then
-    begin
-      if FirstFound
-      or ( (n < Length(Result)) and (Result[n+1] = '&') ) // got &&
-      then begin
-        Delete(Result, n, 1);
-        if not FirstFound then
-          Inc(n);               // Skip the second & of &&
-      end
-      else begin
-        FirstFound := True;
-        Result[n] := '_';
-      end;
+    case ASource[n] of
+      '_': Result := Result + '__';
+      '&': if (n < len) and (ASource[n+1] = '&') then // got &&
+           begin
+             Result:= Result + '&';
+             Inc(n);               // Skip the second & of &&
+            end
+           else if not(FirstFound) then
+                begin
+                  Result:= Result+ '_';
+                  FirstFound:= True;
+                end;
+      else Result:= Result+ ASource[n];
     end;
-    Inc(n);
+    inc(n);
   end;
 end;
 

lcl/interfaces/gtk2/gtk2proc.pp

@@ -591,6 +591,9 @@ procedure ConnectInternalWidgetsSignals(AWidget: PGtkWidget;
 
 //--
 
+// markups
+function EscapeMarkups(const Str: String): String;
+
 // accelerators
 function Ampersands2Underscore(Src: PChar): PChar;
 function Ampersands2Underscore(const ASource: String): String;

lcl/interfaces/gtk2/gtk2widgetset.inc

@@ -950,32 +950,22 @@ begin
   ConnectSignal(AGTKObject,'grab-notify',@gtk2GrabNotify, ALCLObject);
 end;
 
-procedure TGtk2WidgetSet.SetLabelCaption(const ALabel: PGtkLabel;
-  const ACaption: String);
-var
-  s: String;
-  i: Integer;
+function TGtk2WidgetSet.SetLabelCaption(const ALabel: PGtkLabel;
+  const ACaption: String): String;
 begin
-  s := '';
-  i := 1;
-  while i <=  Length(ACaption) do
-  begin
-    case ACaption[i] of
-      '_': s := s + '__';
-      '&':
-        if (i < Length(ACaption)) and (ACaption[i + 1] = '&') then
-        begin
-          s := s + '&';
-          inc(i);
-        end
-        else
-          s := s + '_';
-    else
-      s := s + ACaption[i];
-    end;
-    inc(i);
-  end;
-  gtk_label_set_text_with_mnemonic(ALabel, PChar(s));
+  Result:= Ampersands2Underscore(ACaption);
+  gtk_label_set_text_with_mnemonic(ALabel, PChar(Result));
+end;
+
+function TGtk2WidgetSet.SetLabelCaptionMarkup(const ALabel: PGtkLabel;
+  const ACaption: String; AmpersandsEscape: Boolean; MarkupsEscape: Boolean): String;
+begin
+  Result:= ACaption;
+  if AmpersandsEscape then Result:= Ampersands2Underscore(Result);
+  if MarkupsEscape then Result:= EscapeMarkups(Result);
+
+  gtk_label_set_use_markup(ALabel, True);
+  gtk_label_set_markup_with_mnemonic(ALabel, PChar(Result));
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/gtk2/gtk2wsmenus.pp

@@ -44,6 +44,7 @@ type
     class procedure SetShortCut(const AMenuItem: TMenuItem; const ShortCutK1, ShortCutK2: 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 SetDefault(const AMenuItem: TMenuItem; const ADefault: boolean): boolean; override;
     class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override;
     class function SetRadioItem(const AMenuItem: TMenuItem; const {%H-}RadioItem: boolean): boolean; override;
     class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override;
@@ -452,6 +453,23 @@ begin
   end;
 end;
 
+class function TGtk2WSMenuItem.SetDefault(const AMenuItem: TMenuItem; const ADefault: boolean): boolean;
+var
+   MenuItemWidget: PGtkWidget;
+
+begin
+  Result:= False;
+
+  if not WSCheckMenuItem(AMenuItem, 'SetDefault') then
+      Exit;
+
+  MenuItemWidget:={%H-}PGtkWidget(AMenuItem.Handle);
+  UpdateInnerMenuItem(AMenuItem,MenuItemWidget);
+//  gtk_widget_set_sensitive({%H-}PGtkWidget(AMenuItem.Handle), AMenuItem.Enabled);
+
+  Result:= True;
+end;
+
 class function TGtk2WSMenuItem.SetEnable(const AMenuItem: TMenuItem;
   const Enabled: boolean): boolean;
 begin

lcl/interfaces/qt5/qtwidgets.pas

@@ -107,6 +107,7 @@ type
 
   TQtWidget = class(TQtObject, IUnknown)
   private
+    FDefaultFocusReason: QtFocusReason;
     FInResizeEvent: boolean;
     FWidgetState: TQtWidgetStates;
     FWidgetDefaultFont: TQtFont;
@@ -319,6 +320,7 @@ type
       nil): QPixmapH;
     property ChildOfComplexWidget: TChildOfComplexWidget read FChildOfComplexWidget write FChildOfComplexWidget;
     property Context: HDC read GetContext;
+    property DefaultFocusReason: QtFocusReason read FDefaultFocusReason write FDefaultFocusReason;
     property HasCaret: Boolean read FHasCaret write SetHasCaret;
     property HasPaint: Boolean read FHasPaint write FHasPaint;
     property InResizeEvent: boolean read FInResizeEvent write FInResizeEvent;
@@ -2161,6 +2163,7 @@ end;
 
 procedure TQtWidget.InitializeWidget;
 begin
+  FDefaultFocusReason := QtTabFocusReason;
   FInResizeEvent := False;
   // default states
   FWidgetState := [];
@@ -5164,7 +5167,7 @@ end;
 procedure TQtWidget.setFocus;
 begin
   if getFocusPolicy <> QtNoFocus then
-    QWidget_setFocus(Widget, QtTabFocusReason) {issue #10155}
+    QWidget_setFocus(Widget, FDefaultFocusReason) {issue #10155}
   else
     QWidget_setFocus(Widget);
 end;
@@ -9769,6 +9772,7 @@ begin
   FCachedSelectionLen := -1;
   FIntValidator := nil;
   FNumbersOnly := False;
+  FDefaultFocusReason := QtOtherFocusReason;
   if AParams.WndParent <> 0 then
     Parent := TQtWidget(AParams.WndParent).GetContainerWidget
   else
@@ -16412,6 +16416,7 @@ end;
 
 procedure TQtMenu.InitializeWidget;
 begin
+  FDefaultFocusReason := QtTabFocusReason;
   FWidgetState := [];
   ChildOfComplexWidget := ccwNone;
   WidgetColorRole := QPaletteWindow;

lcl/interfaces/qt6/qtwidgets.pas

@@ -107,6 +107,7 @@ type
 
   TQtWidget = class(TQtObject, IUnknown)
   private
+    FDefaultFocusReason: QtFocusReason;
     FInResizeEvent: boolean;
     FWidgetState: TQtWidgetStates;
     FWidgetDefaultFont: TQtFont;
@@ -316,6 +317,7 @@ type
       nil): QPixmapH;
     property ChildOfComplexWidget: TChildOfComplexWidget read FChildOfComplexWidget write FChildOfComplexWidget;
     property Context: HDC read GetContext;
+    property DefaultFocusReason: QtFocusReason read FDefaultFocusReason write FDefaultFocusReason;
     property HasCaret: Boolean read FHasCaret write SetHasCaret;
     property HasPaint: Boolean read FHasPaint write FHasPaint;
     property InResizeEvent: boolean read FInResizeEvent write FInResizeEvent;
@@ -2158,6 +2160,7 @@ end;
 
 procedure TQtWidget.InitializeWidget;
 begin
+  FDefaultFocusReason := QtTabFocusReason;
   FInResizeEvent := False;
   // default states
   FWidgetState := [];
@@ -5168,7 +5171,7 @@ end;
 procedure TQtWidget.setFocus;
 begin
   if getFocusPolicy <> QtNoFocus then
-    QWidget_setFocus(Widget, QtTabFocusReason) {issue #10155}
+    QWidget_setFocus(Widget, FDefaultFocusReason) {issue #10155}
   else
     QWidget_setFocus(Widget);
 end;
@@ -9725,6 +9728,7 @@ begin
   FCachedSelectionLen := -1;
   FIntValidator := nil;
   FNumbersOnly := False;
+  FDefaultFocusReason := QtOtherFocusReason;
   if AParams.WndParent <> 0 then
     Parent := TQtWidget(AParams.WndParent).GetContainerWidget
   else
@@ -16322,6 +16326,7 @@ end;
 
 procedure TQtMenu.InitializeWidget;
 begin
+  FDefaultFocusReason := QtTabFocusReason;
   FWidgetState := [];
   ChildOfComplexWidget := ccwNone;
   WidgetColorRole := QPaletteWindow;

lcl/widgetset/wsmenus.pp

@@ -59,6 +59,7 @@ type
     class procedure SetShortCut(const AMenuItem: TMenuItem; const ShortCutK1, ShortCutK2: TShortCut); virtual;
     class procedure SetVisible(const AMenuItem: TMenuItem; const Visible: boolean); virtual;
     class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; virtual;
+    class function SetDefault(const AMenuItem: TMenuItem; const ADefault: boolean): boolean; virtual;
     class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; virtual;
     class function SetRadioItem(const AMenuItem: TMenuItem; const RadioItem: boolean): boolean; virtual;
     class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; virtual;
@@ -157,6 +158,11 @@ begin
   Result := false;
 end;
 
+class function TWSMenuItem.SetDefault(const AMenuItem: TMenuItem; const ADefault: boolean): boolean;
+begin
+  Result := false;
+end;
+
 class function TWSMenuItem.SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean;
 begin
   Result := false;