codetools, TSynPasSyn: aded bitpacked keyword

git-svn-id: trunk@11173 -

components/codetools/finddeclarationtool.pas

@@ -3963,7 +3963,7 @@ begin
   // search the ancestor name
   MoveCursorToNodeStart(ClassNode);
   ReadNextAtom; // read keyword 'class', 'object', 'interface', 'dispinterface'
-  if UpAtomIs('PACKED') then ReadNextAtom;
+  if UpAtomIs('PACKED') or (UpAtomIs('BITPACKED')) then ReadNextAtom;
   ReadNextAtom;
   ClassIdentNode:=ClassNode.GetNodeOfType(ctnTypeDefinition);
   if AtomIsChar('(') then begin

components/codetools/keywordfunclists.pas

@@ -106,6 +106,7 @@ var
   WordIsBlockKeyWord,
   EndKeyWordFuncList,
   PackedTypesKeyWordFuncList,
+  BitPackedTypesKeyWordFuncList,
   GenericTypesKeyWordFuncList,
   BlockStatementStartKeyWordFuncList,
   WordIsLogicalBlockStart,
@@ -1016,6 +1017,17 @@ begin
     Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
   end;
   
+  BitPackedTypesKeyWordFuncList:=TKeyWordFunctionList.Create;
+  KeyWordLists.Add(BitPackedTypesKeyWordFuncList);
+  with BitPackedTypesKeyWordFuncList do begin
+    Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('OBJECT',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('DISPINTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('ARRAY',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('SET',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
+  end;
+
   GenericTypesKeyWordFuncList:=TKeyWordFunctionList.Create;
   KeyWordLists.Add(GenericTypesKeyWordFuncList);
   with GenericTypesKeyWordFuncList do begin

components/codetools/pascalparsertool.pas

@@ -139,6 +139,7 @@ type
     function KeyWordFuncClass: boolean;
     function KeyWordFuncClassInterface: boolean;
     function KeyWordFuncTypePacked: boolean;
+    function KeyWordFuncTypeBitPacked: boolean;
     function KeyWordFuncGeneric: boolean;
     function KeyWordFuncSpecialize: boolean;
     function KeyWordFuncTypeArray: boolean;
@@ -162,6 +163,7 @@ type
     function KeyWordFuncClassIdentifier: boolean;
     function KeyWordFuncClassVarTypeClass: boolean;
     function KeyWordFuncClassVarTypePacked: boolean;
+    function KeyWordFuncClassVarTypeBitPacked: boolean;
     function KeyWordFuncClassVarTypeRecord: boolean;
     function KeyWordFuncClassVarTypeArray: boolean;
     function KeyWordFuncClassVarTypeSet: boolean;
@@ -369,6 +371,7 @@ begin
     Add('INTERFACE',@KeyWordFuncClassInterface);
     Add('DISPINTERFACE',@KeyWordFuncClassInterface);
     Add('PACKED',@KeyWordFuncTypePacked);
+    Add('BITPACKED',@KeyWordFuncTypeBitPacked);
     Add('GENERIC',@KeyWordFuncGeneric);
     Add('SPECIALIZE',@KeyWordFuncSpecialize);
     Add('ARRAY',@KeyWordFuncTypeArray);
@@ -416,6 +419,7 @@ begin
     Add('CLASS',@KeyWordFuncClassVarTypeClass);
     Add('OBJECT',@KeyWordFuncClassVarTypeClass);
     Add('PACKED',@KeyWordFuncClassVarTypePacked);
+    Add('BITPACKED',@KeyWordFuncClassVarTypeBitPacked);
     Add('RECORD',@KeyWordFuncClassVarTypeRecord);
     Add('ARRAY',@KeyWordFuncClassVarTypeArray);
     Add('SET',@KeyWordFuncClassVarTypeSet);
@@ -609,7 +613,7 @@ begin
     // first parse the inheritage
     // read the "class"/"object" keyword
     ReadNextAtom;
-    if UpAtomIs('PACKED') then ReadNextAtom;
+    if UpAtomIs('PACKED') or (UpAtomIs('BITPACKED')) then ReadNextAtom;
     if (not UpAtomIs('CLASS')) and (not UpAtomIs('OBJECT')) then
       RaiseClassKeyWordExpected;
     ReadNextAtom;
@@ -800,6 +804,18 @@ begin
   end;
 end;
 
+function TPascalParserTool.KeyWordFuncClassVarTypeBitPacked: boolean;
+// 'bitpacked' array
+begin
+  ReadNextAtom;
+  if UpAtomIs('ARRAY') then
+    Result:=KeyWordFuncClassVarTypeArray
+  else begin
+    RaiseStringExpectedButAtomFound('"array"');
+    Result:=true;
+  end;
+end;
+
 function TPascalParserTool.KeyWordFuncClassVarTypeRecord: boolean;
 { read variable type 'record'
 
@@ -2921,6 +2937,17 @@ begin
                                             CurPos.EndPos-CurPos.StartPos);
 end;
 
+function TPascalParserTool.KeyWordFuncTypeBitPacked: boolean;
+begin
+  ReadNextAtom;
+  if not BitPackedTypesKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
+    CurPos.EndPos-CurPos.StartPos)
+  then
+    RaiseStringExpectedButAtomFound('"array"');
+  Result:=TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
+                                            CurPos.EndPos-CurPos.StartPos);
+end;
+
 function TPascalParserTool.KeyWordFuncGeneric: boolean;
 // generic type
 // examples:
@@ -3040,7 +3067,7 @@ begin
   then begin
     SaveRaiseExceptionFmt(ctsAnonymDefinitionsAreNotAllowed,['class']);
   end;
-  if (LastUpAtomIs(0,'PACKED')) then begin
+  if LastUpAtomIs(0,'PACKED') or LastUpAtomIs(0,'BITPACKED') then begin
     ClassAtomPos:=LastAtoms.GetValueAt(0);
   end else begin
     ClassAtomPos:=CurPos;
@@ -3487,7 +3514,7 @@ function TPascalParserTool.KeyWordFuncTypeRecord: boolean;
 begin
   CreateChildNode;
   CurNode.Desc:=ctnRecordType;
-  if LastUpAtomIs(0,'PACKED') then
+  if LastUpAtomIs(0,'PACKED') or LastUpAtomIs(0,'BITPACKED') then
     CurNode.StartPos:=LastAtoms.GetValueAt(0).StartPos;
   // read all variables
   repeat

components/codetools/stdcodetools.pas

@@ -2503,7 +2503,7 @@ begin
   // search the ancestor name
   MoveCursorToNodeStart(ClassNode);
   ReadNextAtom; // read keyword 'class', 'object', 'interface', 'dispinterface'
-  if UpAtomIs('PACKED') then ReadNextAtom;
+  if UpAtomIs('PACKED') or UpAtomIs('BITPACKED') then ReadNextAtom;
   ReadNextAtom;
   if AtomIsChar('(') then begin
     ReadNextAtom;

components/synedit/synhighlighterpas.pp

@@ -551,10 +551,10 @@ begin
     if IsUnderScoreOrNumberChar[ToHash^] then
       inc(ToHash);
     fStringLen := PtrInt(ToHash) - PtrInt(Start);
+    //if CompareText(copy(fLineStr,fToIdent+1,fStringLen),'bitpacked')=0 then debugln('TSynPasSyn.KeyHash '+copy(fLineStr,fToIdent+1,fStringLen)+'='+dbgs(Result));
   end else begin
     fStringLen := 0;
   end;
-  //if CompareText(copy(fLineStr,fToIdent,fStringLen),'nostackframe')=0 then debugln('TSynPasSyn.KeyHash '+copy(fLineStr,fToIdent,fStringLen)+'='+dbgs(Result));
 end; { KeyHash }
 {$ELSE}
 function TSynPasSyn.KeyHash(ToHash: PChar): Integer;
@@ -866,8 +866,16 @@ end;
 
 function TSynPasSyn.Func71: TtkTokenKind;
 begin
-  if KeyComp('Stdcall') then Result := tkKey else
-    if KeyComp('Const') then Result := tkKey else Result := tkIdentifier;
+  if KeyComp('Stdcall') then
+    Result := tkKey
+  else if KeyComp('Const') then
+    Result := tkKey
+  {$IFDEF SYN_LAZARUS}
+  else if KeyComp('Bitpacked') then
+    Result := tkKey
+  {$ENDIF}
+  else
+    Result := tkIdentifier;
 end;
 
 function TSynPasSyn.Func73: TtkTokenKind;

lcl/interfaces/gtk/gtkproc.inc

@@ -791,9 +791,10 @@ var
 {$ENDIF}
 begin
   {$IFDEF GTK2}
-   If AValue then
-   GTK_Window_FullScreen(PGTKWindow(AForm.Handle)) else
-   GTK_Window_UnFullScreen(PGTKWindow(AForm.Handle));
+  If AValue then
+    GTK_Window_FullScreen(PGTKWindow(AForm.Handle))
+  else
+    GTK_Window_UnFullScreen(PGTKWindow(AForm.Handle));
   {$ENDIF}
   {$IFDEF GTK1}
   XDisplay := gdk_display;