paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 03:35:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented Rename Identifier

Browse Source 
git-svn-id: trunk@6075 -
This commit is contained in:
mattias 2004-09-25 15:05:39 +00:00
parent 19fb185df2
commit abacaa7cbf
26 changed files with 867 additions and 386 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
components/codetools/basiccodetools.pas
View File

@ -118,6 +118,7 @@ function CompareTextIgnoringSpace(Txt1: PChar; Len1: integer;
function CompareSubStrings(const Find, Txt: string;
FindStartPos, TxtStartPos, Len: integer; CaseSensitive: boolean): integer;
function CompareIdentifiers(Identifier1, Identifier2: PChar): integer;
function CompareIdentifiersCaseSensitive(Identifier1, Identifier2: PChar): integer;
function ComparePrefixIdent(PrefixIdent, Identifier: PChar): boolean;
function TextBeginsWith(Txt: PChar; TxtLen: integer; StartTxt: PChar;
StartTxtLen: integer; CaseSensitive: boolean): boolean;
@ -2300,6 +2301,47 @@ begin
end;
end;
function CompareIdentifiersCaseSensitive(Identifier1, Identifier2: PChar
): integer;
begin
if (Identifier1<>nil) then begin
if (Identifier2<>nil) then begin
while (Identifier1[0]=Identifier2[0]) do begin
if (IsIDChar[Identifier1[0]]) then begin
inc(Identifier1);
inc(Identifier2);
end else begin
Result:=0; // for example 'aaA;' 'aAa;'
exit;
end;
end;
if (IsIDChar[Identifier1[0]]) then begin
if (IsIDChar[Identifier2[0]]) then begin
if Identifier1[0]>Identifier2[0] then
Result:=-1 // for example 'aab' 'aaa'
else
Result:=1; // for example 'aaa' 'aab'
end else begin
Result:=-1; // for example 'aaa' 'aa;'
end;
end else begin
if (IsIDChar[Identifier2[0]]) then
Result:=1 // for example 'aa;' 'aaa'
else
Result:=0; // for example 'aa;' 'aa,'
end;
end else begin
Result:=-1; // for example 'aaa' nil
end;
end else begin
if (Identifier2<>nil) then begin
Result:=1; // for example nil 'bbb'
end else begin
Result:=0; // for example nil nil
end;
end;
end;
function ComparePrefixIdent(PrefixIdent, Identifier: PChar): boolean;
begin
if PrefixIdent<>nil then begin

128
components/codetools/codetoolmanager.pas
View File

@ -108,6 +108,8 @@ type
const AFilename: string): string;
function FindCodeOfMainUnitHint(Code: TCodeBuffer): TCodeBuffer;
procedure CreateScanner(Code: TCodeBuffer);
procedure ClearError;
procedure ClearCurCodeTool;
function InitCurCodeTool(Code: TCodeBuffer): boolean;
function InitResourceTool: boolean;
procedure ClearPositions;
@ -125,6 +127,8 @@ type
procedure BeforeApplyingChanges(var Abort: boolean);
procedure AfterApplyingChanges;
function HandleException(AnException: Exception): boolean;
procedure AdjustErrorTopLine;
procedure WriteError;
function OnGetCodeToolForBuffer(Sender: TObject;
Code: TCodeBuffer; GoToMainCode: boolean): TFindDeclarationTool;
procedure OnToolSetWriteLock(Lock: boolean);
@ -171,6 +175,8 @@ type
read FOnSearchUsedUnit write FOnSearchUsedUnit;
// exception handling
procedure SetError(Code: TCodeBuffer; Line, Column: integer;
const TheMessage: string);
property CatchExceptions: boolean
read FCatchExceptions write FCatchExceptions;
property WriteExceptions: boolean
@ -302,6 +308,8 @@ type
function FindReferences(IdentifierCode: TCodeBuffer;
X, Y: integer; TargetCode: TCodeBuffer; SkipComments: boolean;
var ListOfPCodeXYPosition: TList): boolean;
function RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
const OldIdentifier, NewIdentifier: string): boolean;
// resourcestring sections
function GatherResourceStringSections(
@ -798,6 +806,20 @@ begin
end;
end;
procedure TCodeToolManager.ClearError;
begin
fErrorMsg:='';
fErrorCode:=nil;
fErrorLine:=-1;
end;
procedure TCodeToolManager.ClearCurCodeTool;
begin
ClearError;
if IdentifierList<>nil then IdentifierList.Clear;
FCurCodeTool:=nil;
end;
function TCodeToolManager.ApplyChanges: boolean;
begin
Result:=SourceChangeCache.Apply;
@ -1074,10 +1096,7 @@ function TCodeToolManager.InitCurCodeTool(Code: TCodeBuffer): boolean;
var MainCode: TCodeBuffer;
begin
Result:=false;
fErrorMsg:='';
fErrorCode:=nil;
fErrorLine:=-1;
if IdentifierList<>nil then IdentifierList.Clear;
ClearCurCodeTool;
MainCode:=GetMainCode(Code);
if MainCode=nil then begin
fErrorMsg:='TCodeToolManager.InitCurCodeTool MainCode=nil';
@ -1153,6 +1172,17 @@ begin
fErrorLine:=FCurCodeTool.ErrorPosition.Y;
end;
end;
// adjust error topline
AdjustErrorTopLine;
// write error
WriteError;
// raise or catch
if not FCatchExceptions then raise AnException;
Result:=false;
end;
procedure TCodeToolManager.AdjustErrorTopLine;
begin
// adjust error topline
if (fErrorCode<>nil) and (fErrorTopLine<1) then begin
fErrorTopLine:=fErrorLine;
@ -1161,7 +1191,10 @@ begin
if fErrorTopLine<1 then fErrorTopLine:=1;
end;
end;
// write error
end;
procedure TCodeToolManager.WriteError;
begin
if FWriteExceptions then begin
{$IFDEF CTDEBUG}
WriteDebugReport(true,false,false,false,false);
@ -1172,9 +1205,6 @@ begin
if ErrorCode<>nil then DbgOut(' in "',ErrorCode.Filename,'"');
DebugLn('');
end;
// raise or catch
if not FCatchExceptions then raise AnException;
Result:=false;
end;
function TCodeToolManager.CheckSyntax(Code: TCodeBuffer;
@ -1460,6 +1490,76 @@ begin
{$ENDIF}
end;
function TCodeToolManager.RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
const OldIdentifier, NewIdentifier: string): boolean;
var
ANode: TAVLTreeNode;
CurCodePos: PCodeXYPosition;
IdentStartPos: integer;
IdentLen: Integer;
Code: TCodeBuffer;
begin
Result:=false;
{ $IFDEF CTDEBUG}
DebugLn('TCodeToolManager.RenameIdentifier A Old=',OldIdentifier,' New=',NewIdentifier);
{ $ENDIF}
if TreeOfPCodeXYPosition=nil then begin
Result:=true;
exit;
end;
if (NewIdentifier='') or (not IsValidIdent(NewIdentifier)) then exit;
ClearCurCodeTool;
SourceChangeCache.Clear;
IdentLen:=length(OldIdentifier);
// the tree is sorted for descending line code positions
// -> go from end of source to start of source, so that replacing does not
// change any CodeXYPosition not yet processed
ANode:=TreeOfPCodeXYPosition.FindLowest;
while ANode<>nil do begin
// next position
CurCodePos:=PCodeXYPosition(ANode.Data);
Code:=CurCodePos^.Code;
Code.LineColToPosition(CurCodePos^.Y,CurCodePos^.X,IdentStartPos);
DebugLn('TCodeToolManager.RenameIdentifier A ',Code.Filename,' Line=',dbgs(CurCodePos^.Y),' Col=',dbgs(CurCodePos^.X));
// search absolute position in source
if IdentStartPos<1 then begin
SetError(Code, CurCodePos^.Y, CurCodePos^.X, ctsPositionNotInSource);
exit;
end;
// check if old identifier is there
if CompareIdentifiers(@Code.Source[IdentStartPos],PChar(OldIdentifier))<>0
then begin
SetError(CurCodePos^.Code,CurCodePos^.Y,CurCodePos^.X,
Format(ctsStrExpectedButAtomFound,[OldIdentifier,
GetIdentifier(@Code.Source[IdentStartPos])])
);
exit;
end;
// change if needed
if CompareIdentifiersCaseSensitive(@Code.Source[IdentStartPos],
PChar(NewIdentifier))<>0
then begin
DebugLn('TCodeToolManager.RenameIdentifier Change ');
SourceChangeCache.ReplaceEx(gtNone,gtNone,1,1,Code,
IdentStartPos,IdentStartPos+IdentLen,NewIdentifier);
end else begin
DebugLn('TCodeToolManager.RenameIdentifier KEPT ',GetIdentifier(@Code.Source[IdentStartPos]));
end;
ANode:=TreeOfPCodeXYPosition.FindSuccessor(ANode);
end;
// apply
DebugLn('TCodeToolManager.RenameIdentifier Apply');
if not SourceChangeCache.Apply then exit;
DebugLn('TCodeToolManager.RenameIdentifier Success');
Result:=true;
{$IFDEF CTDEBUG}
DebugLn('TCodeToolManager.RenameIdentifier END ');
{$ENDIF}
end;
function TCodeToolManager.GatherResourceStringSections(Code: TCodeBuffer;
X, Y: integer; CodePositions: TCodeXYPositions): boolean;
var
@ -2975,6 +3075,18 @@ begin
Result:=nil;
end;
procedure TCodeToolManager.SetError(Code: TCodeBuffer; Line, Column: integer;
const TheMessage: string);
begin
FErrorMsg:=TheMessage;
FErrorCode:=Code;
FErrorLine:=Line;
FErrorColumn:=Column;
FErrorTopLine:=FErrorLine;
AdjustErrorTopLine;
WriteError;
end;
function TCodeToolManager.GetCodeToolForSource(Code: TCodeBuffer;
GoToMainCode, ExceptionOnError: boolean): TCustomCodeTool;
// return a codetool for the source

1
components/codetools/codetoolsstrconsts.pas
View File

@ -53,6 +53,7 @@ ResourceString
ctsIdentExpectedButAtomFound = 'identifier expected, but %s found';
ctsIdentExpectedButKeyWordFound = 'identifier expected, but keyword %s found';
ctsStrExpectedButAtomFound = '%s expected, but %s found';
ctsPositionNotInSource = 'Position not in source';
ctsInvalidClassName = 'invalid class name=%s%s%s';
ctsclassNotFound = 'class %s%s%s not found';
ctsinvalidClassName2 = 'invalid class name %s%s%s';

52
components/codetools/finddeclarationtool.pas
View File

@ -2953,7 +2953,7 @@ var
debugln(' x=',dbgs(ReferencePos.X),' y=',dbgs(ReferencePos.Y),' ',ReferencePos.Code.Filename);
CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(Tree.Root,StartPos,true);
debugln(' CursorNode=',CursorNode.DescAsString,' ',dbgs(CursorNode.SubDesc and ctnsForwardDeclaration));
debugln(' CursorNode=',CursorNode.DescAsString,' Forward=',dbgs(CursorNode.SubDesc and ctnsForwardDeclaration));
if (DeclarationTool=Self)
and ((StartPos=CleanDeclCursorPos) or (CursorNode=AliasDeclarationNode))
@ -2969,10 +2969,10 @@ var
else
Params.Clear;
Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,
fdfExceptionOnNotFound];
fdfExceptionOnNotFound,fdfIgnoreCurContextNode];
if NodeIsForwardDeclaration(CursorNode) then begin
debugln('Node is forward declaration');
Params.Flags:=Params.Flags+[fdfSearchForward,fdfIgnoreCurContextNode];
Params.Flags:=Params.Flags+[fdfSearchForward];
end;
Params.ContextNode:=CursorNode;
//debugln(copy(Src,Params.ContextNode.StartPos,200));
@ -2988,16 +2988,20 @@ var
except
on E: ECodeToolError do
if not IsComment then raise;
on E: Exception do
raise;
end;
debugln(' Found=',dbgs(Found));
if Found and (Params.NewNode<>nil) then begin
if (Params.NewNode<>nil) and (Params.NewNode.Desc=ctnProcedure)
if (Params.NewNode.Desc=ctnProcedure)
and (Params.NewNode.FirstChild<>nil)
and (Params.NewNode.FirstChild.Desc=ctnProcedureHead) then begin
// Instead of jumping to the procedure keyword,
// jump to the procedure name
Params.NewNode:=Params.NewNode.FirstChild;
Params.NewCleanPos:=Params.NewNode.StartPos;
Params.NewCodeTool.MoveCursorToProcName(Params.NewNode,true);
Params.NewCleanPos:=Params.NewCodeTool.CurPos.StartPos;
end;
debugln('Context=',Params.NewNode.DescAsString,' ',dbgs(Params.NewNode.StartPos),' ',dbgs(DeclarationNode.StartPos));
if (Params.NewNode=DeclarationNode)
@ -3240,21 +3244,12 @@ end;
function TFindDeclarationTool.CleanPosIsDeclarationIdentifier(CleanPos: integer;
Node: TCodeTreeNode): boolean;
function InNodeIdentifier: boolean;
function InNodeIdentifier(NodeIdentStartPos: Integer): boolean;
var
IdentStartPos, IdentEndPos: integer;
NodeIdentStartPos: Integer;
begin
NodeIdentStartPos:=Node.StartPos;
if Node.Desc in [ctnProperty,ctnGlobalProperty] then begin
if not MoveCursorToPropName(Node) then exit;
NodeIdentStartPos:=CurPos.StartPos;
end;
GetIdentStartEndAtPosition(Src,CleanPos,IdentStartPos,IdentEndPos);
if (IdentEndPos>IdentStartPos) and (IdentStartPos=NodeIdentStartPos)
then begin
Result:=true;
end;
Result:=(IdentEndPos>IdentStartPos) and (IdentStartPos=NodeIdentStartPos);
end;
begin
@ -3265,13 +3260,30 @@ begin
ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition,ctnEnumIdentifier:
begin
if NodeIsForwardDeclaration(Node) then exit;
Result:=InNodeIdentifier;
Result:=InNodeIdentifier(Node.StartPos);
end;
ctnProcedureHead, ctnProperty, ctnGlobalProperty:
Result:=InNodeIdentifier;
ctnProcedure:
begin
if (Node.SubDesc and ctnsForwardDeclaration)>0 then
RaiseException('TFindDeclarationTool.CleanPosIsDeclarationIdentifier Node not expanded');
MoveCursorToProcName(Node,true);
Result:=InNodeIdentifier(CurPos.StartPos);
end;
ctnProcedureHead:
begin
MoveCursorToProcName(Node,true);
Result:=InNodeIdentifier(CurPos.StartPos);
end;
ctnProperty, ctnGlobalProperty:
begin
if not MoveCursorToPropName(Node) then exit;
Result:=InNodeIdentifier(CurPos.StartPos);
end;
ctnBeginBlock,ctnClass,ctnProcedure:
ctnBeginBlock,ctnClass:
if (Node.SubDesc and ctnsForwardDeclaration)>0 then
RaiseException('TFindDeclarationTool.CleanPosIsDeclarationIdentifier Node not expanded');

1
components/codetools/identcompletiontool.pas
View File

@ -760,6 +760,7 @@ begin
GatherPredefinedIdentifiers(CleanPos,Context,BeautifyCodeOptions);
if Context.Node.Desc=ctnProperty then begin
PropertyName:=ExtractPropName(Context.Node,false);
debugln('AAA1 ',PropertyName);
MoveCursorToCleanPos(CleanPos);
ReadPriorAtom;
if UpAtomIs('READ') then begin

24
components/codetools/pascalreadertool.pas
View File

@ -91,6 +91,8 @@ type
procedure MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode);
function MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
ProcSpec: TProcedureSpecifier): boolean;
procedure MoveCursorToProcName(ProcNode: TCodeTreeNode;
SkipClassName: boolean);
function ProcNodeHasParamList(ProcNode: TCodeTreeNode): boolean;
function NodeIsInAMethod(Node: TCodeTreeNode): boolean;
function NodeIsMethodBody(ProcNode: TCodeTreeNode): boolean;
@ -669,6 +671,27 @@ begin
Result:=false;
end;
procedure TPascalReaderTool.MoveCursorToProcName(ProcNode: TCodeTreeNode;
SkipClassName: boolean);
begin
if (ProcNode.Desc=ctnProcedure) and (ProcNode.FirstChild<>nil)
and (ProcNode.FirstChild.Desc=ctnProcedureHead) then
ProcNode:=ProcNode.FirstChild;
MoveCursorToNodeStart(ProcNode);
ReadNextAtom;
if (ProcNode.Desc=ctnProcedure) then begin
if UpAtomIs('CLASS') then ReadNextAtom;
ReadNextAtom; // skip proc keyword
end;
if SkipClassName then begin
ReadNextAtom;
if CurPos.Flag=cafPoint then
ReadNextAtom
else
UndoReadNextAtom;
end;
end;
function TPascalReaderTool.MoveCursorToPropType(PropNode: TCodeTreeNode
): boolean;
begin
@ -709,6 +732,7 @@ begin
ReadNextAtom;
end;
AtomIsIdentifier(true);
Result:=true;
end;
function TPascalReaderTool.ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;

36
components/codetools/sourcechanger.pas
View File

@ -169,6 +169,7 @@ type
FEntries: TAVLTree;
FBuffersToModify: TList; // sorted list of TCodeBuffer
FBuffersToModifyNeedsUpdate: boolean;
FMainScannerNeeded: boolean;
FOnBeforeApplyChanges: TOnBeforeApplyChanges;
FOnAfterApplyChanges: TOnAfterApplyChanges;
FUpdateLock: integer;
@ -189,6 +190,7 @@ type
procedure BeginUpdate;
procedure EndUpdate;
property MainScanner: TLinkScanner read FMainScanner write SetMainScanner;
property MainScannerNeeded: boolean read FMainScannerNeeded;
function Replace(FrontGap, AfterGap: TGapTyp; FromPos, ToPos: integer;
const Text: string): boolean;
function ReplaceEx(FrontGap, AfterGap: TGapTyp; FromPos, ToPos: integer;
@ -442,13 +444,13 @@ function TSourceChangeCache.ReplaceEx(FrontGap, AfterGap: TGapTyp;
procedure RaiseDataInvalid;
begin
if MainScanner=nil then
if (MainScanner=nil) then
RaiseException('TSourceChangeCache.ReplaceEx MainScanner=nil');
if FromPos>ToPos then
RaiseException('TSourceChangeCache.ReplaceEx FromPos>ToPos');
if FromPos<1 then
RaiseException('TSourceChangeCache.ReplaceEx FromPos<1');
if ToPos>MainScanner.CleanedLen+1 then
if (MainScanner<>nil) and (ToPos>MainScanner.CleanedLen+1) then
RaiseException('TSourceChangeCache.ReplaceEx ToPos>MainScanner.CleanedLen+1');
end;
@ -491,7 +493,8 @@ begin
Result:=true;
exit;
end;
if (MainScanner=nil) or (FromPos>ToPos) or (FromPos<1)
if (MainScanner=nil)
or (FromPos>ToPos) or (FromPos<1)
or (ToPos>MainScanner.CleanedLen+1) then
begin
{$IFDEF CTDEBUG}
@ -501,6 +504,7 @@ begin
exit;
end;
end else begin
// direct code change without MainScanner
if (Text='') and (FromDirectPos=ToDirectPos) then begin
{$IFDEF CTDEBUG}
DebugLn('TSourceChangeCache.ReplaceEx SUCCESS NoOperation');
@ -519,16 +523,16 @@ begin
end;
if ToPos>FromPos then begin
// this is a replace/delete operation
// this is a replace/delete operation (in cleaned code)
// -> check the whole range for writable buffers
if not MainScanner.WholeRangeIsWritable(FromPos,ToPos,true) then exit;
end else if (DirectCode<>nil) and (FromDirectPos<ToDirectPos) then begin
end else if IsDirectChange and (FromDirectPos<ToDirectPos) then begin
// this is a direct replace/delete operation
// -> check if the DirectCode is writable
if DirectCode.ReadOnly then
RaiseCodeReadOnly(DirectCode);
end;
if DirectCode=nil then begin
if not IsDirectChange then begin
if not MainScanner.CleanedPosToCursor(FromPos,FromDirectPos,p) then begin
{$IFDEF CTDEBUG}
DebugLn('TSourceChangeCache.ReplaceEx IGNORED, because not in clean pos');
@ -543,7 +547,8 @@ begin
NewEntry:=TSourceChangeCacheEntry.Create(FrontGap,AfterGap,FromPos,ToPos,
Text,DirectCode,FromDirectPos,ToDirectPos,IsDirectChange);
FEntries.Add(NewEntry);
if not IsDirectChange then
FMainScannerNeeded:=true;
FBuffersToModifyNeedsUpdate:=true;
Result:=true;
{$IFDEF CTDEBUG}
@ -561,6 +566,7 @@ procedure TSourceChangeCache.Clear;
begin
FUpdateLock:=0;
FEntries.FreeAndClear;
FMainScannerNeeded:=false;
FBuffersToModify.Clear;
FBuffersToModifyNeedsUpdate:=true;
end;
@ -719,7 +725,7 @@ begin
DebugLn('TSourceChangeCache.Apply EntryCount=',dbgs(FEntries.Count));
{$ENDIF}
Result:=false;
if MainScanner=nil then
if MainScannerNeeded and (MainScanner=nil) then
RaiseCatchableException('TSourceChangeCache.Apply');
if FUpdateLock>0 then begin
Result:=true;
@ -738,7 +744,10 @@ begin
end;
end;
try
Src:=MainScanner.CleanedSrc;
if MainScanner<>nil then
Src:=MainScanner.CleanedSrc
else
Src:='';
SrcLen:=length(Src);
// apply the changes beginning with the last
CurNode:=FEntries.FindHighest;
@ -887,7 +896,14 @@ begin
ANode:=FEntries.FindLowest;
while ANode<>nil do begin
AnEntry:=TSourceChangeCacheEntry(ANode.Data);
MainScanner.FindCodeInRange(AnEntry.FromPos,AnEntry.ToPos,FBuffersToModify);
if AnEntry.IsDirectChange then begin
if AnEntry.DirectCode=nil then
RaiseException('TSourceChangeCache.UpdateBuffersToModify AnEntry.DirectCode=nil');
if FBuffersToModify.IndexOf(AnEntry.DirectCode)<0 then
FBuffersToModify.Add(AnEntry.DirectCode)
end else
MainScanner.FindCodeInRange(AnEntry.FromPos,AnEntry.ToPos,
FBuffersToModify);
ANode:=FEntries.FindSuccessor(ANode);
end;
FBuffersToModifyNeedsUpdate:=false;

17
components/gtk/gtkglarea/gtkglareacontrol.pas
View File

@ -104,8 +104,8 @@ type
TWSGTKGLAreaControl = class(TWSWinControl)
public
class function CreateHandle(const AComponent: TComponent;
const AParams: TCreateParams): THandle; override;
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
end;
@ -341,16 +341,16 @@ end;
{ TWSGTKGLAreaControl }
function TWSGTKGLAreaControl.CreateHandle(const AComponent: TComponent;
const AParams: TCreateParams): THandle;
function TWSGTKGLAreaControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
NewWidget: Pointer;
Area: TCustomGTKGLAreaControl;
begin
if csDesigning in AComponent.ComponentState then
Result:=inherited CreateHandle(AComponent,AParams)
if csDesigning in AWinControl.ComponentState then
Result:=inherited CreateHandle(AWinControl,AParams)
else begin
Area:=AComponent as TCustomGTKGLAreaControl;
Area:=AWinControl as TCustomGTKGLAreaControl;
if (Area.SharedArea<>nil) and (not (csDestroying in Area.ComponentState))
then
NewWidget:=gtk_gl_area_share_new(Plongint(@InitAttrList),
@ -358,7 +358,8 @@ begin
else
NewWidget:=gtk_gl_area_new(Plongint(@InitAttrList));
Result:=longint(NewWidget);
TGTKWidgetSet(InterfaceObject).FinishComponentCreate(AComponent,NewWidget,true);
TGTKWidgetSet(InterfaceObject).FinishComponentCreate(AWinControl,NewWidget,
true);
end;
end;

4
ide/findrenameidentifier.lfm
View File

@ -47,7 +47,6 @@ object FindRenameIdentifierDialog: TFindRenameIdentifierDialog
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
Text = 'NewEdit'
TabOrder = 0
Left = 6
Height = 23
Top = 6
@ -98,6 +97,7 @@ object FindRenameIdentifierDialog: TFindRenameIdentifierDialog
'in project/package owning file'
'in all open projects and packages'
)
ParentColor = True
Left = 6
Height = 112
Top = 5
@ -108,7 +108,6 @@ object FindRenameIdentifierDialog: TFindRenameIdentifierDialog
Caption = 'ExtraFilesGroupBox'
ClientHeight = 27
ClientWidth = 413
Enabled = False
ParentColor = True
TabOrder = 2
Left = 6
@ -119,7 +118,6 @@ object FindRenameIdentifierDialog: TFindRenameIdentifierDialog
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
Text = 'ExtraFilesEdit'
TabOrder = 0
Left = 6
Height = 23
Width = 404

54
ide/findrenameidentifier.lrs
View File

@ -16,32 +16,32 @@ LazarusResources.Add('TFindRenameIdentifierDialog','FORMDATA',[
+#7'akRight'#0#7'Caption'#6#11'NewGroupBox'#12'ClientHeight'#2'$'#11'ClientWi'
+'dth'#3#176#1#11'ParentColor'#9#8'TabOrder'#2#1#4'Left'#2#8#6'Height'#2'5'#3
+'Top'#2'['#5'Width'#3#180#1#0#5'TEdit'#7'NewEdit'#7'Anchors'#11#5'akTop'#6'a'
+'kLeft'#7'akRight'#0#8'TabOrder'#2#0#4'Text'#6#7'NewEdit'#8'TabOrder'#2#0#4
+'Left'#2#6#6'Height'#2#23#3'Top'#2#6#5'Width'#3#4#1#0#0#9'TCheckBox'#14'Rena'
+'meCheckBox'#11'AllowGrayed'#9#7'Anchors'#11#5'akTop'#7'akRight'#0#8'AutoSiz'
+'e'#9#7'Caption'#6#14'RenameCheckBox'#8'OnChange'#7#20'RenameCheckBoxChange'
+#8'TabOrder'#2#1#11'UseOnChange'#9#4'Left'#3#18#1#6'Height'#2#23#3'Top'#2#6#5
+'Width'#3#151#0#0#0#0#9'TGroupBox'#13'ScopeGroupBox'#7'Anchors'#11#5'akTop'#6
+'akLeft'#7'akRight'#0#7'Caption'#6#13'ScopeGroupBox'#12'ClientHeight'#3#211#0
+#11'ClientWidth'#3#177#1#11'ParentColor'#9#8'TabOrder'#2#2#4'Left'#2#8#6'Hei'
+'ght'#3#228#0#3'Top'#3#156#0#5'Width'#3#181#1#0#9'TCheckBox'#21'ScopeComment'
+'sCheckBox'#11'AllowGrayed'#9#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8
+'AutoSize'#9#7'Caption'#6#21'ScopeCommentsCheckBox'#8'TabOrder'#2#0#4'Left'#2
+#6#6'Height'#2#23#3'Top'#3#181#0#5'Width'#3#161#1#0#0#11'TRadioGroup'#15'Sco'
+'peRadioGroup'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#7'Caption'#6#15
+'ScopeRadioGroup'#13'Items.Strings'#1#6#15'in current unit'#6#15'in main pro'
+'ject'#6#30'in project/package owning file'#6'!in all open projects and pack'
+'ages'#0#4'Left'#2#6#6'Height'#2'p'#3'Top'#2#5#5'Width'#3#161#1#0#0#9'TGroup'
+'Box'#18'ExtraFilesGroupBox'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#7
+'kLeft'#7'akRight'#0#8'TabOrder'#2#0#4'Text'#6#7'NewEdit'#4'Left'#2#6#6'Heig'
+'ht'#2#23#3'Top'#2#6#5'Width'#3#4#1#0#0#9'TCheckBox'#14'RenameCheckBox'#11'A'
+'llowGrayed'#9#7'Anchors'#11#5'akTop'#7'akRight'#0#8'AutoSize'#9#7'Caption'#6
+#14'RenameCheckBox'#8'OnChange'#7#20'RenameCheckBoxChange'#8'TabOrder'#2#1#11
+'UseOnChange'#9#4'Left'#3#18#1#6'Height'#2#23#3'Top'#2#6#5'Width'#3#151#0#0#0
+#0#9'TGroupBox'#13'ScopeGroupBox'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'
+#0#7'Caption'#6#13'ScopeGroupBox'#12'ClientHeight'#3#211#0#11'ClientWidth'#3
+#177#1#11'ParentColor'#9#8'TabOrder'#2#2#4'Left'#2#8#6'Height'#3#228#0#3'Top'
+#3#156#0#5'Width'#3#181#1#0#9'TCheckBox'#21'ScopeCommentsCheckBox'#11'AllowG'
+'rayed'#9#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'AutoSize'#9#7'Capt'
+'ion'#6#21'ScopeCommentsCheckBox'#8'TabOrder'#2#0#4'Left'#2#6#6'Height'#2#23
+#3'Top'#3#181#0#5'Width'#3#161#1#0#0#11'TRadioGroup'#15'ScopeRadioGroup'#7'A'
+'nchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#7'Caption'#6#15'ScopeRadioGroup'
+#13'Items.Strings'#1#6#15'in current unit'#6#15'in main project'#6#30'in pro'
+'ject/package owning file'#6'!in all open projects and packages'#0#11'Parent'
+'Color'#9#4'Left'#2#6#6'Height'#2'p'#3'Top'#2#5#5'Width'#3#161#1#0#0#9'TGrou'
+'pBox'#18'ExtraFilesGroupBox'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#7
+'Caption'#6#18'ExtraFilesGroupBox'#12'ClientHeight'#2#27#11'ClientWidth'#3
+#157#1#7'Enabled'#8#11'ParentColor'#9#8'TabOrder'#2#2#4'Left'#2#6#6'Height'#2
+','#3'Top'#2'}'#5'Width'#3#161#1#0#5'TEdit'#14'ExtraFilesEdit'#7'Anchors'#11
+#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#0#4'Text'#6#14'ExtraFilesEdit'
+#8'TabOrder'#2#0#4'Left'#2#6#6'Height'#2#23#5'Width'#3#148#1#0#0#0#0#7'TButt'
+'on'#18'FindOrRenameButton'#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption'#6
+#18'FindOrRenameButton'#7'OnClick'#7#23'FindOrRenameButtonClick'#8'TabOrder'
+#2#3#4'Left'#2'X'#6'Height'#2#25#3'Top'#3#144#1#5'Width'#3#233#0#0#0#7'TButt'
+'on'#12'CancelButton'#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption'#6#12'Ca'
+'ncelButton'#11'ModalResult'#2#2#8'TabOrder'#2#4#4'Left'#3'P'#1#6'Height'#2
+#25#3'Top'#3#144#1#5'Width'#2'Y'#0#0#0
+#157#1#11'ParentColor'#9#8'TabOrder'#2#2#4'Left'#2#6#6'Height'#2','#3'Top'#2
+'}'#5'Width'#3#161#1#0#5'TEdit'#14'ExtraFilesEdit'#7'Anchors'#11#5'akTop'#6
+'akLeft'#7'akRight'#0#8'TabOrder'#2#0#4'Text'#6#14'ExtraFilesEdit'#4'Left'#2
+#6#6'Height'#2#23#5'Width'#3#148#1#0#0#0#0#7'TButton'#18'FindOrRenameButton'
+#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption'#6#18'FindOrRenameButton'#7'O'
+'nClick'#7#23'FindOrRenameButtonClick'#8'TabOrder'#2#3#4'Left'#2'X'#6'Height'
+#2#25#3'Top'#3#144#1#5'Width'#3#233#0#0#0#7'TButton'#12'CancelButton'#7'Anch'
+'ors'#11#5'akTop'#7'akRight'#0#7'Caption'#6#12'CancelButton'#11'ModalResult'
+#2#2#8'TabOrder'#2#4#4'Left'#3'P'#1#6'Height'#2#25#3'Top'#3#144#1#5'Width'#2
+'Y'#0#0#0
]);

124
ide/findrenameidentifier.pas
View File

@ -75,12 +75,16 @@ type
function ShowFindRenameIdentifierDialog(const Filename: string;
const Position: TPoint; AllowRename: boolean;
const Position: TPoint; AllowRename, SetRenameActive: boolean;
Options: TFindRenameIdentifierOptions): TModalResult;
function GatherIdentifierReferences(Files: TStringList;
DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
SearchInComments: boolean): TModalResult;
procedure ShowReferences(DeclarationCode: TCodeBuffer;
SearchInComments: boolean;
var TreeOfPCodeXYPosition: TAVLTree): TModalResult;
function ShowIdentifierReferences(
DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
TreeOfPCodeXYPosition: TAVLTree): TModalResult;
procedure AddReferencesToResultView(DeclarationCode: TCodeBuffer;
const DeclarationCaretXY: TPoint; TargetCode: TCodeBuffer;
TreeOfPCodeXYPosition: TAVLTree; ClearItems: boolean; SearchPageIndex: integer);
@ -89,7 +93,7 @@ implementation
function ShowFindRenameIdentifierDialog(const Filename: string;
const Position: TPoint; AllowRename: boolean;
const Position: TPoint; AllowRename, SetRenameActive: boolean;
Options: TFindRenameIdentifierOptions): TModalResult;
var
FindRenameIdentifierDialog: TFindRenameIdentifierDialog;
@ -99,6 +103,8 @@ begin
FindRenameIdentifierDialog.LoadFromConfig;
FindRenameIdentifierDialog.SetIdentifier(Filename,Position);
FindRenameIdentifierDialog.AllowRename:=AllowRename;
if SetRenameActive and AllowRename then
FindRenameIdentifierDialog.RenameCheckBox.Checked:=true;
Result:=FindRenameIdentifierDialog.ShowModal;
if Result=mrOk then
if Options<>nil then
@ -110,21 +116,17 @@ end;
function GatherIdentifierReferences(Files: TStringList;
DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
SearchInComments: boolean): TModalResult;
SearchInComments: boolean;
var TreeOfPCodeXYPosition: TAVLTree): TModalResult;
var
i: Integer;
SearchPageIndex: LongInt;
LoadResult: TModalResult;
Code: TCodeBuffer;
ListOfPCodeXYPosition: TList;
TreeOfPCodeXYPosition: TAVLTree;
Identifier: string;
OldSearchPageIndex: LongInt;
begin
Result:=mrCancel;
ListOfPCodeXYPosition:=nil;
TreeOfPCodeXYPosition:=nil;
SearchPageIndex:=-1;
try
// sort files
Files.Sort;
@ -138,11 +140,6 @@ begin
inc(i);
end;
// create a search result page
CodeToolBoss.GetIdentifierAt(DeclarationCode,
DeclarationCaretXY.X,DeclarationCaretXY.Y,Identifier);
// search in every file
for i:=0 to Files.Count-1 do begin
LoadResult:=
@ -150,18 +147,6 @@ begin
if LoadResult=mrAbort then exit;
if LoadResult<>mrOk then continue;
// create search page
if SearchPageIndex<0 then begin
SearchPageIndex:=SearchResultsView.AddResult(
'References of '+Identifier,
Identifier,
ExtractFilePath(Code.Filename),
'*.pas;*.pp;*.inc',
[fifWholeWord,fifSearchDirectories]);
if SearchPageIndex<0 then exit;
SearchResultsView.BeginUpdate(SearchPageIndex);
end;
// search references
CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
if not CodeToolBoss.FindReferences(
@ -181,9 +166,41 @@ begin
end;
end;
Result:=mrOk;
finally
CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
if Result<>mrOk then
CodeToolBoss.FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
end;
end;
function ShowIdentifierReferences(
DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
TreeOfPCodeXYPosition: TAVLTree): TModalResult;
var
Identifier: string;
OldSearchPageIndex: LongInt;
SearchPageIndex: LongInt;
begin
Result:=mrCancel;
SearchPageIndex:=-1;
try
// show result
ShowReferences(DeclarationCode,DeclarationCaretXY,
Code,TreeOfPCodeXYPosition,false,SearchPageIndex);
CodeToolBoss.GetIdentifierAt(DeclarationCode,
DeclarationCaretXY.X,DeclarationCaretXY.Y,Identifier);
// create a search result page
SearchPageIndex:=SearchResultsView.AddResult(
'References of '+Identifier,
Identifier,
ExtractFilePath(DeclarationCode.Filename),
'*.pas;*.pp;*.inc',
[fifWholeWord,fifSearchDirectories]);
if SearchPageIndex<0 then exit;
// list results
SearchResultsView.BeginUpdate(SearchPageIndex);
AddReferencesToResultView(DeclarationCode,DeclarationCaretXY,
DeclarationCode,TreeOfPCodeXYPosition,false,SearchPageIndex);
OldSearchPageIndex:=SearchPageIndex;
SearchPageIndex:=-1;
SearchResultsView.EndUpdate(OldSearchPageIndex);
@ -191,13 +208,10 @@ begin
finally
if SearchPageIndex>=0 then
SearchResultsView.EndUpdate(SearchPageIndex);
CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
CodeToolBoss.FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
end;
Result:=mrOk;
end;
procedure ShowReferences(DeclarationCode: TCodeBuffer;
procedure AddReferencesToResultView(DeclarationCode: TCodeBuffer;
const DeclarationCaretXY: TPoint; TargetCode: TCodeBuffer;
TreeOfPCodeXYPosition: TAVLTree; ClearItems: boolean;
SearchPageIndex: integer);
@ -216,7 +230,7 @@ begin
if ClearItems then
SearchResultsView.Items[SearchPageIndex].Clear;
if (TreeOfPCodeXYPosition<>nil) then begin
ANode:=TreeOfPCodeXYPosition.FindLowest;
ANode:=TreeOfPCodeXYPosition.FindHighest;
while ANode<>nil do begin
CodePos:=PCodeXYPosition(ANode.Data);
CurLine:=TrimRight(CodePos^.Code.GetLine(CodePos^.Y-1));
@ -228,7 +242,7 @@ begin
Point(CodePos^.X,CodePos^.Y),
TrimmedLine,
CodePos^.X-TrimCnt, length(Identifier));
ANode:=TreeOfPCodeXYPosition.FindSuccessor(ANode);
ANode:=TreeOfPCodeXYPosition.FindPrecessor(ANode);
end;
end;
SearchResultsView.EndUpdate(SearchPageIndex);
@ -241,21 +255,20 @@ procedure TFindRenameIdentifierDialog.FindRenameIdentifierDialogCreate(
begin
IDEDialogLayoutList.ApplyLayout(Self,450,400);
Caption:='Find or Rename Identifier';
CancelButton.Caption:='Cancel';
CurrentGroupBox.Caption:='Identifier';
ExtraFilesGroupBox.Caption:=
'Additional files to search (e.g. /path/*.pas;/path2/*.pp)';
FindOrRenameButton.Caption:='Find References';
NewGroupBox.Caption:='Rename to';
RenameCheckBox.Caption:='Rename';
ScopeCommentsCheckBox.Caption:='Search in comments too';
ScopeGroupBox.Caption:='Search where';
ScopeRadioGroup.Caption:='Scope';
ScopeRadioGroup.Items[0]:='in current unit';
ScopeRadioGroup.Items[1]:='in main project';
ScopeRadioGroup.Items[2]:='in project/package owning current unit';
ScopeRadioGroup.Items[3]:='in all open packages and projects';
Caption:=lisFRIFindOrRenameIdentifier;
CancelButton.Caption:=dlgCancel;
CurrentGroupBox.Caption:=lisCodeToolsOptsIdentifier;
ExtraFilesGroupBox.Caption:=lisFRIAdditionalFilesToSearchEGPathPasPath2Pp;
FindOrRenameButton.Caption:=lisFRIFindReferences;
NewGroupBox.Caption:=lisFRIRenameTo;
RenameCheckBox.Caption:=lisFRIRename;
ScopeCommentsCheckBox.Caption:=lisFRISearchInCommentsToo;
ScopeGroupBox.Caption:=lisFRISearchWhere;
ScopeRadioGroup.Caption:=dlgScope;
ScopeRadioGroup.Items[0]:=lisFRIinCurrentUnit;
ScopeRadioGroup.Items[1]:=lisFRIinMainProject;
ScopeRadioGroup.Items[2]:=lisFRIinProjectPackageOwningCurrentUnit;
ScopeRadioGroup.Items[3]:=lisFRIinAllOpenPackagesAndProjects;
LoadFromConfig;
end;
@ -270,9 +283,9 @@ begin
RenameCheckBox.Enabled:=AllowRename;
NewEdit.Enabled:=RenameCheckBox.Checked and RenameCheckBox.Enabled;
if NewEdit.Enabled then
FindOrRenameButton.Caption:='Rename all References'
FindOrRenameButton.Caption:=lisFRIRenameAllReferences
else
FindOrRenameButton.Caption:='Find References';
FindOrRenameButton.Caption:=lisFRIFindReferences;
end;
procedure TFindRenameIdentifierDialog.SetAllowRename(const AValue: boolean);
@ -288,8 +301,9 @@ var
begin
NewIdentifier:=NewEdit.Text;
if (NewIdentifier='') or (not IsValidIdent(NewIdentifier)) then begin
MessageDlg('Invalid Identifier',
'"'+NewIdentifier+'" is not a valid identifier.',mtError,[mbCancel],0);
MessageDlg(lisFRIInvalidIdentifier,
Format(lisSVUOisNotAValidIdentifier, ['"', NewIdentifier, '"']), mtError,
[mbCancel], 0);
exit;
end;
ModalResult:=mrOk;
@ -379,7 +393,7 @@ begin
if CodeToolBoss.GetIdentifierAt(ACodeBuffer,
NewIdentifierPosition.X,NewIdentifierPosition.Y,NewIdentifier) then
begin
CurrentGroupBox.Caption:='Identifier: '+NewIdentifier;
CurrentGroupBox.Caption:=Format(lisFRIIdentifier, [NewIdentifier]);
NewEdit.Text:=NewIdentifier;
end;
end;

5
ide/ideprocs.pp
View File

@ -1113,6 +1113,11 @@ begin
while (Result>=0) and (AnsiCompareText(List[Result],s)<>0) do dec(Result);
end;
{-------------------------------------------------------------------------------
procedure ReverseList(List: TList);
Reverse the order of a TList
-------------------------------------------------------------------------------}
procedure ReverseList(List: TList);
var
i: Integer;

4
ide/keymapping.pp
View File

@ -125,6 +125,7 @@ const
ecDiff = ecUserFirst + 111;
ecExtractProc = ecUserFirst + 112;
ecFindIdentifierRefs = ecUserFirst + 113;
ecRenameIdentifier = ecUserFirst + 114;
// file menu
ecNew = ecUserFirst + 201;
@ -569,6 +570,7 @@ begin
ecIdentCompletion: SetResult(VK_SPACE,[ssCtrl],VK_UNKNOWN,[]);
ecExtractProc: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]);
ecFindIdentifierRefs: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]);
ecRenameIdentifier: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]);
ecSyntaxCheck: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]);
ecGuessUnclosedBlock: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]);
ecGuessMisplacedIFDEF: SetResult(VK_UNKNOWN,[],VK_UNKNOWN,[]);
@ -1175,6 +1177,7 @@ begin
ecIdentCompletion : Result:= dlgedidcomlet;
ecExtractProc : Result:= srkmecExtractProc;
ecFindIdentifierRefs : Result:= srkmecFindIdentifierRefs;
ecRenameIdentifier : Result:= srkmecRenameIdentifier;
ecSyntaxCheck : Result:= srkmecSyntaxCheck;
ecGuessUnclosedBlock : Result:= lismenuguessunclosedblock;
ecGuessMisplacedIFDEF : Result:= srkmecGuessMisplacedIFDEF;
@ -1986,6 +1989,7 @@ begin
AddDefault(C,'Identifier completion',ecIdentCompletion);
AddDefault(C,'Extract proc',ecExtractProc);
AddDefault(C,'Find identifier references',ecFindIdentifierRefs);
AddDefault(C,'Rename identifier',ecRenameIdentifier);
AddDefault(C,'Syntax check',ecSyntaxCheck);
AddDefault(C,'Guess unclosed block',ecGuessUnclosedBlock);
AddDefault(C,'Guess misplaced $IFDEF',ecGuessMisplacedIFDEF);

21
ide/lazarusidestrconsts.pas
View File

@ -148,6 +148,7 @@ resourcestring
lisMenuCompleteCode = 'Complete Code';
lisMenuExtractProc = 'Extract procedure';
lisMenuFindIdentifierRefs = 'Find Identifier References';
lisMenuRenameIdentifier = 'Rename Identifier';
lisMenuInsertGPLNotice = 'GPL notice';
lisMenuInsertLGPLNotice = 'LGPL notice';
@ -1019,6 +1020,12 @@ resourcestring
dlgFromCursor = 'From Cursor';
dlgEntireScope = 'Entire Scope';
dlgScope = 'Scope';
lisFRIinCurrentUnit = 'in current unit';
lisFRIinMainProject = 'in main project';
lisFRIinProjectPackageOwningCurrentUnit = 'in project/package owning '
+'current unit';
lisFRIinAllOpenPackagesAndProjects = 'in all open packages and projects';
lisFRIRenameAllReferences = 'Rename all References';
dlgGlobal = 'Global';
dlgSelectedText = 'Selected Text';
dlgDirection = 'Direction';
@ -1062,7 +1069,6 @@ resourcestring
uemCompleteCode = 'Complete Code';
uemEncloseSelection = 'Enclose Selection';
uemExtractProc = 'Extract Procedure';
uemFindIdentifierReferences = 'Find Identifier References';
uemEditorproperties='Editor properties';
ueNotImplCap='Not implemented yet';
ueNotImplText='If You can help us to implement this feature, mail to '
@ -1262,7 +1268,8 @@ resourcestring
srkmecWordCompletion = 'Word completion';
srkmecCompletecode = 'Complete code';
srkmecExtractProc = 'Extract procedure';
srkmecFindIdentifierRefs = 'FInd identifier references';
srkmecFindIdentifierRefs = 'Find identifier references';
srkmecRenameIdentifier = 'Rename identifier';
srkmecSyntaxCheck = 'Syntax check';
srkmecGuessMisplacedIFDEF = 'Guess misplaced $IFDEF';
srkmecFindDeclaration = 'Find declaration';
@ -1449,6 +1456,14 @@ resourcestring
lisCodeToolsOptsNone = 'None';
lisCodeToolsOptsKeyword = 'Keyword';
lisCodeToolsOptsIdentifier = 'Identifier';
lisFRIAdditionalFilesToSearchEGPathPasPath2Pp = 'Additional files to '
+'search (e.g. /path/*.pas;/path2/*.pp)';
lisFRIFindReferences = 'Find References';
lisFRIInvalidIdentifier = 'Invalid Identifier';
lisFRIRenameTo = 'Rename to';
lisFRIRename = 'Rename';
lisFRISearchInCommentsToo = 'Search in comments too';
lisFRISearchWhere = 'Search where';
lisCodeToolsOptsColon = 'Colon';
lisCodeToolsOptsSemicolon = 'Semicolon';
lisCodeToolsOptsComma = 'Comma';
@ -1715,6 +1730,7 @@ resourcestring
// System Variables Override Dialog
lisSVUOInvalidVariableName = 'Invalid variable name';
lisSVUOisNotAValidIdentifier = '%s%s%s is not a valid identifier.';
lisFRIIdentifier = 'Identifier: %s';
lisSVUOOverrideSystemVariable = 'Override system variable';
lisSVUOOk = 'Ok';
@ -2554,6 +2570,7 @@ resourcestring
lisA2PAddFilesToPackage = 'Add files to package';
lisA2PAddToPackage = 'Add to package';
lisA2PFilename2 = 'Filename';
lisFRIFindOrRenameIdentifier = 'Find or Rename Identifier';
implementation
end.

153
ide/main.pp
View File

@ -183,6 +183,7 @@ type
// search menu
procedure mnuSearchFindInFiles(Sender: TObject);
procedure mnuSearchFindIdentifierRefsClicked(Sender: TObject);
procedure mnuSearchRenameIdentifierClicked(Sender: TObject);
procedure mnuSearchFindBlockOtherEnd(Sender: TObject);
procedure mnuSearchFindBlockStart(Sender: TObject);
procedure mnuSearchFindDeclaration(Sender: TObject);
@ -684,7 +685,7 @@ type
procedure DoJumpToProcedureSection;
procedure DoFindDeclarationAtCursor;
procedure DoFindDeclarationAtCaret(const LogCaretXY: TPoint);
procedure DoFindIdentifierReferences;
function DoFindRenameIdentifier(Rename: boolean): TModalResult;
function DoInitIdentCompletion: boolean;
procedure DoCompleteCodeAtCursor;
procedure DoExtractProcFromSelection;
@ -1645,6 +1646,7 @@ begin
inherited SetupSearchMenu;
with MainIDEBar do begin
itmSearchFindIdentifierRefs.OnClick:=@mnuSearchFindIdentifierRefsClicked;
itmSearchRenameIdentifier.OnClick:=@mnuSearchRenameIdentifierClicked;
itmGotoIncludeDirective.OnClick:=@mnuGotoIncludeDirectiveClicked;
end;
end;
@ -2065,7 +2067,10 @@ begin
DoFindDeclarationAtCursor;
ecFindIdentifierRefs:
DoFindIdentifierReferences;
DoFindRenameIdentifier(false);
ecRenameIdentifier:
DoFindRenameIdentifier(true);
ecFindBlockOtherEnd:
DoGoToPascalBlockOtherEnd;
@ -9250,21 +9255,62 @@ begin
end;
{-------------------------------------------------------------------------------
procedure TMainIDE.DoFindIdentifierReferences;
function TMainIDE.DoFindRenameIdentifier(Rename: boolean): TModalResult;
-------------------------------------------------------------------------------}
procedure TMainIDE.DoFindIdentifierReferences;
function TMainIDE.DoFindRenameIdentifier(Rename: boolean): TModalResult;
var
Options: TFindRenameIdentifierOptions;
// TODO: replace Files: TStringsList with a AVL tree
function AddExtraFiles(Files: TStrings): TModalResult;
var
i: Integer;
CurFileMask: string;
FileInfo: TSearchRec;
CurDirectory: String;
CurFilename: String;
begin
Result:=mrCancel;
if (Options.ExtraFiles=nil) then begin
for i:=0 to Options.ExtraFiles.Count-1 do begin
CurFileMask:=Options.ExtraFiles[i];
if not MacroList.SubstituteStr(CurFileMask) then exit;
if SysUtils.FindFirst(CurFileMask,faAnyFile,FileInfo)=0
then begin
CurDirectory:=AppendPathDelim(ExtractFilePath(CurFileMask));
if not FilenameIsAbsolute(CurDirectory) then begin
CurDirectory:=AppendPathDelim(Project1.ProjectDirectory)
+CurDirectory;
end;
repeat
// check if special file
if (FileInfo.Name='.') or (FileInfo.Name='..') then continue;
CurFilename:=CurDirectory+FileInfo.Name;
if FileIsText(CurFilename) then
Files.Add(CurFilename);
until SysUtils.FindNext(FileInfo)<>0;
end;
SysUtils.FindClose(FileInfo);
end;
end;
Result:=mrOk;
end;
var
TargetSrcEdit, DeclarationSrcEdit: TSourceEditor;
TargetUnitInfo, DeclarationUnitInfo: TUnitInfo;
NewSource: TCodeBuffer;
NewX, NewY, NewTopLine: integer;
LogCaretXY, DeclarationCaretXY: TPoint;
Options: TFindRenameIdentifierOptions;
OwnerList: TList;
ExtraFiles: TStrings;
Files: TStringList;
Identifier: string;
TreeOfPCodeXYPosition: TAVLTree;
begin
Result:=mrCancel;
if not BeginCodeTool(TargetSrcEdit,TargetUnitInfo,[]) then exit;
// find the main declaration
@ -9278,57 +9324,90 @@ begin
end;
DoJumpToCodePos(TargetSrcEdit, TargetUnitInfo,
NewSource, NewX, NewY, NewTopLine, true);
CodeToolBoss.GetIdentifierAt(NewSource,NewX,NewY,Identifier);
GetCurrentUnit(DeclarationSrcEdit,DeclarationUnitInfo);
DeclarationCaretXY:=DeclarationSrcEdit.EditorComponent.LogicalCaretXY;
debugln('TMainIDE.DoFindIdentifierReferences A DeclarationCaretXY=x=',dbgs(DeclarationCaretXY.X),' y=',dbgs(DeclarationCaretXY.Y));
debugln('TMainIDE.DoFindRenameIdentifier A DeclarationCaretXY=x=',dbgs(DeclarationCaretXY.X),' y=',dbgs(DeclarationCaretXY.Y));
// let user choose the search scope
if ShowFindRenameIdentifierDialog(DeclarationUnitInfo.Source.Filename,
DeclarationCaretXY,false,nil)<>mrOk
then exit;
Result:=ShowFindRenameIdentifierDialog(DeclarationUnitInfo.Source.Filename,
DeclarationCaretXY,Rename,Rename,nil);
if Result<>mrOk then exit;
Files:=nil;
OwnerList:=nil;
TreeOfPCodeXYPosition:=nil;
try
// create the file list
Files:=TStringList.Create;
Files.Add(TargetUnitInfo.Filename);
Options:=MiscellaneousOptions.FindRenameIdentifierOptions;
case Options.Scope of
frProject,frOwnerProjectPackage,frAllOpenProjectsAndPackages:
// add packages, projects
case Options.Scope of
frProject:
begin
if Options.Scope=frProject then begin
OwnerList:=TList.Create;
OwnerList.Add(Project1);
end else begin
OwnerList:=PkgBoss.GetOwnersOfUnit(TargetUnitInfo.Filename);
if Options.Scope=frAllOpenProjectsAndPackages then begin
PkgBoss.ExtendOwnerListWithUsedByOwners(OwnerList);
ReverseList(OwnerList);
end;
end;
ExtraFiles:=PkgBoss.GetSourceFilesOfOwners(OwnerList);
try
if ExtraFiles<>nil then
Files.AddStrings(ExtraFiles);
finally
ExtraFiles.Free;
OwnerList:=TList.Create;
OwnerList.Add(Project1);
end;
frOwnerProjectPackage,frAllOpenProjectsAndPackages:
begin
OwnerList:=PkgBoss.GetOwnersOfUnit(TargetUnitInfo.Filename);
if (OwnerList<>nil)
and (Options.Scope=frAllOpenProjectsAndPackages) then begin
PkgBoss.ExtendOwnerListWithUsedByOwners(OwnerList);
ReverseList(OwnerList);
end;
end;
end;
CreateSearchResultWindow;
GatherIdentifierReferences(Files,DeclarationUnitInfo.Source,
DeclarationCaretXY,Options.SearchInComments);
// get source files of packages and projects
if OwnerList<>nil then begin
ExtraFiles:=PkgBoss.GetSourceFilesOfOwners(OwnerList);
try
if ExtraFiles<>nil then
Files.AddStrings(ExtraFiles);
finally
ExtraFiles.Free;
end;
end;
// add user defined extra files
Result:=AddExtraFiles(Files);
if Result<>mrOk then exit;
// gather identifiers
Result:=GatherIdentifierReferences(Files,DeclarationUnitInfo.Source,
DeclarationCaretXY,Options.SearchInComments,TreeOfPCodeXYPosition);
if CodeToolBoss.ErrorMessage<>'' then
DoJumpToCodeToolBossError;
if Result<>mrOk then exit;
// show result
if (not Options.Rename) or (not Rename) then begin
CreateSearchResultWindow;
Result:=ShowIdentifierReferences(DeclarationUnitInfo.Source,
DeclarationCaretXY,TreeOfPCodeXYPosition);
if Result<>mrOk then exit;
end;
// rename identifier
if Options.Rename and Rename then begin
if not CodeToolBoss.RenameIdentifier(TreeOfPCodeXYPosition,
Identifier,Options.RenameTo)
then begin
DoJumpToCodeToolBossError;
Result:=mrCancel;
exit;
end;
end;
finally
Files.Free;
OwnerList.Free;
CodeToolBoss.FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
end;
end;
@ -10655,7 +10734,12 @@ end;
procedure TMainIDE.mnuSearchFindIdentifierRefsClicked(Sender: TObject);
begin
DoFindIdentifierReferences;
DoFindRenameIdentifier(false);
end;
procedure TMainIDE.mnuSearchRenameIdentifierClicked(Sender: TObject);
begin
DoFindRenameIdentifier(true);
end;
procedure TMainIDE.mnuEditCompleteCodeClicked(Sender: TObject);
@ -10813,6 +10897,9 @@ end.
{ =============================================================================
$Log$
Revision 1.779 2004/09/25 15:05:38 mattias
implemented Rename Identifier
Revision 1.778 2004/09/24 17:24:40 micha
convert LM_SETDESIGNING message to TWidgetSet method

1
ide/mainbar.pas
View File

@ -150,6 +150,7 @@ type
itmSearchFindInFiles: TMenuItem;
itmSearchFindIdentifierRefs: TMenuItem;
itmSearchReplace: TMenuItem;
itmSearchRenameIdentifier: TMenuItem;
itmIncrementalFind: TMenuItem;
itmGotoLine: TMenuItem;
itmJumpBack: TMenuItem;

4
ide/mainbase.pas
View File

@ -469,7 +469,6 @@ begin
CreateMenuItem(ParentMI,itmSearchFindNext,'itmSearchFindNext',lisMenuFindNext);
CreateMenuItem(ParentMI,itmSearchFindPrevious,'itmSearchFindPrevious',lisMenuFindPrevious);
CreateMenuItem(ParentMI,itmSearchFindInFiles,'itmSearchFindInFiles',lisMenuFindInFiles);
CreateMenuItem(ParentMI,itmSearchFindIdentifierRefs,'itmSearchFindIdentifierRefs',lisMenuFindIdentifierRefs);
CreateMenuItem(ParentMI,itmSearchReplace,'itmSearchReplace',lisMenuReplace);
CreateMenuItem(ParentMI,itmIncrementalFind,'itmIncrementalFind',lisMenuIncrementalFind);
@ -496,6 +495,8 @@ begin
CreateMenuItem(ParentMI,itmFindDeclaration,'itmFindDeclaration',lisMenuFindDeclarationAtCursor);
CreateMenuItem(ParentMI,itmOpenFileAtCursor,'itmOpenFileAtCursor',lisMenuOpenFilenameAtCursor);
CreateMenuItem(ParentMI,itmGotoIncludeDirective,'itmGotoIncludeDirective',lisMenuGotoIncludeDirective);
CreateMenuItem(ParentMI,itmSearchFindIdentifierRefs,'itmSearchFindIdentifierRefs',lisMenuFindIdentifierRefs);
CreateMenuItem(ParentMI,itmSearchRenameIdentifier,'itmSearchRenameIdentifier',lisMenuRenameIdentifier);
end;
end;
@ -762,6 +763,7 @@ begin
itmSearchFindInFiles.ShortCut:=CommandToShortCut(ecFindInFiles);
itmSearchFindIdentifierRefs.ShortCut:=CommandToShortCut(ecFindIdentifierRefs);
itmSearchReplace.ShortCut:=CommandToShortCut(ecReplace);
itmSearchRenameIdentifier.ShortCut:=CommandToShortCut(ecRenameIdentifier);
itmIncrementalFind.ShortCut:=CommandToShortCut(ecIncrementalFind);
itmGotoLine.ShortCut:=CommandToShortCut(ecGotoLineNumber);
itmJumpBack.ShortCut:=CommandToShortCut(ecJumpBack);

21
ide/uniteditor.pp
View File

@ -342,6 +342,7 @@ type
ReadOnlyMenuItem: TMenuItem;
RefactorMenuItem: TMenuItem;
FindIdentifierReferencesMenuItem: TMenuItem;
RenameIdentifierMenuItem: TMenuItem;
RunToCursorMenuItem: TMenuItem;
SetBookmarkMenuItem: TMenuItem;
ShowLineNumbersMenuItem: TMenuItem;
@ -355,6 +356,7 @@ type
procedure EncloseSelectionMenuItemClick(Sender: TObject);
procedure ExtractProcMenuItemClick(Sender: TObject);
procedure FindIdentifierReferencesMenuItemClick(Sender: TObject);
procedure RenameIdentifierMenuItemClick(Sender: TObject);
procedure RunToClicked(Sender: TObject);
procedure ViewCallStackClick(Sender: TObject);
Procedure AddWatchAtCursor(Sender: TObject);
@ -2861,7 +2863,9 @@ begin
ExtractProcMenuItem.Enabled:=SelAvailAndWritable;
FindIdentifierReferencesMenuItem.Enabled:=
IsValidIdent(ASrcEdit.GetWordAtCurrentCaret);
RenameIdentifierMenuItem.Enabled:=
IsValidIdent(ASrcEdit.GetWordAtCurrentCaret)
and (not ASrcEdit.ReadOnly);
end else begin
// user clicked on gutter
SourceEditorMarks.GetMarksForLine(EditorComp,EditorComp.CaretY,
@ -3113,11 +3117,19 @@ Begin
FindIdentifierReferencesMenuItem := TMenuItem.Create(Self);
with FindIdentifierReferencesMenuItem do begin
Name := 'FindIdentifierReferencesMenuItem';
Caption := uemFindIdentifierReferences;
Caption := lisMenuFindIdentifierRefs;
OnClick :=@FindIdentifierReferencesMenuItemClick;
end;
RefactorMenuItem.Add(FindIdentifierReferencesMenuItem);
RenameIdentifierMenuItem := TMenuItem.Create(Self);
with RenameIdentifierMenuItem do begin
Name := 'RenameIdentifierMenuItem';
Caption := lisMenuRenameIdentifier;
OnClick :=@RenameIdentifierMenuItemClick;
end;
RefactorMenuItem.Add(RenameIdentifierMenuItem);
SrcPopupMenu.Items.Add(Seperator);
EditorPropertiesMenuItem := TMenuItem.Create(Self);
@ -3940,6 +3952,11 @@ begin
MainIDEInterface.DoCommand(ecFindIdentifierRefs);
end;
procedure TSourceNotebook.RenameIdentifierMenuItemClick(Sender: TObject);
begin
MainIDEInterface.DoCommand(ecRenameIdentifier);
end;
procedure TSourceNotebook.RunToClicked(Sender: TObject);
var
ASrcEdit: TSourceEditor;

7
lcl/controls.pp
View File

@ -1122,10 +1122,6 @@ type
end;
// Moved to LCLType to avoid unit circles
// TCreateParams is part of the interface
TCreateParams = LCLType.TCreateParams;
TBorderWidth = 0..MaxInt;
TGetChildProc = procedure(Child: TComponent) of Object;
@ -2391,6 +2387,9 @@ end.
{ =============================================================================
$Log$
Revision 1.249 2004/09/25 15:05:38 mattias
implemented Rename Identifier
Revision 1.248 2004/09/24 21:34:14 micha
convert LM_CREATE message to interface methods
remove SendMsgToInterface, CNSendMessage and related methods

41
lcl/dbctrls.pp
View File

@ -37,7 +37,7 @@ interface
uses
Classes, SysUtils, DB, LCLProc, LMessages, GraphType, Forms, Controls,
Graphics, Dialogs, StdCtrls, Buttons, MaskEdit, ExtCtrls, Calendar,
Graphics, Dialogs, StdCtrls, Buttons, MaskEdit, ExtCtrls, Calendar, Chart,
LCLType;
Type
@ -880,6 +880,10 @@ type
// ToDo: Move this to db.pp
function ExtractFieldName(const Fields: string; var StartPos: Integer): string;
Procedure FillBarChart(BC: TBarChart; DS: TDataset;
const LabelField, ValueField: String; AColor: TColor);
procedure Register;
implementation
@ -896,6 +900,38 @@ begin
StartPos:=i;
end;
Procedure FillBarChart(BC: TBarChart; DS: TDataset;
const LabelField, ValueField: String; AColor: TColor);
Var
LF : TList;
VF : TField;
I : Integer;
L : String;
begin
VF:=DS.FieldByName(ValueField);
LF:=TList.Create;
Try
DS.GetFieldList(LF,LabelField);
With DS do
begin
While Not EOF do
begin
L:='';
For I:=0 to LF.Count-1 do
begin
If L<>'' then
L:=L+' ';
L:=L+TField(LF[i]).AsString;
end;
BC.AddBar(L,VF.AsInteger,AColor);
Next;
end;
end;
Finally
LF.Free;
end;
end;
procedure Register;
begin
RegisterComponents('Data Controls',[TDBNavigator,TDBText,TDBEdit,TDBMemo,
@ -1248,6 +1284,9 @@ end.
{ =============================================================================
$Log$
Revision 1.24 2004/09/25 15:05:38 mattias
implemented Rename Identifier
Revision 1.23 2004/09/01 11:12:04 mattias
replaced KeyPress dependencies with KeyDown

39
lcl/include/customlabel.inc
View File

@ -25,14 +25,15 @@
Constructor for the class.
------------------------------------------------------------------------------}
constructor TCustomLabel.Create(AOwner : TComponent);
constructor TCustomLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fCompStyle := csLabel;
FLayout := tlTop;
fAlignment := taLeftJustify;
FShowAccelChar:= true;
ControlStyle := ControlStyle + [csOpaque, csReplicatable];
SetBounds(0, 0, 65, 17);
SetInitialBounds(0, 0, 65, 17);
end;
{------------------------------------------------------------------------------
@ -47,10 +48,10 @@ begin
end;
{------------------------------------------------------------------------------
procedure TCustomLabel.Notification(AComponent : TComponent;
Operation : TOperation);
procedure TCustomLabel.Notification(AComponent: TComponent;
Operation: TOperation);
------------------------------------------------------------------------------}
procedure TCustomLabel.Notification(AComponent : TComponent; Operation : TOperation);
procedure TCustomLabel.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = FFocusControl) and (Operation = opRemove) then
@ -63,21 +64,19 @@ end;
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCustomLabel.SetAlignment(Value : TAlignment);
procedure TCustomLabel.SetAlignment(Value: TAlignment);
begin
if fAlignment <> value then begin
fAlignment:= value;
if HandleAllocated then begin
Invalidate;
if HandleAllocated then
TWSCustomLabelClass(WidgetSetClass).SetAlignment(Self, Value);
end;
end;
end;
Procedure TCustomLabel.DoAutoSize;
var
R : TRect;
DC : hDC;
R: TRect;
DC: hDC;
begin
If AutoSizing or (not AutoSize) or (Caption='') then
Exit;
@ -113,7 +112,7 @@ end;
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCustomLabel.SetFocusControl(Val : TWinControl);
procedure TCustomLabel.SetFocusControl(Val: TWinControl);
begin
if Val <> FFocusControl then begin
FFocusControl:= Val;
@ -127,7 +126,7 @@ end;
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCustomLabel.SetLayout(Value : TTextLayout);
procedure TCustomLabel.SetLayout(Value: TTextLayout);
begin
if FLayout <> Value then begin
FLayout:= Value;
@ -142,11 +141,12 @@ end;
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCustomLabel.SetShowAccelChar(Val : boolean);
procedure TCustomLabel.SetShowAccelChar(Val: boolean);
begin
if Val <> FShowAccelChar then begin
FShowAccelChar:= Val;
if HandleAllocated then TWSWinControlClass(WidgetSetClass).SetText(Self, Caption);
if HandleAllocated then
TWSWinControlClass(WidgetSetClass).SetText(Self,Caption);
end;
end;
@ -156,14 +156,12 @@ end;
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCustomLabel.SetWordWrap(Value : Boolean);
procedure TCustomLabel.SetWordWrap(Value: Boolean);
begin
if fWordWrap <> value then begin
fWordWrap:= value;
if HandleAllocated then begin
Invalidate;
if HandleAllocated then
TWSCustomLabelClass(WidgetSetClass).SetWordWrap(Self, Value);
end;
end;
end;
@ -185,6 +183,9 @@ end;
{ =============================================================================
$Log$
Revision 1.18 2004/09/25 15:05:38 mattias
implemented Rename Identifier
Revision 1.17 2004/09/22 14:50:18 micha
convert LM_SETPROPERTIES message for tcustomlabel to interface methods

5
lcl/interfaces/gtk/gtkobject.inc
View File

@ -5164,6 +5164,8 @@ begin
csLabel :
begin
P := gtk_label_new(StrTemp);
SetLabelAlignment(PGtkLabel(p),TCustomLabel(Sender).Alignment,
TCustomLabel(Sender).Layout);
SetupProps:= true;
end;
@ -6939,6 +6941,9 @@ end;
{ =============================================================================
$Log$
Revision 1.604 2004/09/25 15:05:38 mattias
implemented Rename Identifier
Revision 1.603 2004/09/24 21:34:14 micha
convert LM_CREATE message to interface methods
remove SendMsgToInterface, CNSendMessage and related methods

53
lcl/interfaces/gtk/gtkproc.inc
View File

@ -889,29 +889,57 @@ begin
LockOnChange(PGtkObject(ComboWidget^.entry),-1);
end;
{------------------------------------------------------------------------------
function GetComboBoxItemIndex(ComboBox: TComboBox): integer;
Returns the current ItemIndex of a TComboBox
------------------------------------------------------------------------------}
function GetComboBoxItemIndex(ComboBox: TComboBox): integer;
function GetComboBoxText(ComboWidget: PGtkCombo): string;
begin
Result:=ComboBox.Items.IndexOf(ComboBox.Text);
Result:=StrPas(gtk_entry_get_text(PGtkEntry(ComboWidget^.entry)));
end;
{------------------------------------------------------------------------------
procedure SetComboBoxItemIndex(ComboBox: TComboBox; Index: integer);
function GetComboBoxItemIndex(ComboBox: TCustomComboBox): integer;
Returns the current ItemIndex of a TComboBox
------------------------------------------------------------------------------}
procedure SetComboBoxItemIndex(ComboBox: TComboBox; Index: integer);
function GetComboBoxItemIndex(ComboBox: TCustomComboBox): integer;
var
ComboWidget: PGtkCombo;
ComboStrings: TStrings;
CurText: String;
begin
ComboWidget:=PGtkCombo(ComboBox.Handle);
ComboStrings:=TStrings(gtk_object_get_data(PGtkObject(ComboWidget),'LCLList'));
CurText:=GetComboBoxText(ComboWidget);
Result:=ComboStrings.IndexOf(CurText);
end;
{------------------------------------------------------------------------------
procedure SetComboBoxItemIndex(ComboBox: TCustomComboBox; Index: integer);
Returns the current ItemIndex of a TComboBox
------------------------------------------------------------------------------}
procedure SetComboBoxItemIndex(ComboBox: TCustomComboBox; Index: integer);
var
ComboWidget: PGtkCombo;
ComboStrings: TStrings;
begin
ComboWidget:=PGtkCombo(ComboBox.Handle);
gtk_list_select_item(PGtkList(ComboWidget^.list),Index);
if Index>=0 then
SetComboBoxText(ComboWidget,PChar(ComboBox.Items[Index]));
if Index>=0 then begin
ComboStrings:=TStrings(gtk_object_get_data(PGtkObject(ComboWidget),'LCLList'));
SetComboBoxText(ComboWidget,PChar(ComboStrings[Index]));
end;
end;
procedure SetLabelAlignment(LabelWidget: PGtkLabel;
const NewAlignment: TAlignment; const NewLayout: TTextLayout);
const
cLabelAlignX : array[TAlignment] of gfloat = (0.0, 1.0, 0.5);
cLabelAlignY : array[TTextLayout] of gfloat = (0.0, 0.5, 1.0);
cLabelAlign : array[TAlignment] of TGtkJustification =
(GTK_JUSTIFY_LEFT, GTK_JUSTIFY_RIGHT, GTK_JUSTIFY_CENTER);
begin
gtk_label_set_justify(LabelWidget, cLabelAlign[NewAlignment]);
gtk_misc_set_alignment(GTK_MISC(LabelWidget), cLabelAlignX[NewAlignment],
cLabelAlignY[NewLayout]);
end;
{------------------------------------------------------------------------------
@ -7309,6 +7337,9 @@ end;
{ =============================================================================
$Log$
Revision 1.311 2004/09/25 15:05:39 mattias
implemented Rename Identifier
Revision 1.310 2004/09/24 18:00:52 micha
convert LM_NB_UPDATETAB message to interface method

9
lcl/interfaces/gtk/gtkproc.pp
View File

@ -335,8 +335,13 @@ procedure HideCaretOfWidgetGroup(ChildWidget: PGtkWidget;
// combobox
procedure SetComboBoxText(ComboWidget: PGtkCombo; NewText: PChar);
function GetComboBoxItemIndex(ComboBox: TComboBox): integer;
procedure SetComboBoxItemIndex(ComboBox: TComboBox; Index: integer);
function GetComboBoxText(ComboWidget: PGtkCombo): string;
function GetComboBoxItemIndex(ComboBox: TCustomComboBox): integer;
procedure SetComboBoxItemIndex(ComboBox: TCustomComboBox; Index: integer);
// label
procedure SetLabelAlignment(LabelWidget: PGtkLabel;
const NewAlignment: TAlignment; const NewLayout: TTextLayout);
// paint messages
function GtkPaintMessageToPaintMessage(var GtkPaintMsg: TLMGtkPaint;

196
lcl/interfaces/gtk/gtkwsstdctrls.pp
View File

@ -147,14 +147,21 @@ type
private
protected
public
class procedure AppendText(const ACustomMemo: TCustomMemo; const AText: string); override;
class procedure AppendText(const ACustomMemo: TCustomMemo;
const AText: string); override;
{$ifdef GTK1}
class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override;
class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
class procedure SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char); override;
class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); override;
class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); override;
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override;
class procedure SetEchoMode(const ACustomEdit: TCustomEdit;
NewMode: TEchoMode); override;
class procedure SetMaxLength(const ACustomEdit: TCustomEdit;
NewLength: integer); override;
class procedure SetPasswordChar(const ACustomEdit: TCustomEdit;
NewChar: char); override;
class procedure SetReadOnly(const ACustomEdit: TCustomEdit;
NewReadOnly: boolean); override;
class procedure SetScrollbars(const ACustomMemo: TCustomMemo;
const NewScrollbars: TScrollStyle); override;
class procedure SetWordWrap(const ACustomMemo: TCustomMemo;
const NewWordWrap: boolean); override;
{$endif}
end;
@ -180,9 +187,12 @@ type
private
protected
public
class procedure SetAlignment(const ACustomLabel: TCustomLabel; const NewAlignment: TAlignment); override;
class procedure SetLayout(const ACustomLabel: TCustomLabel; const NewLayout: TTextLayout); override;
class procedure SetWordWrap(const ACustomLabel: TCustomLabel; const NewWordWrap: boolean); override;
class procedure SetAlignment(const ACustomLabel: TCustomLabel;
const NewAlignment: TAlignment); override;
class procedure SetLayout(const ACustomLabel: TCustomLabel;
const NewLayout: TTextLayout); override;
class procedure SetWordWrap(const ACustomLabel: TCustomLabel;
const NewWordWrap: boolean); override;
end;
{ TGtkWSLabel }
@ -207,10 +217,12 @@ type
private
protected
public
class function RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; override;
class function RetrieveState(const ACustomCheckBox: TCustomCheckBox
): TCheckBoxState; override;
class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox;
const OldShortCut, NewShortCut: TShortCut); override;
class procedure SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState); override;
class procedure SetState(const ACustomCheckBox: TCustomCheckBox;
const NewState: TCheckBoxState); override;
end;
{ TGtkWSCheckBox }
@ -303,10 +315,11 @@ end;
{ TGtkWSCustomListBox }
function TGtkWSCustomListBox.GetItemIndex(const ACustomListBox: TCustomListBox): integer;
function TGtkWSCustomListBox.GetItemIndex(const ACustomListBox: TCustomListBox
): integer;
var
Widget : PGtkWidget; // pointer to gtk-widget
GList : pGList; // Only used for listboxes, replace with widget!!!!!
Widget: PGtkWidget;// pointer to gtk-widget
GList : pGList; // Only used for listboxes, replace with widget!!!!!
Handle: HWND;
begin
Handle := ACustomListBox.Handle;
@ -320,7 +333,8 @@ begin
Widget:= PGtkList(GetWidgetInfo(Pointer(Handle), True)^.
CoreWidget)^.last_focus_child;
if Widget=nil then begin
GList:= PGtkList(GetWidgetInfo(Pointer(Handle), True)^.CoreWidget)^.selection;
GList:= PGtkList(GetWidgetInfo(Pointer(Handle), True)^.
CoreWidget)^.selection;
if GList <> nil then
Widget:= PGtkWidget(GList^.data);
end;
@ -336,7 +350,8 @@ begin
csCListBox:
begin
GList:= PGtkCList(GetWidgetInfo(Pointer(Handle), True)^.CoreWidget)^.selection;
GList:= PGtkCList(GetWidgetInfo(Pointer(Handle), True)^.
CoreWidget)^.selection;
if GList = nil then
Result := -1
else
@ -350,7 +365,8 @@ begin
{$EndIf}
end;
function TGtkWSCustomListBox.GetSelCount(const ACustomListBox: TCustomListBox): integer;
function TGtkWSCustomListBox.GetSelCount(const ACustomListBox: TCustomListBox
): integer;
var
Handle: HWND;
begin
@ -369,12 +385,13 @@ begin
{$EndIf}
end;
function TGtkWSCustomListBox.GetSelected(const ACustomListBox: TCustomListBox; const AIndex: integer): boolean;
function TGtkWSCustomListBox.GetSelected(const ACustomListBox: TCustomListBox;
const AIndex: integer): boolean;
var
Handle: HWND;
Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
GList : pGList; // Only used for listboxes, replace with widget!!!!!
ListItem : PGtkListItem; // currently only used for listboxes
Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
GList : pGList; // Only used for listboxes, replace with widget!!!!!
ListItem : PGtkListItem;// currently only used for listboxes
begin
{$IFdef GTK2}
DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_GETSEL');
@ -409,9 +426,10 @@ begin
end;
function TGtkWSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
function TGtkWSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox
): TStrings;
var
Widget : PGtkWidget; // pointer to gtk-widget
Widget: PGtkWidget;// pointer to gtk-widget
Handle: HWND;
begin
{$ifdef GTK2}
@ -425,7 +443,8 @@ begin
Result := TGtkCListStringList.Create(PGtkCList(Widget));
if ACustomListBox is TCustomListBox then
TGtkCListStringList(Result).Sorted := TCustomListBox(ACustomListBox).Sorted;
TGtkCListStringList(Result).Sorted :=
TCustomListBox(ACustomListBox).Sorted;
end;
csCheckListBox, csListBox:
@ -442,14 +461,16 @@ begin
{$endif}
end;
function TGtkWSCustomListBox.GetTopIndex(const ACustomListBox: TCustomListBox): integer;
function TGtkWSCustomListBox.GetTopIndex(const ACustomListBox: TCustomListBox
): integer;
begin
Result:=TGtkWidgetSet(InterfaceObject).GetListBoxIndexAtY(ACustomListBox, 0);
end;
procedure TGtkWSCustomListBox.SelectItem(const ACustomListBox: TCustomListBox; AIndex: integer; ASelected: boolean);
procedure TGtkWSCustomListBox.SelectItem(const ACustomListBox: TCustomListBox;
AIndex: integer; ASelected: boolean);
var
Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
Widget: PGtkWidget;// pointer to gtk-widget (local use when neccessary)
Handle: HWND;
begin
{$IFdef GTK2}
@ -478,7 +499,7 @@ end;
procedure TGtkWSCustomListBox.SetBorder(const ACustomListBox: TCustomListBox);
var
Handle: HWND;
Widget : PGtkWidget; // pointer to gtk-widget
Widget: PGtkWidget;// pointer to gtk-widget
begin
{$IFdef GTK2}
DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_SETBORDER');
@ -507,7 +528,8 @@ begin
{$Endif}
end;
procedure TGtkWSCustomListBox.SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer);
procedure TGtkWSCustomListBox.SetItemIndex(const ACustomListBox: TCustomListBox;
const AIndex: integer);
var
Handle: HWND;
begin
@ -540,14 +562,16 @@ begin
end;
end;
procedure TGtkWSCustomListBox.SetSelectionMode(const ACustomListBox: TCustomListBox;
procedure TGtkWSCustomListBox.SetSelectionMode(
const ACustomListBox: TCustomListBox;
const AExtendedSelect, AMultiSelect: boolean);
begin
TGtkWidgetSet(InterfaceObject).SetSelectionMode(ACustomListBox,
PGtkWidget(ACustomListBox.Handle), AMultiSelect, AExtendedSelect);
end;
procedure TGtkWSCustomListBox.SetSorted(const ACustomListBox: TCustomListBox; AList: TStrings; ASorted: boolean);
procedure TGtkWSCustomListBox.SetSorted(const ACustomListBox: TCustomListBox;
AList: TStrings; ASorted: boolean);
begin
case ACustomListBox.fCompStyle of
csListBox,
@ -562,7 +586,8 @@ begin
end
end;
procedure TGtkWSCustomListBox.SetTopIndex(const ACustomListBox: TCustomListBox; const NewTopIndex: integer);
procedure TGtkWSCustomListBox.SetTopIndex(const ACustomListBox: TCustomListBox;
const NewTopIndex: integer);
{$IFdef GTK2}
begin
DebugLn('TODO: TGtkWSCustomListBox.SetTopIndex');
@ -600,30 +625,35 @@ end;
{ TGtkWSCustomComboBox }
function TGtkWSCustomComboBox.GetSelStart(const ACustomComboBox: TCustomComboBox): integer;
function TGtkWSCustomComboBox.GetSelStart(
const ACustomComboBox: TCustomComboBox): integer;
begin
Result := WidgetGetSelStart(PGtkWidget(PGtkCombo(ACustomComboBox.Handle)^.entry));
Result := WidgetGetSelStart(PGtkWidget(PGtkCombo(ACustomComboBox.Handle
)^.entry));
end;
function TGtkWSCustomComboBox.GetSelLength(const ACustomComboBox: TCustomComboBox): integer;
function TGtkWSCustomComboBox.GetSelLength(
const ACustomComboBox: TCustomComboBox): integer;
begin
with PGtkOldEditable(PGtkCombo(ACustomComboBox.Handle)^.entry)^ do begin
Result:= Abs(integer(selection_end_pos)-integer(selection_start_pos));
end;
end;
function TGtkWSCustomComboBox.GetItemIndex(const ACustomComboBox: TCustomComboBox): integer;
function TGtkWSCustomComboBox.GetItemIndex(
const ACustomComboBox: TCustomComboBox): integer;
begin
// TODO: ugly typecast to tcombobox
Result:=GetComboBoxItemIndex(TComboBox(ACustomComboBox));
Result:=GetComboBoxItemIndex(ACustomComboBox);
end;
function TGtkWSCustomComboBox.GetMaxLength(const ACustomComboBox: TCustomComboBox): integer;
function TGtkWSCustomComboBox.GetMaxLength(
const ACustomComboBox: TCustomComboBox): integer;
begin
Result:= PGtkEntry(PGtkCombo(ACustomComboBox.Handle)^.entry)^.text_max_length;
end;
procedure TGtkWSCustomComboBox.SetArrowKeysTraverseList(const ACustomComboBox: TCustomComboBox;
procedure TGtkWSCustomComboBox.SetArrowKeysTraverseList(
const ACustomComboBox: TCustomComboBox;
NewTraverseList: boolean);
var
GtkCombo: GTK_COMBO;
@ -638,28 +668,34 @@ begin
end;
end;
procedure TGtkWSCustomComboBox.SetSelStart(const ACustomComboBox: TCustomComboBox; NewStart: integer);
procedure TGtkWSCustomComboBox.SetSelStart(
const ACustomComboBox: TCustomComboBox; NewStart: integer);
begin
gtk_editable_set_position(PGtkOldEditable(PGtkCombo(ACustomComboBox.Handle)^.entry), NewStart);
gtk_editable_set_position(
PGtkOldEditable(PGtkCombo(ACustomComboBox.Handle)^.entry), NewStart);
end;
procedure TGtkWSCustomComboBox.SetSelLength(const ACustomComboBox: TCustomComboBox; NewLength: integer);
procedure TGtkWSCustomComboBox.SetSelLength(
const ACustomComboBox: TCustomComboBox; NewLength: integer);
begin
WidgetSetSelLength(PGtkCombo(ACustomComboBox.Handle)^.entry, NewLength);
end;
procedure TGtkWSCustomComboBox.SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer);
procedure TGtkWSCustomComboBox.SetItemIndex(
const ACustomComboBox: TCustomComboBox; NewIndex: integer);
begin
// TODO: ugly typecast
SetComboBoxItemIndex(TComboBox(ACustomComboBox), NewIndex);
SetComboBoxItemIndex(ACustomComboBox, NewIndex);
end;
procedure TGtkWSCustomComboBox.SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer);
procedure TGtkWSCustomComboBox.SetMaxLength(
const ACustomComboBox: TCustomComboBox; NewLength: integer);
begin
gtk_entry_set_max_length(PGtkEntry(PGtkCombo(ACustomComboBox.Handle)^.entry), NewLength);
gtk_entry_set_max_length(PGtkEntry(PGtkCombo(ACustomComboBox.Handle)^.entry),
NewLength);
end;
procedure TGtkWSCustomComboBox.SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle);
procedure TGtkWSCustomComboBox.SetStyle(
const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle);
var
GtkCombo: GTK_COMBO;
begin
@ -682,12 +718,15 @@ begin
end;
end;
function TGtkWSCustomComboBox.GetItems(const ACustomComboBox: TCustomComboBox): TStrings;
function TGtkWSCustomComboBox.GetItems(
const ACustomComboBox: TCustomComboBox): TStrings;
begin
Result := TStrings(gtk_object_get_data(PGtkObject(ACustomComboBox.Handle), 'LCLList'));
Result := TStrings(gtk_object_get_data(PGtkObject(ACustomComboBox.Handle),
'LCLList'));
end;
procedure TGtkWSCustomComboBox.Sort(const ACustomComboBox: TCustomComboBox; AList: TStrings; IsSorted: boolean);
procedure TGtkWSCustomComboBox.Sort(const ACustomComboBox: TCustomComboBox;
AList: TStrings; IsSorted: boolean);
begin
TGtkListStringList(AList).Sorted := IsSorted;
end;
@ -696,7 +735,8 @@ end;
function TGtkWSCustomEdit.GetSelStart(const ACustomEdit: TCustomEdit): integer;
begin
Result := WidgetGetSelStart(GetWidgetInfo(Pointer(ACustomEdit.Handle), true)^.CoreWidget);
Result := WidgetGetSelStart(GetWidgetInfo(Pointer(ACustomEdit.Handle),
true)^.CoreWidget);
end;
function TGtkWSCustomEdit.GetSelLength(const ACustomEdit: TCustomEdit): integer;
@ -769,26 +809,22 @@ end;
{ TGtkWSCustomLabel }
procedure TGtkWSCustomLabel.SetAlignment(const ACustomLabel: TCustomLabel; const NewAlignment: TAlignment);
const
cLabelAlignX : array[TAlignment] of gfloat = (0.0, 1.0, 0.5);
cLabelAlignY : array[TTextLayout] of gfloat = (0.0, 0.5, 1.0);
cLabelAlign : array[TAlignment] of TGtkJustification = (GTK_JUSTIFY_LEFT, GTK_JUSTIFY_RIGHT, GTK_JUSTIFY_CENTER);
var
wHandle: HWND;
procedure TGtkWSCustomLabel.SetAlignment(const ACustomLabel: TCustomLabel;
const NewAlignment: TAlignment);
begin
wHandle := ACustomLabel.Handle;
gtk_label_set_justify(GTK_LABEL(wHandle), cLabelAlign[NewAlignment]);
gtk_misc_set_alignment(GTK_MISC(wHandle), cLabelAlignX[NewAlignment],
cLabelAlignY[ACustomLabel.Layout]);
SetLabelAlignment(PGtkLabel(ACustomLabel.Handle),NewAlignment,
ACustomLabel.Layout);
end;
procedure TGtkWSCustomLabel.SetLayout(const ACustomLabel: TCustomLabel; const NewLayout: TTextLayout);
procedure TGtkWSCustomLabel.SetLayout(const ACustomLabel: TCustomLabel;
const NewLayout: TTextLayout);
begin
SetAlignment(ACustomLabel, ACustomLabel.Alignment);
SetLabelAlignment(PGtkLabel(ACustomLabel.Handle),ACustomLabel.Alignment,
NewLayout);
end;
procedure TGtkWSCustomLabel.SetWordWrap(const ACustomLabel: TCustomLabel; const NewWordWrap: boolean);
procedure TGtkWSCustomLabel.SetWordWrap(const ACustomLabel: TCustomLabel;
const NewWordWrap: boolean);
begin
gtk_label_set_line_wrap(GTK_LABEL(ACustomLabel.Handle), NewWordWrap);
end;
@ -826,18 +862,21 @@ begin
Widget:=GetWidgetInfo(Pointer(ACustomMemo.Handle), true)^.CoreWidget;
gtk_text_freeze(PGtkText(Widget));
CurMemoLen := gtk_text_get_length(PGtkText(Widget));
gtk_editable_insert_text(PGtkOldEditable(Widget), PChar(AText), Length(AText), @CurMemoLen);
gtk_editable_insert_text(PGtkOldEditable(Widget), PChar(AText), Length(AText),
@CurMemoLen);
gtk_text_thaw(PGtkText(Widget));
end;
{$ifdef GTK1}
procedure TGtkWSCustomMemo.SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode);
procedure TGtkWSCustomMemo.SetEchoMode(const ACustomEdit: TCustomEdit;
NewMode: TEchoMode);
begin
// no password char in memo
end;
procedure TGtkWSCustomMemo.SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer);
procedure TGtkWSCustomMemo.SetMaxLength(const ACustomEdit: TCustomEdit;
NewLength: integer);
var
ImplWidget : PGtkWidget;
i: integer;
@ -852,12 +891,14 @@ begin
end;
end;
procedure TGtkWSCustomMemo.SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char);
procedure TGtkWSCustomMemo.SetPasswordChar(const ACustomEdit: TCustomEdit;
NewChar: char);
begin
// no password char in memo
end;
procedure TGtkWSCustomMemo.SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean);
procedure TGtkWSCustomMemo.SetReadOnly(const ACustomEdit: TCustomEdit;
NewReadOnly: boolean);
var
ImplWidget : PGtkWidget;
begin
@ -865,7 +906,8 @@ begin
gtk_text_set_editable (GTK_TEXT(ImplWidget), not ACustomEdit.ReadOnly);
end;
procedure TGtkWSCustomMemo.SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle);
procedure TGtkWSCustomMemo.SetScrollbars(const ACustomMemo: TCustomMemo;
const NewScrollbars: TScrollStyle);
var
wHandle: HWND;
begin
@ -895,7 +937,8 @@ begin
end;
end;
procedure TGtkWSCustomMemo.SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean);
procedure TGtkWSCustomMemo.SetWordWrap(const ACustomMemo: TCustomMemo;
const NewWordWrap: boolean);
var
ImplWidget : PGtkWidget;
begin
@ -913,7 +956,8 @@ end;
{ TGtkWSCustomCheckBox }
procedure TGtkWSCustomCheckBox.SetState(const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState);
procedure TGtkWSCustomCheckBox.SetState(const ACustomCheckBox: TCustomCheckBox;
const NewState: TCheckBoxState);
var
GtkObject: PGtkObject;
begin

211
lcl/stdctrls.pp
View File

@ -3,7 +3,7 @@
stdctrls.pp
-----------
Initial Revision : Tue Oct 19 CST 1999
Initial Revision : Tue Oct 19 CST 1999
***************************************************************************/
@ -131,7 +131,7 @@ type
TCustomGroupBox = class (TWinControl) {class(TCustomControl) }
protected
public
constructor Create(AOwner : TComponent); Override;
constructor Create(AOwner: TComponent); Override;
function CanTab: boolean; override;
end;
@ -210,7 +210,7 @@ type
FItemWidth: integer;
FItems: TStrings;
fMaxLength: integer;
FOnChange : TNotifyEvent;
FOnChange: TNotifyEvent;
FOnCloseUp: TNotifyEvent;
FOnDrawItem: TDrawItemEvent;
FOnDropDown: TNotifyEvent;
@ -218,18 +218,18 @@ type
FOnSelect: TNotifyEvent;
FSelLength: integer;
FSelStart: integer;
FSorted : boolean;
FStyle : TComboBoxStyle;
FArrowKeysTraverseList : Boolean;
FReturnArrowState : Boolean; //used to return the state of arrow keys from termporary change
FSorted: boolean;
FStyle: TComboBoxStyle;
FArrowKeysTraverseList: Boolean;
FReturnArrowState: Boolean; //used to return the state of arrow keys from termporary change
function GetDroppedDown: Boolean;
function GetItemWidth: Integer;
procedure SetItemWidth(const AValue: Integer);
procedure SetItems(Value : TStrings);
procedure LMDrawListItem(var TheMessage : TLMDrawListItem); message LM_DrawListItem;
procedure CNCommand(var TheMessage : TLMCommand); message CN_Command;
procedure SetItems(Value: TStrings);
procedure LMDrawListItem(var TheMessage: TLMDrawListItem); message LM_DrawListItem;
procedure CNCommand(var TheMessage: TLMCommand); message CN_Command;
procedure UpdateSorted;
procedure SetArrowKeysTraverseList(Value : Boolean);
procedure SetArrowKeysTraverseList(Value: Boolean);
protected
procedure CreateWnd; override;
procedure DestroyWnd; override;
@ -244,24 +244,24 @@ type
function GetItemCount: Integer; //override;
function GetItemHeight: Integer; virtual;
function GetSelLength : integer; virtual;
function GetSelStart : integer; virtual;
function GetSelText : string; virtual;
function GetItemIndex : integer; virtual;
function GetMaxLength : integer; virtual;
function GetSelLength: integer; virtual;
function GetSelStart: integer; virtual;
function GetSelText: string; virtual;
function GetItemIndex: integer; virtual;
function GetMaxLength: integer; virtual;
procedure InitializeWnd; override;
function SelectItem(const AnItem: String): Boolean;
procedure SetDropDownCount(const AValue: Integer); virtual;
procedure SetDroppedDown(const AValue: Boolean); virtual;
procedure SetItemHeight(const AValue: Integer); virtual;
procedure SetItemIndex(Val : integer); virtual;
procedure SetMaxLength(Val : integer); virtual;
procedure SetSelLength(Val : integer); virtual;
procedure SetSelStart(Val : integer); virtual;
procedure SetSelText(const Val : string); virtual;
procedure SetSorted(Val : boolean); virtual;
procedure SetStyle(Val : TComboBoxStyle); virtual;
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
procedure SetItemIndex(Val: integer); virtual;
procedure SetMaxLength(Val: integer); virtual;
procedure SetSelLength(Val: integer); virtual;
procedure SetSelStart(Val: integer); virtual;
procedure SetSelText(const Val: string); virtual;
procedure SetSorted(Val: boolean); virtual;
procedure SetStyle(Val: TComboBoxStyle); virtual;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8;
property Items: TStrings read FItems write SetItems;
@ -379,7 +379,7 @@ type
procedure SetTopIndex(const AValue: Integer);
procedure UpdateSelectionMode;
procedure UpdateSorted;
procedure LMDrawListItem(var TheMessage : TLMDrawListItem); message LM_DrawListItem;
procedure LMDrawListItem(var TheMessage: TLMDrawListItem); message LM_DrawListItem;
procedure LMSelChange(var TheMessage); message LM_SelChange;
procedure SendItemSelected(Index: integer; IsSelected: boolean);
protected
@ -390,19 +390,19 @@ type
procedure DestroyHandle; override;
procedure CheckIndex(const AIndex: Integer);
function GetItemHeight: Integer;
function GetItemIndex : integer; virtual;
function GetSelCount : integer;
function GetSelected(Index : integer) : boolean;
function GetItemIndex: integer; virtual;
function GetSelCount: integer;
function GetSelected(Index: integer): boolean;
function GetCachedDataSize: Integer; virtual; // returns the amount of data needed per item
function GetCachedData(const AIndex: Integer): Pointer;
procedure SetExtendedSelect(Val : boolean); virtual;
procedure SetItemIndex(Val : integer); virtual;
procedure SetItems(Value : TStrings); virtual;
procedure SetExtendedSelect(Val: boolean); virtual;
procedure SetItemIndex(Val: integer); virtual;
procedure SetItems(Value: TStrings); virtual;
procedure SetItemHeight(Value: Integer);
procedure SetMultiSelect(Val : boolean); virtual;
procedure SetSelected(Index : integer; Val : boolean);
procedure SetSorted(Val : boolean); virtual;
procedure SetStyle(Val : TListBoxStyle); virtual;
procedure SetMultiSelect(Val: boolean); virtual;
procedure SetSelected(Index: integer; Val: boolean);
procedure SetSorted(Val: boolean); virtual;
procedure SetStyle(Val: TListBoxStyle); virtual;
procedure DrawItem(Index: Integer; ARect: TRect;
State: TOwnerDrawState); virtual;
procedure DoSelectionChange(User: Boolean); virtual;
@ -461,7 +461,7 @@ type
property ParentFont;
property ParentShowHint;
property PopupMenu;
property SelCount : integer read GetSelCount;
property SelCount: integer read GetSelCount;
property Selected[Index: integer]: boolean read GetSelected write SetSelected;
property ShowHint;
property Sorted: boolean read FSorted write SetSorted;
@ -536,26 +536,26 @@ type
FOnChange: TNotifyEvent;
FSelLength: integer;
FSelStart: integer;
function GetModified : Boolean;
procedure SetCharCase(Value : TEditCharCase);
procedure SetMaxLength(Value : Integer);
procedure SetModified(Value : Boolean);
function GetModified: Boolean;
procedure SetCharCase(Value: TEditCharCase);
procedure SetMaxLength(Value: Integer);
procedure SetModified(Value: Boolean);
procedure SetPasswordChar(const AValue: Char);
procedure SetReadOnly(Value : Boolean);
procedure SetReadOnly(Value: Boolean);
Protected
Procedure DoAutoSize; Override;
procedure CreateWnd; override;
procedure CMTextChanged(Var Message : TLMessage); message CM_TextChanged;
procedure CMTextChanged(Var Message: TLMessage); message CM_TextChanged;
procedure Change; dynamic;
function GetSelLength : integer; virtual;
function GetSelStart : integer; virtual;
function GetSelText : string; virtual;
function GetSelLength: integer; virtual;
function GetSelStart: integer; virtual;
function GetSelText: string; virtual;
procedure InitializeWnd; override;
procedure SetEchoMode(Val : TEchoMode); virtual;
procedure SetSelLength(Val : integer); virtual;
procedure SetSelStart(Val : integer); virtual;
procedure SetSelText(const Val : string); virtual;
procedure SetEchoMode(Val: TEchoMode); virtual;
procedure SetSelLength(Val: integer); virtual;
procedure SetSelStart(Val: integer); virtual;
procedure SetSelText(const Val: string); virtual;
procedure RealSetText(const Value: TCaption); override;
function ChildClassAllowed(ChildClass: TClass): boolean; override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
@ -614,9 +614,9 @@ type
procedure SetVertScrollBar(const AValue: TMemoScrollBar);
function StoreScrollBars: boolean;
protected
procedure SetLines(const Value : TStrings);
procedure SetWordWrap(const Value : boolean);
procedure SetScrollBars(const Value : TScrollStyle);
procedure SetLines(const Value: TStrings);
procedure SetWordWrap(const Value: boolean);
procedure SetScrollBars(const Value: TScrollStyle);
procedure InitializeWnd; override;
procedure Loaded; override;
function WordWrapIsStored: boolean; virtual;
@ -624,13 +624,13 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Append(const Value : String);
procedure Append(const Value: String);
procedure Clear;
public
property Lines: TStrings read FLines write SetLines;
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
property WordWrap: Boolean read FWordWrap write SetWordWrap stored WordWrapIsStored default true;
//property Font : TFont read FFont write FFont;
//property Font: TFont read FFont write FFont;
property HorzScrollBar: TMemoScrollBar
read FHorzScrollBar write SetHorzScrollBar stored StoreScrollBars;
property VertScrollBar: TMemoScrollBar
@ -714,28 +714,28 @@ type
TCustomLabel = class(TWinControl)
private
FAlignment : TAlignment;
FWordWrap : Boolean;
FLayout : TTextLayout;
FFocusControl : TWinControl;
FShowAccelChar : boolean;
procedure SetAlignment(Value : TAlignment);
procedure SetLayout(Value : TTextLayout);
procedure SetWordWrap(Value : Boolean);
FAlignment: TAlignment;
FWordWrap: Boolean;
FLayout: TTextLayout;
FFocusControl: TWinControl;
FShowAccelChar: boolean;
procedure SetAlignment(Value: TAlignment);
procedure SetLayout(Value: TTextLayout);
procedure SetWordWrap(Value: Boolean);
procedure WMActivate(var Message: TLMActivate); message LM_ACTIVATE;
protected
function GetLabelText: String ; virtual;
procedure DoAutoSize; Override;
procedure DoAutoSize; override;
procedure ParentFormInitializeWnd; override;
procedure Notification(AComponent : TComponent; Operation : TOperation); override;
procedure SetFocusControl(Val : TWinControl); virtual;
procedure SetShowAccelChar(Val : boolean); virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetFocusControl(Val: TWinControl); virtual;
procedure SetShowAccelChar(Val: boolean); virtual;
public
constructor Create(AOwner : TComponent); override;
constructor Create(AOwner: TComponent); override;
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
property FocusControl: TWinControl read FFocusControl write SetFocusControl;
property Layout: TTextLayout read FLayout write SetLayout default tlTop;
property ShowAccelChar : boolean read FShowAccelChar write SetShowAccelChar default true;
property ShowAccelChar: boolean read FShowAccelChar write SetShowAccelChar default true;
property WordWrap: Boolean read FWordWrap write SetWordWrap default false;
end;
@ -881,50 +881,50 @@ type
Private
FAllowGrayed,
FWordWrap,
FAttachTextToBox : Boolean;
FAlignment : TCBAlignment;
FState : TCheckBoxState;
FCheckBoxStyle : TCheckBoxStyle;
FAttachTextToBox: Boolean;
FAlignment: TCBAlignment;
FState : TCheckBoxState;
FCheckBoxStyle: TCheckBoxStyle;
FMouseIsDragging,
FMouseInControl: Boolean;
Protected
Procedure DoAutoSize; Override;
Procedure SetAlignment(Value : TCBAlignment);
Procedure SetState(Value : TCheckBoxState);
Procedure SetAlignment(Value: TCBAlignment);
Procedure SetState(Value: TCheckBoxState);
Function GetChecked : Boolean;
procedure SetChecked(Value : Boolean);
procedure SetCheckBoxStyle(Value : TCheckBoxStyle);
procedure SetAttachTextToBox(Value : Boolean);
Function GetChecked: Boolean;
procedure SetChecked(Value: Boolean);
procedure SetCheckBoxStyle(Value: TCheckBoxStyle);
procedure SetAttachTextToBox(Value: Boolean);
procedure CMMouseEnter(var Message: TLMMouse); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TLMMouse); message CM_MOUSELEAVE;
Procedure WMMouseDown(var Message : TLMMouseEvent); Message LM_LBUTTONDOWN;
Procedure WMMouseUp(var Message : TLMMouseEvent); Message LM_LBUTTONUP;
Procedure WMKeyDown(var Message : TLMKeyDown); Message LM_KeyDown;
Procedure WMKeyUp(var Message : TLMKeyUp); Message LM_KeyUp;
Procedure WMMouseDown(var Message: TLMMouseEvent); Message LM_LBUTTONDOWN;
Procedure WMMouseUp(var Message: TLMMouseEvent); Message LM_LBUTTONUP;
Procedure WMKeyDown(var Message: TLMKeyDown); Message LM_KeyDown;
Procedure WMKeyUp(var Message: TLMKeyUp); Message LM_KeyUp;
public
procedure Paint; Override;
Procedure PaintCheck(var PaintRect: TRect);
Procedure PaintText(var PaintRect: TRect);
Constructor Create(AOwner: TComponent); Override;
Function CheckBoxRect : TRect;
Function CheckBoxRect: TRect;
procedure Click; Override;
Property MouseInControl : Boolean read FMouseInControl;
Property MouseIsDragging : Boolean read FMouseIsDragging;
Property MouseInControl: Boolean read FMouseInControl;
Property MouseIsDragging: Boolean read FMouseIsDragging;
published
property Alignment : TCBAlignment read FAlignment write SetAlignment;
Property AllowGrayed : Boolean read FAllowGrayed write FAllowGrayed;
Property Checked : Boolean read GetChecked write SetChecked;
property State : TCheckBoxState read FState write SetState;
property CheckBoxStyle : TCheckBoxStyle read FCheckBoxStyle write SetCheckBoxStyle;
property AttachToBox : Boolean read FAttachTextToBox write SetAttachTextToBox default True;
property Alignment: TCBAlignment read FAlignment write SetAlignment;
Property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed;
Property Checked: Boolean read GetChecked write SetChecked;
property State: TCheckBoxState read FState write SetState;
property CheckBoxStyle: TCheckBoxStyle read FCheckBoxStyle write SetCheckBoxStyle;
property AttachToBox: Boolean read FAttachTextToBox write SetAttachTextToBox default True;
property Align;
Property AutoSize;
property WordWrap : Boolean read FWordWrap write FWordWrap;
property WordWrap: Boolean read FWordWrap write FWordWrap;
property TabStop;
property Anchors;
@ -1047,26 +1047,26 @@ type
FStaticBorderStyle: TStaticBorderStyle;
FFocusControl: TWinControl;
FShowAccelChar: Boolean;
Procedure FontChange(Sender : TObject);
Procedure FontChange(Sender: TObject);
protected
Procedure DoAutoSize; Override;
Procedure CMTextChanged(var Message: TLMSetText); message CM_TEXTCHANGED;
procedure WMActivate(var Message: TLMActivate); message LM_ACTIVATE;
procedure Notification(AComponent : TComponent; Operation : TOperation); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
Procedure SetAlignment(Value : TAlignment);
Function GetAlignment : TAlignment;
Procedure SetStaticBorderStyle(Value : TStaticBorderStyle);
Function GetStaticBorderStyle : TStaticBorderStyle;
Procedure SetFocusControl(Value : TWinControl);
Procedure SetShowAccelChar(Value : Boolean);
Function GetShowAccelChar : Boolean;
Procedure SetAlignment(Value: TAlignment);
Function GetAlignment: TAlignment;
Procedure SetStaticBorderStyle(Value: TStaticBorderStyle);
Function GetStaticBorderStyle: TStaticBorderStyle;
Procedure SetFocusControl(Value: TWinControl);
Procedure SetShowAccelChar(Value: Boolean);
Function GetShowAccelChar: Boolean;
function CanTab: boolean; override;
property Alignment: TAlignment read GetAlignment write SetAlignment;
property BorderStyle: TStaticBorderStyle read GetStaticBorderStyle write SetStaticBorderStyle;
property FocusControl : TWinControl read FFocusControl write SetFocusControl;
property FocusControl: TWinControl read FFocusControl write SetFocusControl;
property ShowAccelChar: Boolean read GetShowAccelChar write SetShowAccelChar;
public
constructor Create(AOwner: TComponent); override;
@ -1126,12 +1126,12 @@ type
FMemo: TCustomMemo;
FMemoWidgetClass: TWSCustomMemoClass;
protected
function Get(Index : Integer): String; override;
function Get(Index: Integer): String; override;
function GetCount: Integer; override;
public
constructor Create(AMemo: TCustomMemo);
procedure Clear; override;
procedure Delete(index : Integer); override;
procedure Delete(index: Integer); override;
procedure Insert(index: Integer; const S: String); override;
property MemoWidgetClass: TWSCustomMemoClass read FMemoWidgetClass write FMemoWidgetClass;
@ -1175,6 +1175,9 @@ end.
{ =============================================================================
$Log$
Revision 1.170 2004/09/25 15:05:38 mattias
implemented Rename Identifier
Revision 1.169 2004/09/22 19:05:58 mattias
various fixes for TCustomMemo, RTTIControls, FindReferences