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

fixed win32 lazconf and improved enclose selection

Browse Source 
git-svn-id: trunk@4493 -
This commit is contained in:
mattias 2003-08-18 10:02:37 +00:00
parent 11e77dd2c1
commit 2e3f11e1ec
13 changed files with 727 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6,6 +6,7 @@ components/codetools/basiccodetools.pas svneol=native#text/pascal
components/codetools/codeatom.pas svneol=native#text/pascal
components/codetools/codecache.pas svneol=native#text/pascal
components/codetools/codecompletiontool.pas svneol=native#text/pascal
components/codetools/codetemplatestool.pas svneol=native#text/pascal
components/codetools/codetoolmanager.pas svneol=native#text/pascal
components/codetools/codetoolmemmanager.pas svneol=native#text/pascal
components/codetools/codetools.inc svneol=native#text/pascal

7
components/codetools/Makefile.fpc
View File

@ -19,9 +19,10 @@ options=-gl
units=allcodetoolunits
implicitunits=codetoolsstrconsts avl_tree basiccodetools codecache sourcelog \
customcodetool multikeywordlisttool pascalparsertool finddeclarationtool \
identcompletiontool stdcodetools resourcecodetool methodjumptool \
eventcodetool codecompletiontool codeatom codetree definetemplates expreval \
keywordfunclists linkscanner sourcechanger fileprocs codetoolsstructs \
identcompletiontool stdcodetools resourcecodetool codetemplatestool \
methodjumptool eventcodetool codecompletiontool codeatom codetree \
definetemplates expreval keywordfunclists linkscanner sourcechanger \
fileprocs codetoolsstructs \
codetoolmanager memcheck
[clean]

66
components/codetools/basiccodetools.pas
View File

@ -53,6 +53,9 @@ procedure GetLineStartEndAtPosition(const Source:string; Position:integer;
var LineStart,LineEnd:integer);
function GetLineIndent(const Source: string; Position: integer): integer;
function GetIndentStr(Indent: integer): string;
procedure IndentText(const Source: string; Indent: integer;
var NewSource: string);
function LineEndCount(const Txt: string): integer;
function LineEndCount(const Txt: string; var LengthOfLastLine:integer): integer;
function PositionsInSameLine(const Source: string;
Pos1, Pos2: integer): boolean;
@ -1399,7 +1402,7 @@ begin
inc(LineStart);
// search code
Result:=LineStart;
while (Result<length(Source)) and (Source[Result]<=' ') do inc(Result);
while (Result<=length(Source)) and (Source[Result]=' ') do inc(Result);
dec(Result,LineStart);
end;
@ -2079,6 +2082,67 @@ begin
FillChar(Result[1],length(Result),' ');
end;
procedure IndentText(const Source: string; Indent: integer;
var NewSource: string);
var
LengthOfLastLine: integer;
LineEndCnt: Integer;
SrcPos: Integer;
SrcLen: Integer;
NewSrcPos: Integer;
c: Char;
procedure AddIndent;
var
i: Integer;
begin
for i:=1 to Indent do begin
NewSource[NewSrcPos]:=' ';
inc(NewSrcPos);
end;
end;
begin
if (Indent<=0) or (Source='') then begin
NewSource:=Source;
exit;
end;
LineEndCnt:=LineEndCount(Source,LengthOfLastLine);
if LengthOfLastLine>0 then inc(LineEndCnt);
SetLength(NewSource,LineEndCnt*Indent+length(Source));
SrcPos:=1;
SrcLen:=length(Source);
NewSrcPos:=1;
AddIndent;
while SrcPos<=SrcLen do begin
c:=Source[SrcPos];
// copy char
NewSource[NewSrcPos]:=Source[SrcPos];
inc(NewSrcPos);
inc(SrcPos);
if (c in [#10,#13]) then begin
// line end
if (SrcPos<=SrcLen) and (Source[SrcPos] in [#10,#13])
and (Source[SrcPos]<>Source[SrcPos-1]) then begin
NewSource[NewSrcPos]:=Source[SrcPos];
inc(NewSrcPos);
inc(SrcPos);
end;
if (SrcPos<=SrcLen) and (not (Source[SrcPos] in [#10,#13])) then begin
// next line not empty -> indent
AddIndent;
end;
end;
end;
end;
function LineEndCount(const Txt: string): integer;
var
LengthOfLastLine: integer;
begin
Result:=LineEndCount(Txt,LengthOfLastLine);
end;
function TrimCodeSpace(const ACode: string): string;
// turn all lineends and special chars to space
// space is combined to one char

286
components/codetools/codetemplatestool.pas Normal file
View File

@ -0,0 +1,286 @@
{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
TCodeTemplatesTool enhances TStandardCodeTool with the ability to insert
code templates.
}
unit CodeTemplatesTool;
{$mode objfpc}{$H+}
interface
{$I codetools.inc}
{ $DEFINE IgnoreErrorAfterCursor}
uses
{$IFDEF MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, CodeToolsStrConsts, CodeTree, CodeAtom,
PascalReaderTool, PascalParserTool, SourceLog,
KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache, AVL_Tree,
SourceChanger, CustomCodeTool, CodeToolsStructs, StdCodeTools;
type
TCodeTemplateSyntax = (
ctsxDefault
);
{ ctsxDefault:
The backslash '\' makes special chars to normal chars.
| for cursor
$(MacroName) for macro variables
$MacroName(Param) for macro functions
If the variable contains several lines, the lines are indented like the
first line.
Example:
Inserting the text
"begin"
" i:=1;"
"end;"
Into the text
"begin"
" |"
"end;"
at the | results in
"begin"
" begin"
" i:=1;"
" end;"
"end;"
Defined variables:
$(Selection) - replaced by the current selection
$(Indent) - replaced by nothing. Set Indent for multiline macros
Example:
Text: " Text: $(Indent)$(Selection)"
Selection: "First"
"Second"
Result: " Text: First"
" Second"
}
TCodeToolTemplate = class
private
FIndent: integer;
FNewLineAtEnd: boolean;
FNewLineAtStart: boolean;
FSyntax: TCodeTemplateSyntax;
FTemplate: string;
procedure SetIndent(const AValue: integer);
procedure SetNewLineAtEnd(const AValue: boolean);
procedure SetNewLineAtStart(const AValue: boolean);
procedure SetSyntax(const AValue: TCodeTemplateSyntax);
procedure SetTemplate(const AValue: string);
public
property Template: string read FTemplate write SetTemplate;
property NewLineAtStart: boolean read FNewLineAtStart write SetNewLineAtStart;
property NewLineAtEnd: boolean read FNewLineAtEnd write SetNewLineAtEnd;
property Syntax: TCodeTemplateSyntax read FSyntax write SetSyntax;
property Indent: integer read FIndent write SetIndent;
end;
TCodeTemplatesTool = class(TStandardCodeTool)
public
function InsertCodeTemplate(CursorPos,EndPos: TCodeXYPosition;
TopLine: integer; CodeTemplate: TCodeToolTemplate;
var NewPos: TCodeXYPosition; var NewTopLine: integer;
SourceChangeCache: TSourceChangeCache): boolean;
end;
implementation
{ TCodeTemplatesTool }
function TCodeTemplatesTool.InsertCodeTemplate(CursorPos,
EndPos: TCodeXYPosition; TopLine: integer; CodeTemplate: TCodeToolTemplate;
var NewPos: TCodeXYPosition; var NewTopLine: integer;
SourceChangeCache: TSourceChangeCache): boolean;
var
NewText: TMemoryStream;
TemplatePos: Integer;
LastWrittenTemplatePos: Integer;
TemplateStr: String;
TemplateStrLen: Integer;
procedure FlushTemplate;
var
FromPos: Integer;
ToPos: Integer;
begin
FromPos:=LastWrittenTemplatePos+1;
ToPos:=TemplatePos-1;
if ToPos>TemplateStrLen then
ToPos:=TemplateStrLen;
if FromPos<=ToPos then
NewText.Write(TemplateStr[FromPos],ToPos-FromPos+1);
LastWrittenTemplatePos:=ToPos;
end;
procedure CalculateNewCursorPos;
begin
end;
procedure ParseMacro;
var
MacroStart: Integer;
MacroFuncNameStart: Integer;
MacroFuncNameEnd: Integer;
BracketLvl: Integer;
MacroParamStart: Integer;
MacroParamEnd: Integer;
begin
MacroStart:=TemplatePos;
inc(MacroStart);
MacroFuncNameStart:=TemplatePos;
while (TemplatePos<=TemplateStrLen)
and IsIdentChar[TemplateStr[TemplatePos]] do
inc(TemplatePos);
MacroFuncNameEnd:=TemplatePos;
if (TemplatePos<=TemplateStrLen) and (TemplateStr[TemplatePos]='(') then
begin
inc(TemplatePos);
MacroParamStart:=TemplatePos;
MacroParamEnd:=MacroParamStart;
BracketLvl:=1;
while (TemplatePos<=TemplateStrLen) do begin
case TemplateStr[TemplatePos] of
'\':
begin
inc(TemplatePos);
if (TemplatePos>TemplateStrLen) then break;
end;
'(': inc(BracketLvl);
')':
begin
dec(BracketLvl);
if BracketLvl=0 then begin
MacroParamEnd:=TemplatePos;
break;
end;
end;
end;
inc(TemplatePos);
end;
if MacroFuncNameStart<MacroFuncNameEnd then begin
// a macro function
// ToDo
end else if MacroParamStart<MacroParamEnd then begin
// a macro variable
// ToDo
end;
end;
LastWrittenTemplatePos:=TemplatePos;
end;
begin
Result:=false;
NewPos:=CursorPos;
NewText:=TMemoryStream.Create;
try
// parse the template
TemplatePos:=1;
LastWrittenTemplatePos:=TemplatePos-1;
TemplateStr:=CodeTemplate.Template;
TemplateStrLen:=length(TemplateStr);
while TemplatePos<=TemplateStrLen do begin
case TemplateStr[TemplatePos] of
'\':
begin
FlushTemplate;
LastWrittenTemplatePos:=TemplatePos;
inc(TemplatePos,2);
end;
'|':
begin
FlushTemplate;
CalculateNewCursorPos;
LastWrittenTemplatePos:=TemplatePos;
inc(TemplatePos);
end;
'$':
begin
FlushTemplate;
ParseMacro;
end;
else
inc(TemplatePos);
end;
end;
FlushTemplate;
finally
NewText.Free;
end;
end;
{ TCodeToolTemplate }
procedure TCodeToolTemplate.SetIndent(const AValue: integer);
begin
if FIndent=AValue then exit;
FIndent:=AValue;
end;
procedure TCodeToolTemplate.SetNewLineAtEnd(const AValue: boolean);
begin
if FNewLineAtEnd=AValue then exit;
FNewLineAtEnd:=AValue;
end;
procedure TCodeToolTemplate.SetNewLineAtStart(const AValue: boolean);
begin
if FNewLineAtStart=AValue then exit;
FNewLineAtStart:=AValue;
end;
procedure TCodeToolTemplate.SetSyntax(const AValue: TCodeTemplateSyntax);
begin
if FSyntax=AValue then exit;
FSyntax:=AValue;
end;
procedure TCodeToolTemplate.SetTemplate(const AValue: string);
begin
if FTemplate=AValue then exit;
FTemplate:=AValue;
end;
end.

44
components/codetools/codetoolmanager.pas
View File

@ -43,7 +43,8 @@ uses
Classes, SysUtils, FileProcs, BasicCodeTools, CodeToolsStrConsts,
EventCodeTool, CodeTree, CodeAtom, SourceChanger, DefineTemplates, CodeCache,
ExprEval, LinkScanner, KeywordFuncLists, TypInfo, AVL_Tree, CustomCodeTool,
FindDeclarationTool, IdentCompletionTool, ResourceCodeTool, CodeToolsStructs;
FindDeclarationTool, IdentCompletionTool, ResourceCodeTool, CodeToolsStructs,
CodeTemplatesTool;
type
TCodeToolManager = class;
@ -295,6 +296,14 @@ type
function CompleteCode(Code: TCodeBuffer; X,Y,TopLine: integer;
var NewCode: TCodeBuffer;
var NewX, NewY, NewTopLine: integer): boolean;
// code templates
function InsertCodeTemplate(Code: TCodeBuffer;
SelectionStart, SelectionEnd: TPoint;
TopLine: integer;
CodeTemplate: TCodeToolTemplate;
var NewCode: TCodeBuffer;
var NewX, NewY, NewTopLine: integer): boolean;
// source name e.g. 'unit UnitName;'
function GetSourceName(Code: TCodeBuffer; SearchMainCode: boolean): string;
@ -1525,6 +1534,39 @@ begin
end;
end;
function TCodeToolManager.InsertCodeTemplate(Code: TCodeBuffer;
SelectionStart, SelectionEnd: TPoint; TopLine: integer;
CodeTemplate: TCodeToolTemplate; var NewCode: TCodeBuffer; var NewX, NewY,
NewTopLine: integer): boolean;
var
CursorPos: TCodeXYPosition;
EndPos: TCodeXYPosition;
NewPos: TCodeXYPosition;
begin
{$IFDEF CTDEBUG}
writeln('TCodeToolManager.InsertCodeTemplate A ',Code.Filename,' x=',x,' y=',y);
{$ENDIF}
Result:=false;
if not InitCurCodeTool(Code) then exit;
CursorPos.X:=SelectionStart.X;
CursorPos.Y:=SelectionStart.Y;
CursorPos.Code:=Code;
EndPos.X:=SelectionStart.X;
EndPos.Y:=SelectionStart.Y;
EndPos.Code:=Code;
try
Result:=FCurCodeTool.InsertCodeTemplate(CursorPos,EndPos,TopLine,
CodeTemplate,NewPos,NewTopLine,SourceChangeCache);
if Result then begin
NewX:=NewPos.X;
NewY:=NewPos.Y;
NewCode:=NewPos.Code;
end;
except
on e: Exception do Result:=HandleException(e);
end;
end;
function TCodeToolManager.GetSourceName(Code: TCodeBuffer;
SearchMainCode: boolean): string;
begin

8
components/codetools/methodjumptool.pas
View File

@ -21,7 +21,7 @@
Author: Mattias Gaertner
Abstract:
TMethodJumpingCodeTool enhances TStandardCodeTool with functions to jump
TMethodJumpingCodeTool enhances TCodeTemplatesTool with functions to jump
between a method definition and its body and a forward procedure and its
body.
@ -41,12 +41,12 @@ uses
MemCheck,
{$ENDIF}
Classes, SysUtils, CodeToolsStrConsts, CodeTree, CodeAtom, PascalParserTool,
StdCodeTools, SourceLog, KeywordFuncLists, BasicCodeTools, LinkScanner,
CodeCache, AVL_Tree, TypInfo, SourceChanger;
StdCodeTools, CodeTemplatesTool, SourceLog, KeywordFuncLists, BasicCodeTools,
LinkScanner, CodeCache, AVL_Tree, TypInfo, SourceChanger;
type
TMethodJumpingCodeTool = class(TStandardCodeTool)
TMethodJumpingCodeTool = class(TCodeTemplatesTool)
private
FAdjustTopLineDueToComment: boolean;
protected

135
components/codetools/sourcechanger.pas
View File

@ -74,7 +74,9 @@ type
TAtomTypes = set of TAtomType;
TBeautifyCodeFlag = (
bcfNoIndentOnBreakLine
bcfNoIndentOnBreakLine,
bcfDoNotIndentFirstLine,
bcfIndentExistingLineBreaks
);
TBeautifyCodeFlags = set of TBeautifyCodeFlag;
@ -84,7 +86,7 @@ type
LastSplitPos: integer; // last position where splitting is allowed
LastSrcLineStart: integer;// last line start, not added by splitting
CurAtomType, LastAtomType: TAtomType;
CurPos, AtomStart, AtomEnd, SrcLen, CurIndent: integer;
CurPos, AtomStart, AtomEnd, SrcLen, CurIndent, HiddenIndent: integer;
Src, UpperSrc: string;
procedure AddAtom(var CurCode: string; NewAtom: string);
procedure ReadNextAtom;
@ -107,7 +109,7 @@ type
PropertyWriteIdentPrefix: string;
PropertyStoredIdentPostfix: string;
PrivatVariablePrefix: string;
CurFlags: TBeautifyCodeFlags;
CurFlags: TBeautifyCodeFlags;
function BeautifyProc(const AProcCode: string; IndentSize: integer;
AddBeginEnd: boolean): string;
@ -838,6 +840,8 @@ end;
procedure TBeautifyCodeOptions.AddAtom(var CurCode: string; NewAtom: string);
var
RestLineLen, LastLineEndInAtom: integer;
BreakPos: Integer;
IndentLen: Integer;
begin
if NewAtom='' then exit;
//writeln('[TBeautifyCodeOptions.AddAtom] NewAtom=',NewAtom,' s="',s,'"');
@ -850,6 +854,26 @@ begin
NewAtom:=BeautifyWord(NewAtom,IdentifierPolicy);
end;
// indent existing line break
if bcfIndentExistingLineBreaks in CurFlags then begin
BreakPos:=1;
while (BreakPos<=length(NewAtom)) do begin
if NewAtom[BreakPos] in [#10,#13] then begin
inc(BreakPos);
if (BreakPos<=length(NewAtom)) and (NewAtom[BreakPos] in [#10,#13])
and (NewAtom[BreakPos]<>NewAtom[BreakPos-1]) then
inc(BreakPos);
IndentLen:=GetLineIndent(CurCode,LastSrcLineStart)+HiddenIndent;
NewAtom:=copy(NewAtom,1,BreakPos-1)
+GetIndentStr(IndentLen)
+copy(NewAtom,BreakPos,length(NewAtom)-BreakPos);
inc(BreakPos,IndentLen);
HiddenIndent:=0;
end else
inc(BreakPos);
end;
end;
// split long string constants
if NewAtom[1] in ['''','#'] then
NewAtom:=SplitStringConstant(NewAtom,LineLength-CurLineLen,LineLength,
@ -858,10 +882,12 @@ begin
// find last line end in atom
LastLineEndInAtom:=length(NewAtom);
while (LastLineEndInAtom>=1)
and (not (NewAtom[LastLineEndInAtom] in [#10,#13]))
do
dec(LastLineEndInAtom);
while (LastLineEndInAtom>=1) do begin
if (not (NewAtom[LastLineEndInAtom] in [#10,#13])) then
dec(LastLineEndInAtom)
else
break;
end;
// start new line if necessary
if (LastLineEndInAtom<1) and (CurLineLen+length(NewAtom)>LineLength)
@ -870,9 +896,11 @@ begin
// -> split line
//writeln('[TBeautifyCodeOptions.AddAtom] NEW LINE CurLineLen=',CurLineLen,' NewAtom=',NewAtom,' "',copy(s,LastSplitPos,5));
RestLineLen:=length(CurCode)-LastSplitPos+1;
IndentLen:=Indent+GetLineIndent(CurCode,LastSrcLineStart)+HiddenIndent;
CurCode:=copy(CurCode,1,LastSplitPos-1)+LineEnd
+GetIndentStr(Indent+GetLineIndent(CurCode,LastSrcLineStart))
+GetIndentStr(IndentLen)
+copy(CurCode,LastSplitPos,RestLineLen)+NewAtom;
HiddenIndent:=0;
CurLineLen:=length(CurCode)-LastSplitPos-length(LineEnd)+1;
LastSplitPos:=-1;
end else begin
@ -883,6 +911,7 @@ begin
// there is a line end in the code
CurLineLen:=length(NewAtom)-LastLineEndInAtom;
LastSrcLineStart:=length(CurCode)+1-CurLineLen;
HiddenIndent:=0;
end;
end;
end;
@ -1041,51 +1070,55 @@ begin
//writeln('[TBeautifyCodeOptions.BeautifyStatement] "',AStatement,'"');
// set flags
CurFlags:=BeautifyFlags;
if bcfNoIndentOnBreakLine in CurFlags then begin
OldIndent:=Indent;
Indent:=0;
end;
// init
Src:=AStatement;
UpperSrc:=UpperCaseStr(Src);
SrcLen:=length(Src);
if IndentSize>=LineLength-10 then IndentSize:=LineLength-10;
CurIndent:=IndentSize;
Result:=GetIndentStr(CurIndent);
CurPos:=1;
LastSplitPos:=-1;
LastSrcLineStart:=1;
CurLineLen:=length(Result);
LastAtomType:=atNone;
// read atoms
while (CurPos<=SrcLen) do begin
repeat
ReadNextAtom;
CurAtom:=copy(Src,AtomStart,AtomEnd-AtomStart);
if CurAtom=' ' then
AddAtom(Result,' ')
else
break;
until false;
if ((Result='') or (Result[length(Result)]<>' '))
and ((CurAtomType in DoInsertSpaceInFront)
or (LastAtomType in DoInsertSpaceAfter)) then
AddAtom(Result,' ');
if (not (CurAtomType in DoNotSplitLineInFront))
and (not (LastAtomType in DoNotSplitLineAfter)) then
LastSplitPos:=length(Result)+1;
{writeln('SPLIT LINE CurPos=',CurPos,' CurAtom="',CurAtom,
'" CurAtomType=',AtomTypeNames[CurAtomType],' LastAtomType=',AtomTypeNames[LastAtomType],
' ',LastAtomType in DoInsertSpaceAfter,' LastSplitPos=',LastSplitPos,
' ..."',copy(Result,length(Result)-10,10),'"');}
AddAtom(Result,CurAtom);
LastAtomType:=CurAtomType;
end;
// restore flags
if bcfNoIndentOnBreakLine in CurFlags then begin
OldIndent:=Indent;
try
if bcfNoIndentOnBreakLine in CurFlags then
Indent:=0;
// init
Src:=AStatement;
UpperSrc:=UpperCaseStr(Src);
SrcLen:=length(Src);
if IndentSize>=LineLength-10 then IndentSize:=LineLength-10;
CurIndent:=IndentSize;
HiddenIndent:=0;
if bcfDoNotIndentFirstLine in CurFlags then begin
Result:='';
HiddenIndent:=CurIndent;
end else
Result:=GetIndentStr(CurIndent);
CurPos:=1;
LastSplitPos:=-1;
LastSrcLineStart:=1;
CurLineLen:=length(Result);
LastAtomType:=atNone;
// read atoms
while (CurPos<=SrcLen) do begin
repeat
ReadNextAtom;
CurAtom:=copy(Src,AtomStart,AtomEnd-AtomStart);
if CurAtom=' ' then
AddAtom(Result,' ')
else
break;
until false;
if ((Result='') or (Result[length(Result)]<>' '))
and ((CurAtomType in DoInsertSpaceInFront)
or (LastAtomType in DoInsertSpaceAfter)) then
AddAtom(Result,' ');
if (not (CurAtomType in DoNotSplitLineInFront))
and (not (LastAtomType in DoNotSplitLineAfter)) then
LastSplitPos:=length(Result)+1;
{writeln('SPLIT LINE CurPos=',CurPos,' CurAtom="',CurAtom,
'" CurAtomType=',AtomTypeNames[CurAtomType],' LastAtomType=',AtomTypeNames[LastAtomType],
' ',LastAtomType in DoInsertSpaceAfter,' LastSplitPos=',LastSplitPos,
' ..."',copy(Result,length(Result)-10,10),'"');}
AddAtom(Result,CurAtom);
LastAtomType:=CurAtomType;
end;
finally
Indent:=OldIndent;
CurFlags:=[];
end;
CurFlags:=[];
//writeln('[TBeautifyCodeOptions.BeautifyStatement] Result="',Result,'"');
//writeln('**********************************************************');
end;

185
ide/encloseselectiondlg.pas
View File

@ -36,7 +36,8 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
ExtCtrls, LazarusIDEStrConsts, LazConf, IDEProcs;
ExtCtrls, BasicCodeTools, CodeToolManager, SourceChanger,
LazarusIDEStrConsts, LazConf, IDEProcs;
type
TEncloseSelectionType = (
@ -68,6 +69,10 @@ function ShowEncloseSelectionDialog(var TheType: TEncloseSelectionType
): TModalResult;
procedure GetEncloseSelectionParams(TheType: TEncloseSelectionType;
var Template: string);
procedure EncloseTextSelection(const Template: string; Source: TStrings;
SelectionStart, SelectionEnd: TPoint;
Indent: integer;
var NewSelection: string; var NewCursor: TPoint);
implementation
@ -108,45 +113,209 @@ begin
+' <selection>'+LineBreak
+'finally'+LineBreak
+' |'+LineBreak
+'end;'+LineBreak;
+'end;';
estTryExcept:
Template:='try'+LineBreak
+' <selection>'+LineBreak
+'except'+LineBreak
+' |'+LineBreak
+'end;'+LineBreak;
+'end;';
estBeginEnd:
Template:='begin'+LineBreak
+' |<selection>'+LineBreak
+'end;'+LineBreak;
+'end;';
estForBeginEnd:
Template:='for | do begin'+LineBreak
+' <selection>'+LineBreak
+'end;'+LineBreak;
+'end;';
estWhileDoBeginEnd:
Template:='while | do begin'+LineBreak
+' <selection>'+LineBreak
+'end;'+LineBreak;
+'end;';
estRepeatUntil:
Template:='repeat'+LineBreak
+' <selection>'+LineBreak
+'until |;'+LineBreak;
+'until |;';
estPascalComment:
Template:='{'+LineBreak
+' |<selection>'+LineBreak
+'}'+LineBreak;
+'}';
else
RaiseException('GetEnclosedSelectionParams');
end;
end;
procedure EncloseTextSelection(const Template: string; Source: TStrings;
SelectionStart, SelectionEnd: TPoint;
Indent: integer;
var NewSelection: string; var NewCursor: TPoint);
const
TemplateIndent = 2;
var
TemplateLen: Integer;
TemplatePos: Integer;
LastWrittenTemplatePos: Integer;
NewSelect: TMemoryStream;
Y: Integer;
X: Integer;
ExtraIndent: Integer;
procedure AddBeautified(const s: string);
var
NewStr: String;
LengthOfLastLine: integer;
LineEndCnt: Integer;
begin
if s='' then exit;
NewStr:=s;
writeln('AddBeautified A X=',X,' Y=',Y,' ExtraIndent=',ExtraIndent,' NewSTr="',NewSTr,'"');
NewStr:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
NewStr,ExtraIndent,
[bcfIndentExistingLineBreaks,bcfDoNotIndentFirstLine]);
LineEndCnt:=LineEndCount(NewStr,LengthOfLastLine);
inc(Y,LineEndCnt);
if LineEndCnt=0 then
inc(X,LengthOfLastLine)
else begin
X:=LengthOfLastLine+1;
ExtraIndent:=GetLineIndent(NewStr,length(NewStr)+1);
end;
writeln('AddBeautified B X=',X,' Y=',Y,' ExtraIndent=',ExtraIndent,' NewSTr="',NewSTr,'"');
NewSelect.Write(NewStr[1],length(NewStr));
end;
procedure FlushTemplate;
var
FromPos: Integer;
ToPos: Integer;
begin
FromPos:=LastWrittenTemplatePos+1;
ToPos:=TemplatePos-1;
if ToPos>TemplateLen then ToPos:=TemplateLen;
if FromPos<=ToPos then
AddBeautified(copy(Template,FromPos,ToPos-FromPos+1));
LastWrittenTemplatePos:=ToPos;
end;
procedure CalculateCursorPos;
begin
NewCursor:=Point(X,Y);
end;
procedure InsertSelection;
var
CurY: Integer;
CurLine: string;
IndentStr: String;
MinX: Integer;
MaxX: Integer;
begin
IndentStr:=GetIndentStr(ExtraIndent);
for CurY:=SelectionStart.Y to SelectionEnd.Y do begin
CurLine:=Source[CurY-1];
MinX:=1;
MaxX:=length(CurLine);
if (CurY=SelectionStart.Y) then begin
MinX:=SelectionStart.X;
if MinX>MaxX then
MinX:=MaxX;
end;
if (CurY=SelectionEnd.Y) and (MaxX>SelectionEnd.X) then
MaxX:=SelectionEnd.X;
// write indent
if (IndentStr<>'') and (CurY<>SelectionStart.Y) then
NewSelect.Write(IndentStr[1],length(IndentStr));
// write line
if MaxX>MinX then
NewSelect.Write(CurLine[MinX],MaxX-MinX+1);
end;
end;
procedure ParseMacro;
var
MacroNameStart: Integer;
MacroNameEnd: Integer;
function MacroNameIs(const Name: string): boolean;
begin
Result:=CompareText(@Template[MacroNameStart],MacroNameEnd-MacroNameStart,
@Name[1],length(Name),false)=0;
end;
begin
FlushTemplate;
inc(TemplatePos);
MacroNameStart:=TemplatePos;
while (TemplatePos<=TemplateLen)
and (Template[TemplatePos] in ['a'..'z','A'..'Z','_','0'..'9']) do
inc(TemplatePos);
MacroNameEnd:=TemplatePos;
if (TemplatePos<=TemplateLen) and (Template[TemplatePos]='>') then begin
LastWrittenTemplatePos:=TemplatePos;
inc(TemplatePos);
if MacroNameIs('Selection') then begin
InsertSelection;
end;
end;
end;
begin
writeln('EncloseTextSelection A ',SelectionStart.X,',',SelectionStart.Y,'-',SelectionEnd.X,',',SelectionEnd.Y,
' indent=',Indent,' Template="',Template,'"');
NewSelect:=TMemoryStream.Create;
NewCursor:=SelectionStart;
X:=NewCursor.X;
Y:=NewCursor.Y;
ExtraIndent:=0;
if Y<Source.Count then
ExtraIndent:=GetLineIndent(Source[Y-1],X);
writeln('AAA1 ',X,',',Y,' ',ExtraIndent,' "',Source[Y-1],'"');
try
TemplateLen:=length(Template);
TemplatePos:=1;
LastWrittenTemplatePos:=TemplatePos-1;
while TemplatePos<=TemplateLen do begin
case Template[TemplatePos] of
'\':
begin
FlushTemplate;
LastWrittenTemplatePos:=TemplatePos;
inc(TemplatePos,2);
end;
'|':
begin
FlushTemplate;
CalculateCursorPos;
LastWrittenTemplatePos:=TemplatePos;
inc(TemplatePos);
end;
'<':
ParseMacro;
else
inc(TemplatePos);
end;
end;
FlushTemplate;
finally
SetLength(NewSelection,NewSelect.Size);
if NewSelection<>'' then begin
NewSelect.Position:=0;
NewSelect.Read(NewSelection[1],length(NewSelection));
end;
NewSelect.Free;
end;
end;
{ TEncloseSelectionDialog }
procedure TEncloseSelectionDialog.EncloseSelectionDialogCREATE(Sender: TObject);

6
ide/include/win32/lazconf.inc
View File

@ -21,6 +21,9 @@
* *
***************************************************************************
}
uses
DOS; // .. invincible DOS ..
const
DefaultFPCSrcDirs: array[1..1] of string = (
'C:\pp'
@ -166,6 +169,9 @@ end;
{
$Log$
Revision 1.11 2003/08/18 10:02:37 mattias
fixed win32 lazconf and improved enclose selection
Revision 1.10 2003/08/15 14:28:48 mattias
clean up win32 ifdefs

39
ide/inputhistory.pas
View File

@ -57,6 +57,9 @@ type
MaxHistory: integer;
end;
{ THistoryList - a TStringList to store a history list }
THistoryList = class(TStringList)
private
FMaxCount: integer;
@ -75,6 +78,9 @@ type
property MaxCount: integer read FMaxCount write SetMaxCount;
end;
{ THistoryLists - list of THistoryList }
THistoryLists = class
private
FItems: TList;
@ -101,6 +107,7 @@ type
public
Options: string;
SearchPath: string;
FPCSrcDir: string;
UnitLinks: string;
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
@ -122,11 +129,12 @@ type
destructor Destroy; override;
procedure Clear;
function FindItem(const Options: string): integer;
procedure SetItem(const Options, SearchPath, UnitLinks: string);
procedure SetItem(const Options, SearchPath, FPCSrcDir, UnitLinks: string);
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
function Valid(CheckCompiler: boolean): boolean;
function UnitLinksNeedUpdate(const Options, SearchPath: string): boolean;
function UnitLinksNeedUpdate(const Options, SearchPath,
FPCSrcDir: string): boolean;
function GetUnitLinks(const Options: string): string;
public
property CompilerPath: string read FCompilerPath write SetCompilerPath;
@ -183,10 +191,10 @@ type
function AddToUnitDependenciesHistory(const ARootFilename: String): boolean;
function LastFPCUnitLinksValid: boolean;
function LastFPCUnitLinksNeedsUpdate(const Options,
SearchPath: string): boolean;
function LastFPCUnitLinksNeedsUpdate(const Options, SearchPath,
FPCSrcDir: string): boolean;
procedure SetLastFPCUnitLinks(const FPCPath, FPCOptions,
SearchPath, UnitLinks: string);
SearchPath, FPCSrcDir, UnitLinks: string);
// filedialog
procedure ApplyFileDialogSettings(DestDialog: TFileDialog);
@ -458,16 +466,16 @@ begin
end;
function TInputHistories.LastFPCUnitLinksNeedsUpdate(
const Options, SearchPath: string): boolean;
const Options, SearchPath, FPCSrcDir: string): boolean;
begin
Result:=FFPCConfigCache.UnitLinksNeedUpdate(Options,SearchPath);
Result:=FFPCConfigCache.UnitLinksNeedUpdate(Options,SearchPath,FPCSrcDir);
end;
procedure TInputHistories.SetLastFPCUnitLinks(const FPCPath, FPCOptions,
SearchPath, UnitLinks: string);
SearchPath, FPCSrcDir, UnitLinks: string);
begin
FFPCConfigCache.CompilerPath:=FPCPath;
FFPCConfigCache.SetItem(FPCOptions,SearchPath,UnitLinks);
FFPCConfigCache.SetItem(FPCOptions,SearchPath,FPCSrcDir,UnitLinks);
end;
procedure TInputHistories.ApplyFileDialogSettings(DestDialog: TFileDialog);
@ -695,8 +703,8 @@ begin
while (Result>=0) and (Options<>Items[Result].Options) do dec(Result);
end;
procedure TFPCConfigCache.SetItem(const Options, SearchPath, UnitLinks: string
);
procedure TFPCConfigCache.SetItem(const Options, SearchPath, FPCSrcDir,
UnitLinks: string);
var
i: Integer;
CurItem: TFPCConfigCacheItem;
@ -709,6 +717,7 @@ begin
CurItem:=Items[i];
CurItem.Options:=Options;
CurItem.SearchPath:=SearchPath;
CurItem.FPCSrcDir:=FPCSrcDir;
CurItem.UnitLinks:=UnitLinks;
end;
@ -762,8 +771,8 @@ begin
end;
end;
function TFPCConfigCache.UnitLinksNeedUpdate(const Options, SearchPath: string
): boolean;
function TFPCConfigCache.UnitLinksNeedUpdate(const Options, SearchPath,
FPCSrcDir: string): boolean;
var
i: Integer;
begin
@ -774,6 +783,8 @@ begin
if i<0 then exit;
// check if search path changed
if Items[i].SearchPath<>SearchPath then exit;
// check if FPCSrcDir changed
if Items[i].FPCSrcDir<>FPCSrcDir then exit;
// check if compiler changed
if not Valid(true) then exit;
Result:=false;
@ -797,6 +808,7 @@ procedure TFPCConfigCacheItem.LoadFromXMLConfig(XMLConfig: TXMLConfig;
begin
Options:=XMLConfig.GetValue(Path+'Options/Value','');
SearchPath:=XMLConfig.GetValue(Path+'SearchPath/Value','');
FPCSrcDir:=XMLConfig.GetValue(Path+'FPCSrcDir/Value','');
UnitLinks:=XMLConfig.GetValue(Path+'UnitLinks/Value','');
end;
@ -805,6 +817,7 @@ procedure TFPCConfigCacheItem.SaveToXMLConfig(XMLConfig: TXMLConfig;
begin
XMLConfig.SetDeleteValue(Path+'Options/Value',Options,'');
XMLConfig.SetDeleteValue(Path+'SearchPath/Value',SearchPath,'');
XMLConfig.SetDeleteValue(Path+'FPCSrcDir/Value',FPCSrcDir,'');
XMLConfig.SetDeleteValue(Path+'UnitLinks/Value',UnitLinks,'');
end;

16
ide/main.pp
View File

@ -7578,7 +7578,7 @@ begin
EnvironmentOptions.CompilerFilename;
CompilerUnitLinks:=InputHistories.FPCConfigCache.GetUnitLinks('');
UnitLinksChanged:=InputHistories.LastFPCUnitLinksNeedsUpdate('',
CompilerUnitSearchPath);
CompilerUnitSearchPath,EnvironmentOptions.FPCSourceDirectory);
ADefTempl:=CreateFPCSrcTemplate(
CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'FPCSrcDir'],
CompilerUnitSearchPath,
@ -7590,8 +7590,11 @@ begin
if UnitLinksChanged
or (CompilerUnitLinks<>InputHistories.FPCConfigCache.GetUnitLinks(''))
then begin
InputHistories.SetLastFPCUnitLinks(EnvironmentOptions.CompilerFilename,'',
CompilerUnitSearchPath,CompilerUnitLinks);
InputHistories.SetLastFPCUnitLinks(EnvironmentOptions.CompilerFilename,
'', // default options ''
CompilerUnitSearchPath,
EnvironmentOptions.FPCSourceDirectory,
CompilerUnitLinks);
InputHistories.Save;
end;
AddTemplate(ADefTempl,false,
@ -7688,7 +7691,9 @@ begin
FPCSrcTemplate.InsertBehind(CompilerTemplate);
// save unitlinks
InputHistories.SetLastFPCUnitLinks(EnvironmentOptions.CompilerFilename,
CurOptions,CompilerUnitSearchPath,CompilerUnitLinks);
CurOptions,CompilerUnitSearchPath,
EnvironmentOptions.FPCSourceDirectory,
CompilerUnitLinks);
InputHistories.Save;
end else begin
MessageDlg(lisFPCSourceDirectoryError,
@ -9421,6 +9426,9 @@ end.
{ =============================================================================
$Log$
Revision 1.639 2003/08/18 10:02:36 mattias
fixed win32 lazconf and improved enclose selection
Revision 1.638 2003/08/16 09:45:44 mattias
started enclose selection

1
ide/mainbar.pas
View File

@ -676,7 +676,6 @@ begin
itmEditEncloseBlock := TMenuItem.Create(Self);
itmEditEncloseBlock.Name:='itmEditEncloseBlock';
itmEditEncloseBlock.Caption := lisMenuEncloseSelection;
itmEditEncloseBlock.Enabled:=false;
mnuEdit.Add(itmEditEncloseBlock);
mnuEdit.Add(CreateMenuSeparator);

23
ide/uniteditor.pp
View File

@ -1049,12 +1049,12 @@ Begin
IdentCompletionTimer.Enabled := True;
end;
ecSelectionUpperCase:
ecSelectionEnclose:
EncloseSelection;
ecSelectionEnclose:
ecSelectionUpperCase:
UpperCaseSelection;
ecSelectionLowerCase:
LowerCaseSelection;
@ -1743,9 +1743,24 @@ end;
procedure TSourceEditor.EncloseSelection;
var
EncloseType: TEncloseSelectionType;
EncloseTemplate: string;
NewSelection: string;
NewCaretXY: TPoint;
begin
if not FEditor.SelAvail then begin
FEditor.BlockBegin:=FEditor.CaretXY;
FEditor.BlockEnd:=FEditor.CaretXY;
end;
if ShowEncloseSelectionDialog(EncloseType)<>mrOk then exit;
GetEncloseSelectionParams(EncloseType,EncloseTemplate);
EncloseTextSelection(EncloseTemplate,FEditor.Lines,
FEditor.BlockBegin,FEditor.BlockEnd,
FEditor.BlockIndent,
NewSelection,NewCaretXY);
writeln('TSourceEditor.EncloseSelection A NewCaretXY=',NewCaretXY.X,',',NewCaretXY.Y,
' "',NewSelection,'"');
FEditor.SelText:=NewSelection;
FEditor.CaretXY:=NewCaretXY;
end;
Function TSourceEditor.GetModified : Boolean;