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

fixed extract proc selection block level check

Browse Source 
git-svn-id: trunk@5748 -
This commit is contained in:
mattias 2004-08-07 10:57:08 +00:00
parent ebb787e8f5
commit 6efa88fffb
12 changed files with 250 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
components/codetools/codetoolmanager.pas
View File

@ -48,16 +48,17 @@ uses
type
TCodeToolManager = class;
TCodeTool = TEventsCodeTool;
TGetStringProc = procedure(const s: string) of object;
TOnBeforeApplyChanges = procedure(Manager: TCodeToolManager;
var Abort: boolean) of object;
TOnAfterApplyChanges = procedure(Manager: TCodeToolManager) of object;
TCodeTool = TEventsCodeTool;
TOnGatherExternalChanges = procedure(Manager: TCodeToolManager;
var Abort: boolean) of object;
TOnSearchUsedUnit = function(const SrcFilename: string;
const TheUnitName, TheUnitInFilename: string): TCodeBuffer of object;
const TheUnitName, TheUnitInFilename: string
): TCodeBuffer of object;
TOnCodeToolCheckAbort = function: boolean of object;
TCodeToolManager = class
@ -80,6 +81,7 @@ type
FOnAfterApplyChanges: TOnAfterApplyChanges;
FOnBeforeApplyChanges: TOnBeforeApplyChanges;
FOnCheckAbort: TOnCodeToolCheckAbort;
FOnGatherExternalChanges: TOnGatherExternalChanges;
FOnSearchUsedUnit: TOnSearchUsedUnit;
FResourceTool: TResourceCodeTool;
FSetPropertyVariablename: string;
@ -147,24 +149,24 @@ type
// file handling
property SourceExtensions: string
read FSourceExtensions write FSourceExtensions;
read FSourceExtensions write FSourceExtensions;
function FindFile(const ExpandedFilename: string): TCodeBuffer;
function LoadFile(const ExpandedFilename: string;
UpdateFromDisk, Revert: boolean): TCodeBuffer;
UpdateFromDisk, Revert: boolean): TCodeBuffer;
function CreateFile(const AFilename: string): TCodeBuffer;
function CreateTempFile(const AFilename: string): TCodeBuffer;
procedure ReleaseTempFile(Buffer: TCodeBuffer);
function SaveBufferAs(OldBuffer: TCodeBuffer;const ExpandedFilename: string;
var NewBuffer: TCodeBuffer): boolean;
var NewBuffer: TCodeBuffer): boolean;
function FilenameHasSourceExt(const AFilename: string): boolean;
property OnSearchUsedUnit: TOnSearchUsedUnit
read FOnSearchUsedUnit write FOnSearchUsedUnit;
read FOnSearchUsedUnit write FOnSearchUsedUnit;
// exception handling
property CatchExceptions: boolean
read FCatchExceptions write FCatchExceptions;
read FCatchExceptions write FCatchExceptions;
property WriteExceptions: boolean
read FWriteExceptions write FWriteExceptions;
read FWriteExceptions write FWriteExceptions;
property ErrorCode: TCodeBuffer read fErrorCode;
property ErrorColumn: integer read fErrorColumn;
property ErrorLine: integer read fErrorLine;
@ -172,35 +174,39 @@ type
property ErrorTopLine: integer read fErrorTopLine;
property Abortable: boolean read FAbortable write SetAbortable;
property OnCheckAbort: TOnCodeToolCheckAbort
read FOnCheckAbort write FOnCheckAbort;
read FOnCheckAbort write FOnCheckAbort;
// tool settings
property AdjustTopLineDueToComment: boolean
read FAdjustTopLineDueToComment write FAdjustTopLineDueToComment;
property CheckFilesOnDisk: boolean
read FCheckFilesOnDisk write SetCheckFilesOnDisk;
property CursorBeyondEOL: boolean
read FCursorBeyondEOL write SetCursorBeyondEOL;
property AdjustTopLineDueToComment: boolean read FAdjustTopLineDueToComment
write FAdjustTopLineDueToComment;
property CheckFilesOnDisk: boolean read FCheckFilesOnDisk
write SetCheckFilesOnDisk;
property CursorBeyondEOL: boolean read FCursorBeyondEOL
write SetCursorBeyondEOL;
property IndentSize: integer read FIndentSize write SetIndentSize;
property JumpCentered: boolean read FJumpCentered write SetJumpCentered;
property SetPropertyVariablename: string
read FSetPropertyVariablename write FSetPropertyVariablename;
read FSetPropertyVariablename write FSetPropertyVariablename;
property VisibleEditorLines: integer
read FVisibleEditorLines write SetVisibleEditorLines;
read FVisibleEditorLines write SetVisibleEditorLines;
property TabWidth: integer read FTabWidth write SetTabWidth;
property CompleteProperties: boolean
read FCompleteProperties write SetCompleteProperties;
read FCompleteProperties write SetCompleteProperties;
property AddInheritedCodeToOverrideMethod: boolean
read FAddInheritedCodeToOverrideMethod write SetAddInheritedCodeToOverrideMethod;
read FAddInheritedCodeToOverrideMethod
write SetAddInheritedCodeToOverrideMethod;
// source changing
procedure BeginUpdate;
procedure EndUpdate;
function GatherExternalChanges: boolean;
property OnGatherExternalChanges: TOnGatherExternalChanges
read FOnGatherExternalChanges write FOnGatherExternalChanges;
function ApplyChanges: boolean;
property OnBeforeApplyChanges: TOnBeforeApplyChanges
read FOnBeforeApplyChanges write FOnBeforeApplyChanges;
read FOnBeforeApplyChanges write FOnBeforeApplyChanges;
property OnAfterApplyChanges: TOnAfterApplyChanges
read FOnAfterApplyChanges write FOnAfterApplyChanges;
read FOnAfterApplyChanges write FOnAfterApplyChanges;
// defines
function SetGlobalValue(const VariableName, VariableValue: string): boolean;
@ -552,6 +558,18 @@ begin
SourceChangeCache.EndUpdate;
end;
function TCodeToolManager.GatherExternalChanges: boolean;
var
Abort: Boolean;
begin
Result:=true;
if Assigned(OnGatherExternalChanges) then begin
Abort:=false;
OnGatherExternalChanges(Self,Abort);
Result:=not Abort;
end;
end;
function TCodeToolManager.FindFile(const ExpandedFilename: string): TCodeBuffer;
begin
Result:=SourceCache.FindFile(ExpandedFilename);

57
components/codetools/extractproctool.pas
View File

@ -38,12 +38,14 @@ unit ExtractProcTool;
{$mode objfpc}{$H+}
{ $define CTDEBUG}
interface
uses
Classes, SysUtils, CodeToolsStrConsts, CodeTree, CodeAtom, PascalParserTool,
CodeCompletionTool, KeywordFuncLists, BasicCodeTools, LinkScanner, AVL_Tree,
SourceChanger, FindDeclarationTool;
Classes, SysUtils, FileProcs, CodeToolsStrConsts, CodeTree, CodeAtom,
PascalParserTool, CodeCompletionTool, KeywordFuncLists, BasicCodeTools,
LinkScanner, AVL_Tree, SourceChanger, FindDeclarationTool;
type
{ TExtractProcTool }
@ -162,7 +164,7 @@ begin
{$ENDIF}
// check if Start and End on same block level
MoveCursorToNodeStart(CursorNode);
BlockCleanStart:=CurPos.StartPos;
// check every block in selection
while true do begin
ReadNextAtom;
if (CurPos.StartPos>SrcLen) or (CurPos.StartPos>CursorNode.EndPos)
@ -170,14 +172,23 @@ begin
break;
if WordIsLogicalBlockStart.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
then
then begin
BlockCleanStart:=CurPos.StartPos;
if not ReadTilBlockEnd(true,false) then exit;
BlockCleanEnd:=CurPos.EndPos;
if BlockCleanEnd<CleanEndPos then exit;
end
else if WordIsLogicalBlockEnd.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
then begin
exit;
end
else if WordIsLogicalBlockMiddle.DoItUpperCase(UpperSrc,
CurPos.StartPos,CurPos.EndPos-CurPos.StartPos)
then begin
exit;
end;
end;
MoveCursorToCleanPos(BlockCleanStart);
ReadNextAtom;
if not ReadTilBlockEnd(true,false) then exit;
BlockCleanEnd:=CurPos.EndPos;
if BlockCleanEnd<CleanEndPos then exit;
// check if start not in a statement
// ToDo
// check if end not in a statement
@ -224,7 +235,7 @@ var
UsedInNonSelection: Boolean;
begin
{$IFDEF CTDebug}
DebugLn('AddVariableToTree A IsInSelection=',IsInSelection,' IsParameter=',IsParameter);
DebugLn('AddVariableToTree A IsInSelection=',dbgs(IsInSelection),' IsParameter=',dbgs(IsParameter));
{$ENDIF}
UsedInNonSelection:=(not IsInSelection) or IsParameter;
if VarTree=nil then
@ -373,8 +384,8 @@ var
ProcVar:=TExtractedProcVariable(AVLNode.Data);
{$IFDEF CTDebug}
DebugLn('TExtractProcTool.ReplaceSelectionWithCall B ',GetIdentifier(@Src[ProcVar.Node.StartPos]),
' UsedInSelection=',ProcVar.UsedInSelection,
' UsedInNonSelection=',ProcVar.UsedInNonSelection);
' UsedInSelection=',dbgs(ProcVar.UsedInSelection),
' UsedInNonSelection=',dbgs(ProcVar.UsedInNonSelection));
{$ENDIF}
if ProcVar.UsedInSelection and ProcVar.UsedInNonSelection then begin
// variables
@ -390,7 +401,7 @@ var
CallCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
CallCode,Indent);
{$IFDEF CTDebug}
DebugLn('TExtractProcTool.ReplaceSelectionWithCall C "',CallCode,'" Indent=',Indent);
DebugLn('TExtractProcTool.ReplaceSelectionWithCall C "',CallCode,'" Indent=',dbgs(Indent));
{$ENDIF}
SourceChangeCache.Replace(gtNewLine,gtNewLine,BlockStartPos,BlockEndPos,
CallCode);
@ -544,8 +555,8 @@ var
ProcVar:=TExtractedProcVariable(AVLNode.Data);
{$IFDEF CTDebug}
DebugLn('TExtractProcTool.DeleteMovedLocalVariables B ',GetIdentifier(@Src[ProcVar.Node.StartPos]),
' UsedInSelection=',ProcVar.UsedInSelection,
' UsedInNonSelection=',ProcVar.UsedInNonSelection);
' UsedInSelection=',dbgs(ProcVar.UsedInSelection),
' UsedInNonSelection=',dbgs(ProcVar.UsedInNonSelection));
{$ENDIF}
if ProcVar.UsedInSelection and (not ProcVar.UsedInNonSelection) then
begin
@ -604,8 +615,8 @@ var
ProcVar:=TExtractedProcVariable(AVLNode.Data);
{$IFDEF CTDebug}
DebugLn('TExtractProcTool.CreateProcParamList B ',GetIdentifier(@Src[ProcVar.Node.StartPos]),
' UsedInSelection=',ProcVar.UsedInSelection,
' UsedInNonSelection=',ProcVar.UsedInNonSelection);
' UsedInSelection=',dbgs(ProcVar.UsedInSelection),
' UsedInNonSelection=',dbgs(ProcVar.UsedInNonSelection));
{$ENDIF}
if ProcVar.UsedInSelection and ProcVar.UsedInNonSelection then begin
// extract identifier and type
@ -656,8 +667,8 @@ var
ProcVar:=TExtractedProcVariable(AVLNode.Data);
{$IFDEF CTDebug}
DebugLn('TExtractProcTool.CreateProcVarSection B ',GetIdentifier(@Src[ProcVar.Node.StartPos]),
' UsedInSelection=',ProcVar.UsedInSelection,
' UsedInNonSelection=',ProcVar.UsedInNonSelection);
' UsedInSelection=',dbgs(ProcVar.UsedInSelection),
' UsedInNonSelection=',dbgs(ProcVar.UsedInNonSelection));
{$ENDIF}
if ProcVar.UsedInSelection and (not ProcVar.UsedInNonSelection) then
begin
@ -846,7 +857,7 @@ var
RaiseException('New procedure "'+ProcName+'" exists already');
end;
{$IFDEF CTDebug}
DebugLn('NewProcAlreadExists END ProcHead="',ProcHead,'" Found=',Result);
DebugLn('NewProcAlreadExists END ProcHead="',ProcHead,'" Found=',dbgs(Result));
{$ENDIF}
end;
@ -992,12 +1003,12 @@ var
BuildTree(false);
NewProcNode:=FindSubProcPath(SubProcPath,ShortProcFormat,true);
{$IFDEF CTDebug}
DebugLn('FindJumpPointToNewProc A found=',NewProcNode<>nil);
DebugLn('FindJumpPointToNewProc A found=',dbgs(NewProcNode<>nil));
{$ENDIF}
if NewProcNode=nil then exit;
Result:=FindJumpPointInProcNode(NewProcNode,NewPos,NewTopLine);
{$IFDEF CTDebug}
DebugLn('FindJumpPointToNewProc END ',NewProcNode.DescAsString,' ',Result,' ',NewPos.X,',',NewPos.Y,' ',NewTopLine);
DebugLn('FindJumpPointToNewProc END ',NewProcNode.DescAsString,' ',dbgs(Result),' ',dbgs(NewPos.X),',',dbgs(NewPos.Y),' ',dbgs(NewTopLine));
{$ENDIF}
end;

19
components/codetools/keywordfunclists.pas
View File

@ -106,6 +106,8 @@ var
PackedTypesKeyWordFuncList,
BlockStatementStartKeyWordFuncList,
WordIsLogicalBlockStart,
WordIsLogicalBlockEnd,
WordIsLogicalBlockMiddle,
WordIsBinaryOperator,
WordIsLvl1Operator, WordIsLvl2Operator, WordIsLvl3Operator, WordIsLvl4Operator,
WordIsBooleanOperator,
@ -1022,6 +1024,23 @@ begin
Add('UNIT',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
WordIsLogicalBlockEnd:=TKeyWordFunctionList.Create;
KeyWordLists.Add(WordIsLogicalBlockEnd);
with WordIsLogicalBlockEnd do begin
Add(')',{$ifdef FPC}@{$endif}AllwaysTrue);
Add(']',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('}',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('END',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('UNTIL',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
WordIsLogicalBlockMiddle:=TKeyWordFunctionList.Create;
KeyWordLists.Add(WordIsLogicalBlockMiddle);
with WordIsLogicalBlockMiddle do begin
Add('FINALLY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('EXCEPT',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
WordIsBinaryOperator:=TKeyWordFunctionList.Create;
KeyWordLists.Add(WordIsBinaryOperator);
with WordIsBinaryOperator do begin

33
designer/changeclassdialog.pas
View File

@ -35,9 +35,12 @@ unit ChangeClassDialog;
interface
uses
// FCL, LCL
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, AVGLvlTree, PropEdits, LazarusIDEStrConsts, ComponentReg,
FormEditingIntf, CheckLFMDlg;
Buttons, AVGLvlTree,
// IDE
PropEdits, LazarusIDEStrConsts, ComponentReg, FormEditingIntf, CheckLFMDlg,
CodeToolManager;
type
TChangeClassDlg = class(TForm)
@ -108,16 +111,38 @@ function ChangePersistentClass(ADesigner: TIDesigner; APersistent: TPersistent;
NewClass: TClass): TModalResult;
var
ComponentStream: TMemoryStream;
PersistentName: String;
procedure ShowAbortMessage(const Msg: string);
begin
MessageDlg('Error',
Msg+#13
+'Unable to change class of '+PersistentName+' to '+NewClass.ClassName,
mtError,[mbCancel],0);
end;
begin
Result:=mrCancel;
PersistentName:=APersistent.ClassName;
if APersistent is TComponent then begin
PersistentName:=TComponent(APersistent).Name+':'+PersistentName;
end;
ComponentStream:=nil;
try
// select only this persistent
GlobalDesignHook.SelectOnlyThis(APersistent);
// stream selection
ComponentStream:=TMemoryStream.Create;
FormEditingHook.SaveSelectionToStream(ComponentStream);
if not FormEditingHook.SaveSelectionToStream(ComponentStream) then begin
ShowAbortMessage('Unable to stream selected components');
exit;
end;
// parse
if not CodeToolBoss.GatherExternalChanges then begin
ShowAbortMessage('Unable to gather editor changes');
exit;
end;
// change classname
// check properties

6
designer/designer.pp
View File

@ -221,7 +221,7 @@ type
function CanPaste: Boolean; override;
procedure PasteSelection; override;
procedure DeleteSelection; override;
function CopySelectionToStream(s: TStream): boolean; override;
function CopySelectionToStream(AllComponentsStream: TStream): boolean; override;
function InvokeComponentEditor(AComponent: TComponent;
MenuIndex: integer): boolean; override;
procedure DoProcessCommand(Sender: TObject; var Command: word;
@ -401,7 +401,7 @@ begin
SelectOnlyThisComponent(TControl(ControlSelection[i].Persistent).Parent);
end;
function TDesigner.CopySelectionToStream(s: TStream): boolean;
function TDesigner.CopySelectionToStream(AllComponentsStream: TStream): boolean;
function UnselectDistinctControls: boolean;
var
@ -504,7 +504,7 @@ begin
end;
// add text stream to the all stream
TxtCompStream.Position:=0;
s.CopyFrom(TxtCompStream,TxtCompStream.Size);
AllComponentsStream.CopyFrom(TxtCompStream,TxtCompStream.Size);
finally
BinCompStream.Free;
TxtCompStream.Free;

14
ide/extractprocdlg.lfm
View File

@ -2,6 +2,7 @@ object ExtractProcDialog: TExtractProcDialog
Caption = 'ExtractProcDialog'
ClientHeight = 230
ClientWidth = 446
OnClose = ExtractProcDialogClose
OnCreate = ExtractProcDialogCREATE
HorzScrollBar.Page = 447
VertScrollBar.Page = 231
@ -11,7 +12,8 @@ object ExtractProcDialog: TExtractProcDialog
Width = 446
object TypeRadiogroup: TRadioGroup
Caption = 'TypeRadiogroup'
ColumnLayout = clverticalthenhorizontal
ColumnLayout = clVerticalThenHorizontal
ParentColor = True
Left = 8
Height = 120
Top = 8
@ -19,18 +21,16 @@ object ExtractProcDialog: TExtractProcDialog
end
object OkButton: TButton
Caption = 'OkButton'
TabStop = True
TabOrder = 1
OnClick = OkButtonCLICK
TabOrder = 1
Left = 112
Height = 25
Top = 192
Width = 99
end
object CancelButton: TButton
ModalResult = 2
Caption = 'CancelButton'
TabStop = True
ModalResult = 2
TabOrder = 2
Left = 240
Height = 25
@ -49,9 +49,9 @@ object ExtractProcDialog: TExtractProcDialog
Top = 135
Width = 430
object NameEdit: TEdit
Align = altop
Align = alTop
TabOrder = 0
Text = 'NameEdit'
TabStop = True
TabOrder = 0
Height = 23
Width = 426

30
ide/extractprocdlg.lrs
View File

@ -2,19 +2,19 @@
LazarusResources.Add('TExtractProcDialog','FORMDATA',[
'TPF0'#18'TExtractProcDialog'#17'ExtractProcDialog'#7'Caption'#6#17'ExtractPr'
+'ocDialog'#12'ClientHeight'#3#230#0#11'ClientWidth'#3#190#1#8'OnCreate'#7#23
+'ExtractProcDialogCREATE'#18'HorzScrollBar.Page'#3#191#1#18'VertScrollBar.Pa'
+'ge'#3#231#0#4'Left'#3'f'#1#6'Height'#3#230#0#3'Top'#3#247#0#5'Width'#3#190#1
+#0#11'TRadioGroup'#14'TypeRadiogroup'#7'Caption'#6#14'TypeRadiogroup'#12'Col'
+'umnLayout'#7#24'clverticalthenhorizontal'#4'Left'#2#8#6'Height'#2'x'#3'Top'
+#2#8#5'Width'#3#174#1#0#0#7'TButton'#8'OkButton'#7'Caption'#6#8'OkButton'#7
+'TabStop'#9#8'TabOrder'#2#1#7'OnClick'#7#13'OkButtonCLICK'#4'Left'#2'p'#6'He'
+'ight'#2#25#3'Top'#3#192#0#5'Width'#2'c'#0#0#7'TButton'#12'CancelButton'#11
+'ModalResult'#2#2#7'Caption'#6#12'CancelButton'#7'TabStop'#9#8'TabOrder'#2#2
+#4'Left'#3#240#0#6'Height'#2#25#3'Top'#3#192#0#5'Width'#2'^'#0#0#9'TGroupBox'
+#12'NameGroupbox'#7'Caption'#6#12'NameGroupbox'#12'ClientHeight'#2#27#11'Cli'
+'entWidth'#3#170#1#11'ParentColor'#9#11'ParentCtl3D'#8#8'TabOrder'#2#3#4'Lef'
+'t'#2#8#6'Height'#2','#3'Top'#3#135#0#5'Width'#3#174#1#0#5'TEdit'#8'NameEdit'
+#5'Align'#7#5'altop'#4'Text'#6#8'NameEdit'#7'TabStop'#9#8'TabOrder'#2#0#6'He'
+'ight'#2#23#5'Width'#3#170#1#0#0#0#0
+'ocDialog'#12'ClientHeight'#3#230#0#11'ClientWidth'#3#190#1#7'OnClose'#7#22
+'ExtractProcDialogClose'#8'OnCreate'#7#23'ExtractProcDialogCREATE'#18'HorzSc'
+'rollBar.Page'#3#191#1#18'VertScrollBar.Page'#3#231#0#4'Left'#3'f'#1#6'Heigh'
+'t'#3#230#0#3'Top'#3#247#0#5'Width'#3#190#1#0#11'TRadioGroup'#14'TypeRadiogr'
+'oup'#7'Caption'#6#14'TypeRadiogroup'#12'ColumnLayout'#7#24'clVerticalThenHo'
+'rizontal'#11'ParentColor'#9#4'Left'#2#8#6'Height'#2'x'#3'Top'#2#8#5'Width'#3
+#174#1#0#0#7'TButton'#8'OkButton'#7'Caption'#6#8'OkButton'#7'OnClick'#7#13'O'
+'kButtonCLICK'#8'TabOrder'#2#1#4'Left'#2'p'#6'Height'#2#25#3'Top'#3#192#0#5
+'Width'#2'c'#0#0#7'TButton'#12'CancelButton'#7'Caption'#6#12'CancelButton'#11
+'ModalResult'#2#2#8'TabOrder'#2#2#4'Left'#3#240#0#6'Height'#2#25#3'Top'#3#192
+#0#5'Width'#2'^'#0#0#9'TGroupBox'#12'NameGroupbox'#7'Caption'#6#12'NameGroup'
+'box'#12'ClientHeight'#2#27#11'ClientWidth'#3#170#1#11'ParentColor'#9#11'Par'
+'entCtl3D'#8#8'TabOrder'#2#3#4'Left'#2#8#6'Height'#2','#3'Top'#3#135#0#5'Wid'
+'th'#3#174#1#0#5'TEdit'#8'NameEdit'#5'Align'#7#5'alTop'#8'TabOrder'#2#0#4'Te'
+'xt'#6#8'NameEdit'#8'TabOrder'#2#0#6'Height'#2#23#5'Width'#3#170#1#0#0#0#0
]);

76
ide/extractprocdlg.pas
View File

@ -6,7 +6,8 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Buttons, StdCtrls, CodeCache, CodeToolManager, ExtractProcTool, IDEProcs;
Buttons, StdCtrls, CodeCache, CodeToolManager, ExtractProcTool,
LazarusIDEStrConsts, IDEProcs, MiscOptions;
type
TExtractProcDialog = class(TForm)
@ -16,6 +17,8 @@ type
CancelButton: TBUTTON;
TypeRadiogroup: TRADIOGROUP;
procedure ExtractProcDialogCREATE(Sender: TObject);
procedure ExtractProcDialogClose(Sender: TObject;
var CloseAction: TCloseAction);
procedure OkButtonCLICK(Sender: TObject);
private
FMethodPossible: boolean;
@ -48,8 +51,8 @@ var
begin
Result:=mrCancel;
if CompareCaret(BlockBegin,BlockEnd)<=0 then begin
MessageDlg('No code selected',
'Please select some code to extract a new procedure/method.',
MessageDlg(lisNoCodeSelected,
lisPleaseSelectSomeCodeToExtractANewProcedureMethod,
mtInformation,[mbCancel],0);
exit;
end;
@ -60,9 +63,8 @@ begin
SubProcSameLvlPossible)
then begin
if CodeToolBoss.ErrorMessage='' then begin
MessageDlg('Invalid selection',
'This statement can not be extracted.'#13
+'Please select some code to extract a new procedure/method.',
MessageDlg(lisInvalidSelection,
Format(lisThisStatementCanNotBeExtractedPleaseSelectSomeCode, [#13]),
mtInformation,[mbCancel],0);
end;
exit;
@ -96,12 +98,18 @@ end;
procedure TExtractProcDialog.ExtractProcDialogCREATE(Sender: TObject);
begin
Caption:='Extract Procedure';
NameGroupbox.Caption:='Name of new procedure';
OkButton.Caption:='Extract';
CancelButton.Caption:='Cancel';
TypeRadiogroup.Caption:='Type';
NameEdit.Text:='NewProc';
Caption:=lisExtractProcedure;
NameGroupbox.Caption:=lisNameOfNewProcedure;
OkButton.Caption:=lisExtract;
CancelButton.Caption:=dlgCancel;
TypeRadiogroup.Caption:=dlgEnvType;
NameEdit.Text:=MiscellaneousOptions.ExtractProcName;
end;
procedure TExtractProcDialog.ExtractProcDialogClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
MiscellaneousOptions.ExtractProcName:=NameEdit.Text;
end;
procedure TExtractProcDialog.OkButtonCLICK(Sender: TObject);
@ -110,8 +118,8 @@ var
begin
ProcName:=GetProcName;
if (ProcName='') or (not IsValidIdent(ProcName)) then begin
MessageDlg('Invalid proc name',
'"'+ProcName+'" is not a valid identifier.',
MessageDlg(lisInvalidProcName,
Format(lisSVUOisNotAValidIdentifier, ['"', ProcName, '"']),
mtError,[mbCancel],0);
exit;
end;
@ -124,37 +132,39 @@ begin
BeginUpdate;
Clear;
if MethodPossible then begin
Add('Public Method');
Add('Private Method');
Add('Protected Method');
Add('Published Method');
Add(lisPublicMethod);
Add(lisPrivateMethod);
Add(lisProtectedMethod);
Add(lisPublishedMethod);
TypeRadiogroup.Columns:=2;
end else begin
TypeRadiogroup.Columns:=1;
end;
Add('Procedure');
Add('Procedure with interface');
Add('Sub Procedure');
Add(lisProcedure);
Add(lisProcedureWithInterface);
Add(lisSubProcedure);
if SubProcSameLvlPossible then
Add('Sub Procedure on same level');
Add(lisSubProcedureOnSameLevel);
EndUpdate;
TypeRadiogroup.ItemIndex:=Count-1;
end;
end;
function TExtractProcDialog.GetProcType: TExtractProcType;
var
Item: string;
begin
case TypeRadiogroup.ItemIndex of
0: Result:=eptPublicMethod;
1: Result:=eptPrivateMethod;
2: Result:=eptProtectedMethod;
3: Result:=eptPublishedMethod;
4: Result:=eptProcedure;
5: Result:=eptProcedureWithInterface;
6: Result:=eptSubProcedure;
7: Result:=eptSubProcedureSameLvl;
else
Result:=eptSubProcedure;
Result:=eptSubProcedure;
if TypeRadiogroup.ItemIndex>=0 then begin
Item:=TypeRadiogroup.Items[TypeRadiogroup.ItemIndex];
if Item=lisPublicMethod then Result:=eptPublicMethod
else if Item=lisPrivateMethod then Result:=eptPrivateMethod
else if Item=lisProtectedMethod then Result:=eptProtectedMethod
else if Item=lisPublishedMethod then Result:=eptPublishedMethod
else if Item=lisProcedure then Result:=eptProcedure
else if Item=lisProcedureWithInterface then Result:=eptProcedureWithInterface
else if Item=lisSubProcedure then Result:=eptSubProcedure
else if Item=lisSubProcedureOnSameLevel then Result:=eptSubProcedureSameLvl;
end;
end;

21
ide/lazarusidestrconsts.pas
View File

@ -2400,6 +2400,27 @@ resourcestring
+'LCL. The normal fix is to remove these properties from the lfm and fix '
+'the pascal code manually.';
// extract proc dialog
lisNoCodeSelected = 'No code selected';
lisPleaseSelectSomeCodeToExtractANewProcedureMethod = 'Please select some '
+'code to extract a new procedure/method.';
lisInvalidSelection = 'Invalid selection';
lisThisStatementCanNotBeExtractedPleaseSelectSomeCode = 'This statement can '
+'not be extracted.%sPlease select some code to extract a new procedure/'
+'method.';
lisExtractProcedure = 'Extract Procedure';
lisNameOfNewProcedure = 'Name of new procedure';
lisExtract = 'Extract';
lisInvalidProcName = 'Invalid proc name';
lisPublicMethod = 'Public Method';
lisPrivateMethod = 'Private Method';
lisProtectedMethod = 'Protected Method';
lisPublishedMethod = 'Published Method';
lisProcedure = 'Procedure';
lisProcedureWithInterface = 'Procedure with interface';
lisSubProcedure = 'Sub Procedure';
lisSubProcedureOnSameLevel = 'Sub Procedure on same level';
implementation
end.

25
ide/main.pp
View File

@ -366,6 +366,8 @@ type
const Filename: string; const LineNumber: integer);
// CodeToolBoss events
procedure OnCodeToolNeedsExternalChanges(Manager: TCodeToolManager;
var Abort: boolean);
procedure OnBeforeCodeToolBossApplyChanges(Manager: TCodeToolManager;
var Abort: boolean);
procedure OnAfterCodeToolBossApplyChanges(Manager: TCodeToolManager);
@ -8414,6 +8416,15 @@ begin
DoJumpToSourcePos(Filename,1,LineNumber,-1,true);
end;
procedure TMainIDE.OnCodeToolNeedsExternalChanges(Manager: TCodeToolManager;
var Abort: boolean);
var
ActiveSrcEdit: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
begin
Abort:=not BeginCodeTool(ActiveSrcEdit,ActiveUnitInfo,[]);
end;
// -----------------------------------------------------------------------------
procedure TMainIDE.InitCodeToolBoss;
@ -8539,6 +8550,7 @@ begin
with CodeToolBoss do begin
WriteExceptions:=true;
CatchExceptions:=true;
OnGatherExternalChanges:=@OnCodeToolNeedsExternalChanges;
OnBeforeApplyChanges:=@OnBeforeCodeToolBossApplyChanges;
OnAfterApplyChanges:=@OnAfterCodeToolBossApplyChanges;
OnSearchUsedUnit:=@OnCodeToolBossSearchUsedUnit;
@ -8690,7 +8702,17 @@ begin
end;
procedure TMainIDE.OnAfterCodeToolBossApplyChanges(Manager: TCodeToolManager);
var
i: Integer;
SrcBuf: TCodeBuffer;
AnUnitInfo: TUnitInfo;
begin
for i:=0 to CodeToolBoss.SourceChangeCache.BuffersToModifyCount-1 do begin
SrcBuf:=CodeToolBoss.SourceChangeCache.BuffersToModify[i];
AnUnitInfo:=Project1.UnitInfoWithFilename(SrcBuf.Filename);
if AnUnitInfo<>nil then
AnUnitInfo.Modified:=true;
end;
SourceNoteBook.UnlockAllEditorsInSourceChangeCache;
end;
@ -10488,6 +10510,9 @@ end.
{ =============================================================================
$Log$
Revision 1.744 2004/08/07 10:57:08 mattias
fixed extract proc selection block level check
Revision 1.743 2004/08/07 07:03:29 mattias
implemented virtual temporary ct files

10
ide/miscoptions.pas
View File

@ -37,6 +37,7 @@ type
TMiscellaneousOptions = class
private
fBuildLazOpts: TBuildLazarusOptions;
FExtractProcName: string;
fFilename: string;
FMakeResourceStringInsertPolicy: TResourcestringInsertPolicy;
FSortSelDirection: TSortDirection;
@ -51,6 +52,7 @@ type
property BuildLazOpts: TBuildLazarusOptions
read fBuildLazOpts write fBuildLazOpts;
property ExtractProcName: string read FExtractProcName write FExtractProcName;
property SortSelDirection: TSortDirection read FSortSelDirection
write FSortSelDirection;
property SortSelDomain: TSortDomain read FSortSelDomain write FSortSelDomain;
@ -110,6 +112,10 @@ constructor TMiscellaneousOptions.Create;
begin
inherited Create;
BuildLazOpts:=TBuildLazarusOptions.Create;
FExtractProcName:='NewProc';
fSortSelDirection:=sdAscending;
fSortSelDomain:=sdLines;
fMakeResourceStringInsertPolicy:=rsipAppend;
end;
destructor TMiscellaneousOptions.Destroy;
@ -160,6 +166,8 @@ begin
MakeResourceStringInsertPolicy:=ResourcestringInsertPolicyNameToType(
XMLConfig.GetValue(Path+'MakeResourcestringInsertPolicy/Value',
ResourcestringInsertPolicyNames[rsipAppend]));
ExtractProcName:=XMLConfig.GetValue(
Path+'ExtractProcName/Value','NewProc');
finally
XMLConfig.Free;
end;
@ -198,6 +206,8 @@ begin
XMLConfig.SetDeleteValue(Path+'MakeResourcestringInsertPolicy/Value',
ResourcestringInsertPolicyNames[MakeResourceStringInsertPolicy],
ResourcestringInsertPolicyNames[rsipAppend]);
XMLConfig.SetDeleteValue(Path+'ExtractProcName/Value',ExtractProcName,
'NewProc');
XMLConfig.Flush;
finally
XMLConfig.Free;

7
ide/project.pp
View File

@ -1671,7 +1671,6 @@ begin
if (ShortUnitName<>'') and (not UnitIsUsed(ShortUnitName)) then begin
CodeToolBoss.AddUnitToMainUsesSection(MainUnitInfo.Source,
ShortUnitName,'');
MainUnitInfo.Modified:=true;
end;
end;
EndUpdate;
@ -1702,12 +1701,10 @@ begin
if (OldUnitInfo.UnitName<>'') then begin
CodeToolBoss.RemoveUnitFromAllUsesSections(MainUnitInfo.Source,
OldUnitInfo.UnitName);
MainUnitInfo.Modified:=true;
end;
if (OldUnitInfo.ComponentName<>'') then begin
CodeToolBoss.RemoveCreateFormStatement(MainUnitInfo.Source,
OldUnitInfo.ComponentName);
MainUnitInfo.Modified:=true;
end;
end;
end;
@ -2525,7 +2522,6 @@ begin
// rename unit in program uses section
CodeToolBoss.RenameUsedUnit(MainUnitInfo.Source
,OldUnitName,NewUnitName,'');
MainUnitInfo.Modified:=true;
end;
end;
end;
@ -2860,6 +2856,9 @@ end.
{
$Log$
Revision 1.157 2004/08/07 10:57:08 mattias
fixed extract proc selection block level check
Revision 1.156 2004/08/07 07:03:29 mattias
implemented virtual temporary ct files