LCL: Simplify code dealing with ampersands (&). Remove duplicate code.

git-svn-id: trunk@62493 -

components/lazutils/lazstringutils.pas

@@ -95,6 +95,7 @@ function StringCase(const AString: String; const ACase: array of String; const A
 
 // PChar
 function SamePChar(P1, P2: PChar): boolean;
+function StrLScan(P: PChar; c: Char; MaxLen: Cardinal): PChar;
 
 // Like IsValidIdent() in FPC 3.1.
 function LazIsValidIdent(const Ident: string; AllowDots: Boolean = False;
@@ -1255,6 +1256,20 @@ begin
   Result:=False;
 end;
 
+function StrLScan(P: PChar; c: Char; MaxLen: Cardinal): PChar;
+// Like StrScan() but only scan to MaxLen. Also check for Nil P before scanning.
+var
+  i: Integer;
+begin
+  Result:=Nil;
+  if P=Nil then Exit;
+  for i:=0 to MaxLen-1 do
+  begin
+    if P[i]=#0 then Exit;        // End of the string, c was not found.
+    if P[i]=c then Exit(@P[i]);  // Found!
+  end;
+end;
+
 function LazIsValidIdent(const Ident: string; AllowDots: Boolean = False;
                          StrictDots: Boolean = False): Boolean;
 // This is a copy of IsValidIdent from FPC 3.1.

lcl/forms.pp

@@ -2108,21 +2108,17 @@ var
 begin
   ACaption := Str;
   Result := false;
-  position := UTF8Pos(AmpersandChar, ACaption);
-  // if AmpersandChar is on the last position then there is nothing to underscore, ignore this character
-  while (position > 0) and (position < UTF8Length(ACaption)) do
-  begin
+  repeat
+    position := UTF8Pos(AmpersandChar, ACaption);
+    // Not found or found at the end of string. Nothing to underscore.
+    if (position <= 0) or (position >= UTF8Length(ACaption)) then break;
     FoundChar := UTF8Copy(ACaption, position+1, 1);
     // two AmpersandChar characters together are not valid hot key
-    if FoundChar <> AmpersandChar then begin
-      Result := UTF8UpperCase(UTF16ToUTF8(WideString(WideChar(VK)))) = UTF8UpperCase(FoundChar);
-      exit;
-    end
-    else begin
-      UTF8Delete(ACaption, 1, position+1);
-      position := UTF8Pos(AmpersandChar, ACaption);
-    end;
-  end;
+    if FoundChar = AmpersandChar then
+      UTF8Delete(ACaption, 1, position+1)
+    else
+      Exit(UTF8UpperCase(UTF16ToUTF8(WideString(WideChar(VK)))) = UTF8UpperCase(FoundChar));
+  until false;
 end;
 
 //==============================================================================

lcl/interfaces/gtk2/gtk2proc.inc

@@ -9071,22 +9071,16 @@ procedure GetTextExtentIgnoringAmpersands(TheFont: TGtkIntfFont;
   Str : PChar; StrLength: integer;
   lbearing, rbearing, width, ascent, descent : Pgint);
 var
-  NewStr : PChar;
-  i: integer;
+  NewStr: PChar;
 begin
-  NewStr:=Str;
-  // first check if Str contains an ampersand:
-  if (Str<>nil) then begin
-    i:=0;
-    while (Str[i]<>'&') and (i<StrLength) do inc(i);
-    if i<StrLength then begin
-      NewStr := RemoveAmpersands(Str, StrLength);
-      StrLength:=StrLen(NewStr);
-    end;
-  end;
+  // check if Str contains an ampersand before removing them all.
+  if StrLScan(Str, '&', StrLength) <> nil then
+    NewStr := RemoveAmpersands(Str, StrLength)
+  else
+    NewStr := Str;
   gdk_text_extents(TheFont, NewStr, StrLength,
                    lbearing, rBearing, width, ascent, descent);
-  if NewStr<>Str then
+  if NewStr <> Str then
     StrDispose(NewStr);
 end;
 

lcl/interfaces/gtk3/gtk3objects.pas

@@ -21,9 +21,13 @@ unit gtk3objects;
 interface
 
 uses
-  Classes, SysUtils, Graphics, types, LCLType, LCLProc, LazUTF8, IntegerList,
-  LazGtk3, LazGdk3, LazGObject2, LazPango1, LazPangoCairo1, LazGdkPixbuf2,
-  LazGLib2, LazCairo1, FPCanvas;
+  Classes, SysUtils, Types, FPCanvas,
+  // LazUtils
+  LazUTF8, IntegerList, LazStringUtils,
+  // LCL
+  LCLType, LCLProc, Graphics,
+  LazGtk3, LazGdk3, LazGObject2, LazGLib2, LazGdkPixbuf2,
+  LazPango1, LazPangoCairo1, LazCairo1;
 
 type
   TGtk3DeviceContext = class;
@@ -1874,67 +1878,6 @@ begin
   Result := StringReplace(Result, '&', '_', [rfReplaceAll]);
 end;
 
-{-------------------------------------------------------------------------------
-  function RemoveAmpersands(Src: PChar; LineLength : Longint) : PChar;
-
-  Creates a new PChar removing all escaping ampersands.
--------------------------------------------------------------------------------}
-function RemoveAmpersands(Src: PChar; LineLength : Longint) : PChar;
-var
-  i, j: Longint;
-  ShortenChars, NewLength, SrcLength: integer;
-begin
-  // count ampersands and find first ampersand
-  ShortenChars:= 0;  // chars to delete
-  SrcLength:= LineLength;
-
-  { Look for amperands. If found, check if it is an escaped ampersand.
-    If it is, don't count it in. }
-  i:=0;
-  while i<SrcLength do
-  begin
-    if Src[i] = '&' then
-    begin
-      if (i < SrcLength - 1) and (Src[i+1] = '&') then
-      begin
-        // escaping ampersand found
-        inc(ShortenChars);
-        inc(i,2);
-        Continue;
-      end
-      else
-        inc(ShortenChars);
-    end;
-    inc(i);
-  end;
-  // create new PChar
-  NewLength:= SrcLength - ShortenChars;
-
-  Result:=StrAlloc(NewLength+1); // +1 for #0 char at end
-
-  // copy string without ampersands
-  i:=0;
-  j:=0;
-  while (j < NewLength) do begin
-    if Src[i] <> '&' then begin
-      // copy normal char
-      Result[j]:= Src[i];
-    end else begin
-      // ampersand
-      if (i < (SrcLength - 1)) and (Src[i+1] = '&') then begin
-        // escaping ampersand found
-        inc(i);
-        Result[j]:='&';
-      end else
-        // delete single ampersand
-        dec(j);
-    end;
-    Inc(i);
-    Inc(j);
-  end;
-  Result[NewLength]:=#0;
-end;
-
 {-------------------------------------------------------------------------------
   function GetTextExtentIgnoringAmpersands(TheFont: PGDKFont;
     Str : PChar; StrLength: integer;
@@ -1949,24 +1892,15 @@ procedure GetTextExtentIgnoringAmpersands(TheFont: TGtk3Font;
   lbearing, rbearing, width, ascent, descent : Pgint);
 var
   NewStr : PChar;
-  i: integer;
   AMetrics: PPangoFontMetrics;
   {ACharWidth,}ATextWidth,ATextHeight: gint;
 begin
-  NewStr:=Str;
-  // first check if Str contains an ampersand:
-  if (Str<>nil) then
-  begin
-    i:=0;
-    while (Str[i]<>'&') and (i<StrLength) do inc(i);
-    if i<StrLength then
-    begin
-      NewStr := RemoveAmpersands(Str, StrLength);
-      StrLength:=StrLen(NewStr);
-    end;
-  end;
-  TheFont.Layout^.set_text(Str, StrLength);
-
+  // check if Str contains an ampersand before removing them all.
+  if StrLScan(Str, '&', StrLength) <> nil then
+    NewStr := RemoveAmpersands(Str, StrLength)
+  else
+    NewStr := Str;
+  TheFont.Layout^.set_text(NewStr, StrLength);
   // TheFont.Layout^.get_extents(@AInkRect, @ALogicalRect);
 
   AMetrics := pango_context_get_metrics(TheFont.Layout^.get_context, TheFont.Handle, TheFont.Layout^.get_context^.get_language);
@@ -1995,7 +1929,7 @@ begin
   // rBearing^ := 0;
   // gdk_text_extents(TheFont, NewStr, StrLength,
   //                 lbearing, rBearing, width, ascent, descent);
-  if NewStr<>Str then
+  if NewStr <> Str then
     StrDispose(NewStr);
   AMetrics^.unref;
 end;

lcl/interfaces/gtk3/gtk3winapi.inc

@@ -973,11 +973,7 @@ begin
       AStr := StringReplace(AStr, #9, TabString, [rfReplaceAll]);
 
     if (Flags and DT_NOPREFIX) <> DT_NOPREFIX then
-    begin
-      pIndex := DeleteAmpersands(AStr);
-      if pIndex > Length(AStr) then
-        pIndex := -1; // String ended in '&', which was deleted
-    end
+      pIndex := DeleteAmpersands(AStr)
     else
       pIndex := -1;
 

lcl/lclproc.pas

@@ -133,7 +133,7 @@ procedure CalculateLeftTopWidthHeight(X1,Y1,X2,Y2: integer;
 // Ampersands
 function DeleteAmpersands(var Str : String) : Integer;
 function RemoveAmpersands(const ASource: String): String;
-function RemoveAmpersands(Src: PChar; LineLength: Longint): PChar;
+function RemoveAmpersands(Src: PChar; var LineLength: Longint): PChar;
 
 function ComparePointers(p1, p2: Pointer): integer; inline;
 function CompareHandles(h1, h2: THandle): integer;
@@ -394,14 +394,15 @@ begin
   end;
 end;
 
-function RemoveAmpersands(Src: PChar; LineLength: Longint): PChar;
+function RemoveAmpersands(Src: PChar; var LineLength: Longint): PChar;
 var
   s: String;
 begin
   SetLength(s, LineLength);
   strlcopy(PChar(s), Src, LineLength);
   s := RemoveAmpersands(s);
-  Result := StrAlloc(Length(s)+1); // +1 for #0 char at end
+  LineLength := Length(s);
+  Result := StrAlloc(LineLength+1); // +1 for #0 char at end
   strcopy(Result, PChar(s));
 end;
 

lcl/postscriptcanvas.pas

@@ -2774,11 +2774,7 @@ var
 
 
       if (Flags and DT_NOPREFIX) <> DT_NOPREFIX then
-      begin
-        pIndex := DeleteAmpersands(AStr);
-        if pIndex > Length(AStr) then
-          pIndex := -1; // String ended in '&', which was deleted
-      end
+        pIndex := DeleteAmpersands(AStr)
       else
         pIndex := -1;