paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 03:18:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed codetools ConstSet, implemented notifying TApplication whenmenu popups

Browse Source 
git-svn-id: trunk@5776 -
This commit is contained in:
mattias 2004-08-13 10:20:19 +00:00
parent e8e2846b3e
commit 885b54ba20
10 changed files with 89 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
components/codetools/finddeclarationtool.pas
View File

@ -4691,15 +4691,6 @@ var EndPos, SubStartPos: integer;
if Result.Desc=xtContext then
DebugLn(' Result.Context.Node=',Result.Context.Node.DescAsString);
{$ENDIF}
if not (Result.Desc in [xtConstOrdInteger,xtChar,xtWideChar])
and ((Result.Desc=xtContext)
and (Result.Context.Node.Desc<>ctnEnumerationType)) then
begin
MoveCursorToCleanPos(SubStartPos);
ReadNextAtom; // read '['
ReadNextAtom;
RaiseConstExpected;
end;
end else begin
// empty set '[]'
Result.Desc:=xtNone;

50
ide/objectlists.pas
View File

@ -46,7 +46,7 @@ type
end;
P2Pointer = ^T2Pointer;
TObjectList = class
TObjectArray = class
private
FCapacity: Integer;
FCount: Integer;
@ -85,29 +85,29 @@ type
implementation
{ TObjectList }
{ TObjectArray }
function TObjectList.GetObject(Index: Integer): Pointer;
function TObjectArray.GetObject(Index: Integer): Pointer;
begin
Result:=FList[Index].Associated;
end;
procedure TObjectList.PutObject(Index: Integer; const AValue: Pointer);
procedure TObjectArray.PutObject(Index: Integer; const AValue: Pointer);
begin
FList[Index].Associated:=AValue;
end;
function TObjectList.Get(Index: Integer): Pointer;
function TObjectArray.Get(Index: Integer): Pointer;
begin
Result:=FList[Index].Item;
end;
procedure TObjectList.Put(Index: Integer; const AValue: Pointer);
procedure TObjectArray.Put(Index: Integer; const AValue: Pointer);
begin
FList[Index].Item:=AValue;
end;
procedure TObjectList.SetCapacity(const AValue: Integer);
procedure TObjectArray.SetCapacity(const AValue: Integer);
begin
if FCapacity=AValue then exit;
FCapacity:=AValue;
@ -115,36 +115,36 @@ begin
if FCount>FCapacity then FCount:=FCapacity;
end;
procedure TObjectList.SetCount(const AValue: Integer);
procedure TObjectArray.SetCount(const AValue: Integer);
begin
if FCount=AValue then exit;
FCount:=AValue;
if FCount>FCapacity then SetCapacity(AValue);
end;
procedure TObjectList.Grow;
procedure TObjectArray.Grow;
begin
if FCapacity<5 then Capacity:=5
else Capacity:=Capacity*2;
end;
procedure TObjectList.Shrink;
procedure TObjectArray.Shrink;
begin
Capacity:=Capacity div 2;
end;
destructor TObjectList.Destroy;
destructor TObjectArray.Destroy;
begin
ReallocMem(FList,0);
inherited Destroy;
end;
function TObjectList.Add(Item: Pointer): Integer;
function TObjectArray.Add(Item: Pointer): Integer;
begin
Result:=AddObject(Item,nil);
end;
function TObjectList.AddObject(Item, Associated: Pointer): Integer;
function TObjectArray.AddObject(Item, Associated: Pointer): Integer;
begin
if FCount=FCapacity then Grow;
FList[FCount].Item:=Item;
@ -153,14 +153,14 @@ begin
inc(FCount);
end;
procedure TObjectList.Clear;
procedure TObjectArray.Clear;
begin
FCount:=0;
ReallocMem(FList,0);
FCapacity:=0;
end;
procedure TObjectList.Delete(Index: Integer);
procedure TObjectArray.Delete(Index: Integer);
begin
if FCount>Index+1 then
System.Move(FList[Index+1],FList[Index],SizeOf(T2Pointer)*(FCount-Index-1));
@ -168,7 +168,7 @@ begin
if FCapacity>FCount*4 then Shrink;
end;
procedure TObjectList.Exchange(Index1, Index2: Integer);
procedure TObjectArray.Exchange(Index1, Index2: Integer);
var
SwapDummy: T2Pointer;
begin
@ -178,7 +178,7 @@ begin
FList[Index2]:=SwapDummy;
end;
function TObjectList.First: Pointer;
function TObjectArray.First: Pointer;
begin
if FCount>0 then
Result:=FList[0].Item
@ -186,18 +186,18 @@ begin
Result:=nil;
end;
function TObjectList.IndexOf(Item: Pointer): Integer;
function TObjectArray.IndexOf(Item: Pointer): Integer;
begin
Result:=FCount-1;
while (Result>=0) and (FList[Result].Item<>Item) do dec(Result);
end;
procedure TObjectList.Insert(Index: Integer; Item: Pointer);
procedure TObjectArray.Insert(Index: Integer; Item: Pointer);
begin
InsertObject(Index,Item,nil);
end;
procedure TObjectList.InsertObject(Index: Integer; Item, Associated: Pointer);
procedure TObjectArray.InsertObject(Index: Integer; Item, Associated: Pointer);
begin
if FCount=FCapacity then Grow;
if Index<FCount then
@ -207,7 +207,7 @@ begin
FList[Index].Associated:=Associated;
end;
function TObjectList.Last: Pointer;
function TObjectArray.Last: Pointer;
begin
if FCount>0 then
Result:=FList[FCount-1].Item
@ -215,7 +215,7 @@ begin
Result:=nil;
end;
procedure TObjectList.Move(CurIndex, NewIndex: Integer);
procedure TObjectArray.Move(CurIndex, NewIndex: Integer);
var
SwapDummy: T2Pointer;
begin
@ -230,7 +230,7 @@ begin
FList[NewIndex]:=SwapDummy;
end;
procedure TObjectList.Assign(SrcList: TList);
procedure TObjectArray.Assign(SrcList: TList);
var
i: Integer;
begin
@ -242,13 +242,13 @@ begin
end;
end;
function TObjectList.Remove(Item: Pointer): Integer;
function TObjectArray.Remove(Item: Pointer): Integer;
begin
Result:=IndexOf(Item);
if Result>=0 then Delete(Result);
end;
procedure TObjectList.Pack;
procedure TObjectArray.Pack;
var
SrcID: Integer;
DestID: Integer;

20
ideintf/actionseditor.pas
View File

@ -49,7 +49,8 @@ interface
uses
Classes, SysUtils, LCLProc, Forms, StdCtrls, Buttons, ActnList, ExtCtrls,
Controls, Dialogs, ObjInspStrConsts, ComponentEditors, PropEdits;
Controls, Dialogs, ObjInspStrConsts, ComponentEditors, PropEdits, DBActns,
StdActns;
type
{ TActionListEditor }
@ -786,9 +787,22 @@ end;
procedure RegisterStandardActions;
begin
// TODO
// - db actions
// - edit actions
// - default images for actions
// register edit actions
RegisterActions('Edit',[TEditCut,TEditCopy,TEditPaste,TEditSelectAll,
TEditUndo,TEditDelete],nil);
// register help actions
RegisterActions('Help',[THelpAction,THelpContents,THelpTopicSearch,
THelpOnHelp,THelpContextAction],nil);
// register file actions
RegisterActions('File',[TFileOpen,TFileOpenWith,TFileSaveAs,TFileExit],nil);
// register dialog actions
RegisterActions('Dialog',[TFontEdit,TColorSelect],nil);
// register database actions
RegisterActions('Database',[TDataSetFirst,TDataSetLast,TDataSetNext,
TDataSetPrior,TDataSetRefresh,TDataSetCancel,TDataSetDelete,TDataSetEdit,
TDataSetInsert,TDataSetPost],nil);
end;
initialization

9
lcl/forms.pp
View File

@ -829,7 +829,7 @@ type
procedure RemoveHandler(HandlerType: TApplicationHandlerType;
const Handler: TMethod);
protected
Function GetConsoleApplication: boolean; override;
function GetConsoleApplication: boolean; override;
procedure NotifyIdleHandler;
procedure NotifyIdleEndHandler;
function IsHintMsg(var Msg: TMsg): Boolean;
@ -840,6 +840,7 @@ type
procedure StartHintTimer(Interval: integer; TimerType: TAppHintTimerType);
procedure UpdateVisible;
procedure DoIdleActions;
procedure MenuPopupHandler(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -1089,9 +1090,9 @@ function GetLongHint(const Hint: string): string;
var
Application : TApplication;
Screen : TScreen;
ExceptionObject : TExceptObject;
Application: TApplication;
Screen: TScreen;
ExceptionObject: TExceptObject;
HintWindowClass: THintWindowClass;
type

18
lcl/include/application.inc
View File

@ -87,6 +87,8 @@ begin
FOnIdle := nil;
FIcon := nil;
ApplicationActionComponent:=Self;
OnMenuPopupHandler:=@MenuPopupHandler;
inherited Create(AOwner);
CaptureExceptions:=true;
@ -99,6 +101,9 @@ destructor TApplication.Destroy;
var
HandlerType: TApplicationHandlerType;
begin
if OnMenuPopupHandler=@MenuPopupHandler then
OnMenuPopupHandler:=nil;
// shutting down
CancelHint;
ShowHint := False;
@ -675,6 +680,11 @@ begin
end;
end;
procedure TApplication.MenuPopupHandler(Sender: TObject);
begin
HideHint;
end;
{------------------------------------------------------------------------------
Method: TApplication.IconChanged
------------------------------------------------------------------------------}
@ -953,9 +963,8 @@ begin
if Assigned(FOnHint) then
FOnHint(Self)
else begin
{ Fire THintAction to anyone interested }
{with THintAction.Create(Self) do
begin
// Send THintAction
{with THintAction.Create(Self) do begin
Hint := Value;
try
Execute;
@ -1205,6 +1214,9 @@ end;
{ =============================================================================
$Log$
Revision 1.85 2004/08/13 10:20:19 mattias
fixed codetools ConstSet, implemented notifying TApplication whenmenu popups
Revision 1.84 2004/08/09 21:12:43 mattias
implemented FormStyle fsSplash for splash screens

10
lcl/include/menuitem.inc
View File

@ -49,11 +49,13 @@ procedure TMenuItem.Click;
begin
if Enabled then
begin
if Assigned(OnMenuPopupHandler) then OnMenuPopupHandler(Self);
if (not Assigned(ActionLink) and AutoCheck) or (Assigned(ActionLink) and
not (ActionLink.IsAutoCheckLinked) and AutoCheck)
then begin
// Break a little Delphi compatibility
// It makes no sense to uncheck a checked RadioItem (besides, GTK cant handle it)
// It makes no sense to uncheck a checked RadioItem (besides, GTK can't handle it)
if (not RadioItem) or (not Checked) then
Checked := not Checked;
end;
@ -1162,6 +1164,9 @@ end;
{ =============================================================================
$Log$
Revision 1.59 2004/08/13 10:20:19 mattias
fixed codetools ConstSet, implemented notifying TApplication whenmenu popups
Revision 1.58 2004/06/24 17:45:33 mattias
fixed TMenuItem.GetIconSize
@ -1364,6 +1369,9 @@ end;
$Log$
Revision 1.59 2004/08/13 10:20:19 mattias
fixed codetools ConstSet, implemented notifying TApplication whenmenu popups
Revision 1.58 2004/06/24 17:45:33 mattias
fixed TMenuItem.GetIconSize

4
lcl/include/popupmenu.inc
View File

@ -57,6 +57,7 @@ begin
ActivePopupMenu:=Self;
Items.InitiateActions;
HandleNeeded;
if Assigned(OnMenuPopupHandler) then OnMenuPopupHandler(Self);
SendMsgToInterface(LM_POPUPSHOW, Self, @FPopupPoint);
end;
@ -77,6 +78,9 @@ end;
{
$Log$
Revision 1.12 2004/08/13 10:20:19 mattias
fixed codetools ConstSet, implemented notifying TApplication whenmenu popups
Revision 1.11 2004/07/10 18:17:30 mattias
added Delphi ToDo support, Application.WndProc, small bugfixes from Colin

7
lcl/menus.pp
View File

@ -178,7 +178,7 @@ type
protected
property ActionLink: TMenuActionLink read FActionLink write FActionLink;
public
FCompStyle : LongInt;
FCompStyle: LongInt;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
function GetImageList: TCustomImageList; virtual;
@ -333,6 +333,7 @@ function ShortCutToText(ShortCut: TShortCut): string;
var
DesignerMenuItemClick: TNotifyEvent;
ActivePopupMenu: TPopupMenu;
OnMenuPopupHandler: TNotifyEvent;
procedure Register;
@ -401,6 +402,7 @@ initialization
DesignerMenuItemClick:=nil;
ActivePopupMenu:=nil;
CommandPool := nil;
OnMenuPopupHandler := nil;
finalization
FreeThenNil(CommandPool);
@ -409,6 +411,9 @@ end.
{
$Log$
Revision 1.69 2004/08/13 10:20:19 mattias
fixed codetools ConstSet, implemented notifying TApplication whenmenu popups
Revision 1.68 2004/06/17 21:24:19 mattias
implemented painting menuitem icons from ImageList

4
lcl/stdctrls.pp
View File

@ -592,7 +592,6 @@ type
TCustomMemo = class(TCustomEdit)
private
//FFont : TFont;
FHorzScrollBar: TMemoScrollBar;
FLines: TStrings;
FScrollBars: TScrollStyle;
@ -1159,6 +1158,9 @@ end.
{ =============================================================================
$Log$
Revision 1.157 2004/08/13 10:20:19 mattias
fixed codetools ConstSet, implemented notifying TApplication whenmenu popups
Revision 1.156 2004/08/05 21:20:47 mattias
moved designer/abstractformeditor.pp to ideintf/formeditingintf.pas

9
packager/pkgmanager.pas
View File

@ -174,7 +174,7 @@ type
ComponentClassnames: TStrings): TModalResult; override;
function GetMissingDependenciesForUnit(const UnitFilename: string;
ComponentClassnames: TStrings;
var List: TObjectList): TModalResult;
var List: TObjectArray): TModalResult;
function GetOwnersOfUnit(const UnitFilename: string): TList;
// package graph
@ -2480,7 +2480,7 @@ var
UnitBuf: TCodeBuffer;
UnitNames: TStringList;
Packages: TList;
MissingDependencies: TObjectList;
MissingDependencies: TObjectArray;
function LoadAndParseUnitBuf: TModalResult;
begin
@ -2670,7 +2670,8 @@ end;
function TPkgManager.GetMissingDependenciesForUnit(
const UnitFilename: string; ComponentClassnames: TStrings;
var List: TObjectList): TModalResult;
var List: TObjectArray): TModalResult;
// returns a list of packages needed to use the Component in the unit
var
UnitOwners: TList;
UnitOwner: TObject;
@ -2706,7 +2707,7 @@ begin
and (FindCompatibleDependencyInList(FirstDependency,pdlRequires,
RequiredPackage)=nil)
then begin
if List=nil then List:=TObjectList.Create;
if List=nil then List:=TObjectArray.Create;
List.AddObject(UnitOwner,RequiredPackage);
//writeln('TPkgManager.GetMissingDependenciesForUnit A ',UnitOwner.ClassName,' ',RequiredPackage.Name);
//if TObject(List[List.Count-1])<>UnitOwner then RaiseException('A');