forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

processed with JCF

This commit is contained in:
Basile Burg 2015-03-10 14:52:42 +01:00
parent e8d3f7918d
commit db5e2cbf2d
29 changed files with 2193 additions and 1667 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lazproj/coedit.lpi
View File

@ -302,6 +302,7 @@
<Unit29>
<Filename Value="..\src\ce_writablecomponent.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ce_writableComponent"/>
</Unit29>
<Unit30>
<Filename Value="..\src\ce_todolist.pas"/>
@ -321,6 +322,7 @@
<ComponentName Value="CEOptionEditorWidget"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ce_optionseditor"/>
</Unit32>
<Unit33>
<Filename Value="..\src\ce_editoroptions.pas"/>

29
lazproj/coedit.lpr
View File

@ -2,14 +2,26 @@ program coedit;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_observer,
ce_libman, ce_tools, ce_dcd, ce_main, ce_writableComponent, ce_options,
ce_symstring, ce_staticmacro, ce_inspectors, LResources, ce_editoroptions,
ce_dockoptions, ce_shortcutseditor;
uses {$IFDEF UNIX} {$IFDEF UseCThreads}
cthreads, {$ENDIF} {$ENDIF}
Interfaces,
Forms,
lazcontrols,
runtimetypeinfocontrols,
ce_observer,
ce_libman,
ce_tools,
ce_dcd,
ce_main,
ce_writableComponent,
ce_options,
ce_symstring,
ce_staticmacro,
ce_inspectors,
LResources,
ce_editoroptions,
ce_dockoptions,
ce_shortcutseditor;
{$R *.res}
@ -19,4 +31,3 @@ begin
Application.CreateForm(TCEMainForm, CEMainForm);
Application.Run;
end.

34
src/ce_cdbcmd.pas
View File

@ -28,12 +28,12 @@ type
private
fCdbProc: TAsyncProcess;
fProject: TCEProject;
procedure cdbOutput(sender: TObject);
procedure cdbTerminate(sender: TObject);
procedure cdbOutput(Sender: TObject);
procedure cdbTerminate(Sender: TObject);
procedure cdbOutputToGui;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
//
procedure projNew(aProject: TCEProject);
procedure projClosing(aProject: TCEProject);
@ -43,13 +43,14 @@ type
end;
implementation
{$R *.lfm}
uses
ce_symstring;
{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TCECdbWidget.create(aOwner: TComponent);
constructor TCECdbWidget.Create(aOwner: TComponent);
begin
inherited;
Enabled := exeInSysPath('cdb');
@ -57,14 +58,16 @@ begin
EntitiesConnector.addObserver(self);
end;
destructor TCECdbWidget.destroy;
destructor TCECdbWidget.Destroy;
begin
if Enabled then begin
if Enabled then
begin
killProcess(fCdbProc);
EntitiesConnector.removeObserver(self);
end;
inherited;
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION ICEProjectMonitor -----------------------------------------------------}
@ -92,6 +95,7 @@ end;
procedure TCECdbWidget.projCompiling(aProject: TCEProject);
begin
end;
{$ENDREGION --------------------------------------------------------------------}
procedure TCECdbWidget.btnStartClick(Sender: TObject);
@ -106,7 +110,7 @@ begin
exit;
//
killProcess(fCdbProc);
fCdbProc := TAsyncProcess.create(nil);
fCdbProc := TAsyncProcess.Create(nil);
fCdbProc.Executable := 'cdb';
fCdbProc.Parameters.Add('-c');
fCdbProc.Parameters.Add('"l+*;.lines"');
@ -150,8 +154,7 @@ procedure TCECdbWidget.btnStopClick(Sender: TObject);
const
cmd = 'q'#13#10;
begin
if fCdbProc <> nil
then
if fCdbProc <> nil then
fCdbProc.Input.Write(cmd[1], length(cmd));
killProcess(fCdbProc);
end;
@ -168,9 +171,9 @@ begin
inp := cmd + LineEnding;
fCdbProc.Input.Write(inp[1], length(inp));
//
inp := lstCdbOut.Items.Item[lstCdbOut.Items.Count-1].Caption;
inp := lstCdbOut.Items.Item[lstCdbOut.Items.Count - 1].Caption;
inp += cmd;
lstCdbOut.Items.Item[lstCdbOut.Items.Count-1].Caption := inp;
lstCdbOut.Items.Item[lstCdbOut.Items.Count - 1].Caption := inp;
//
txtCdbCmd.Text := '';
end;
@ -188,22 +191,21 @@ begin
processOutputToStrings(fCdbProc, lst);
for str in lst do
lstCdbOut.AddItem(str, nil);
lstCdbOut.Items[lstCdbOut.Items.Count-1].MakeVisible(true);
lstCdbOut.Items[lstCdbOut.Items.Count - 1].MakeVisible(True);
finally
lst.Free;
end;
end;
procedure TCECdbWidget.cdbOutput(sender: TObject);
procedure TCECdbWidget.cdbOutput(Sender: TObject);
begin
cdbOutputToGui;
end;
procedure TCECdbWidget.cdbTerminate(sender: TObject);
procedure TCECdbWidget.cdbTerminate(Sender: TObject);
begin
cdbOutputToGui;
killProcess(fCdbProc);
end;
end.

459
src/ce_dlang.pas
View File

@ -10,7 +10,7 @@ uses
const
D2Kw: array[0..109] of string =
( 'abstract', 'alias', 'align', 'asm', 'assert', 'auto',
('abstract', 'alias', 'align', 'asm', 'assert', 'auto',
'body', 'bool', 'break', 'byte',
'case', 'cast', 'catch', 'cdouble', 'cent', 'cfloat', 'char', 'class',
'const', 'continue', 'creal',
@ -56,8 +56,8 @@ type
function toHash(const aValue: string): Byte; {$IFNDEF DEBUG}inline;{$ENDIF}
procedure addEntry(const aValue: string);
public
constructor create;
destructor destroy; // do not remove even if empty (compat with char-map version)
constructor Create;
destructor Destroy; // do not remove even if empty (compat with char-map version)
function find(const aValue: string): boolean;
end;
@ -73,10 +73,10 @@ type
fReaderHead: PChar;
function getColAndLine: TPoint;
public
constructor create(const aText: PChar; const aColAndLine: TPoint);
constructor Create(const aText: PChar; const aColAndLine: TPoint);
procedure setReader(const aText: PChar; const aColAndLine: TPoint);
//
function next: PChar;
function Next: PChar;
function previous: PChar;
//
property AbsoluteIndex: Integer read fAbsoluteIndex;
@ -91,8 +91,8 @@ type
ltkNumber, ltkOperator, ltkString, ltkSymbol);
const
LexTokenKindString : array[TLexTokenKind] of string =
( 'Illegal', 'Character', 'Comment', 'Identifier', 'Keyword',
LexTokenKindString: array[TLexTokenKind] of string =
('Illegal', 'Character', 'Comment', 'Identifier', 'Keyword',
'Number', 'Operator', 'String', 'Symbol');
type
@ -101,10 +101,11 @@ type
* Lexer token
*)
PLexToken = ^TLexToken;
TLexToken = record
position: TPoint;
kind: TLexTokenKind;
data: string;
Data: string;
end;
TLexFoundEvent = procedure(const aToken: PLexToken; out doStop: boolean) of Object;
@ -116,7 +117,7 @@ type
private
function getToken(index: integer): TLexToken;
public
procedure clear;
procedure Clear;
procedure addToken(aValue: PLexToken);
property token[index: integer]: TLexToken read getToken;
end;
@ -133,6 +134,7 @@ type
* Error record
*)
PLexError = ^TLexError;
TLexError = record
position: TPoint;
msg: string;
@ -145,7 +147,7 @@ type
private
function getError(index: integer): TLexError;
public
procedure clear;
procedure Clear;
procedure addError(aValue: PLexError);
property error[index: integer]: TLexError read getError;
end;
@ -158,28 +160,28 @@ type
property Current: TLexError read GetCurrent;
end;
operator enumerator(aTokenList: TLexTokenList): TLexTokenEnumerator;
operator enumerator(anErrorList: TLexErrorList): TLexErrorEnumerator;
operator enumerator(aTokenList: TLexTokenList): TLexTokenEnumerator;
operator enumerator(anErrorList: TLexErrorList): TLexErrorEnumerator;
(*****************************************************************************
* Lexes aText and fills aList with the TLexToken found.
*)
procedure lex(const aText: string; aList: TLexTokenList; aCallBack: TLexFoundEvent = nil);
procedure lex(const aText: string; aList: TLexTokenList; aCallBack: TLexFoundEvent = nil);
(*****************************************************************************
* Detects various syntactic errors in a TLexTokenList
*)
procedure checkSyntacticErrors(const aTokenList: TLexTokenList; const anErrorList: TLexErrorList);
procedure checkSyntacticErrors(const aTokenList: TLexTokenList; const anErrorList: TLexErrorList);
(*****************************************************************************
* Outputs the module name from a tokenized D source.
*)
function getModuleName(const aTokenList: TLexTokenList):string;
function getModuleName(const aTokenList: TLexTokenList): string;
(*****************************************************************************
* Compares two TPoints.
*)
operator = (lhs: TPoint; rhs: TPoint): boolean;
operator = (lhs: TPoint; rhs: TPoint): boolean;
implementation
@ -189,12 +191,12 @@ var
{$REGION TReaderHead------------------------------------------------------------}
operator = (lhs: TPoint; rhs: TPoint): boolean;
begin
exit( (lhs.y = rhs.y) and (lhs.x = rhs.x) );
exit((lhs.y = rhs.y) and (lhs.x = rhs.x));
end;
constructor TReaderHead.create(const aText: PChar; const aColAndLine: TPoint);
constructor TReaderHead.Create(const aText: PChar; const aColAndLine: TPoint);
begin
setReader(aText,aColAndLine);
setReader(aText, aColAndLine);
end;
procedure TReaderHead.setReader(const aText: PChar; const aColAndLine: TPoint);
@ -202,18 +204,20 @@ begin
fLineIndex := aColAndLine.y;
fColumnIndex := aColAndLine.x;
fReaderHead := aText;
while (LineAnColumn <> aColAndLine) do next;
while (LineAnColumn <> aColAndLine) do
Next;
//
// editor not 0 based ln index
if fLineIndex = 0 then fLineIndex := 1;
if fLineIndex = 0 then
fLineIndex := 1;
end;
function TReaderHead.getColAndLine: TPoint;
begin
exit( Point(fColumnIndex, fLineIndex) );
exit(Point(fColumnIndex, fLineIndex));
end;
function TReaderHead.next: PChar;
function TReaderHead.Next: PChar;
begin
Inc(fReaderHead);
Inc(fAbsoluteIndex);
@ -234,18 +238,19 @@ begin
Dec(fAbsoluteIndex);
exit(fReaderHead);
end;
{$ENDREGION}
{$REGION TD2Dictionary----------------------------------------------------------}
constructor TD2Dictionary.create;
constructor TD2Dictionary.Create;
var
value: string;
Value: string;
begin
for value in D2Kw do
addEntry(value);
for Value in D2Kw do
addEntry(Value);
end;
destructor TD2Dictionary.destroy;
destructor TD2Dictionary.Destroy;
begin
end;
@ -254,19 +259,22 @@ function TD2Dictionary.toHash(const aValue: string): Byte;
var
i: Integer;
begin
result := 0;
for i := 1 to length(aValue) do result +=
(Byte(aValue[i]) shl (4 and (1-i))) xor 25;
Result := 0;
for i := 1 to length(aValue) do
Result +=
(Byte(aValue[i]) shl (4 and (1 - i))) xor 25;
end;
{$IFDEF DEBUG}{$R+}{$ENDIF}
procedure TD2Dictionary.addEntry(const aValue: string);
var
hash: Byte;
begin
if find(aValue) then exit;
if find(aValue) then
exit;
hash := toHash(aValue);
fEntries[hash].filled := true;
fEntries[hash].filled := True;
setLength(fEntries[hash].values, length(fEntries[hash].values) + 1);
fEntries[hash].values[high(fEntries[hash].values)] := aValue;
if fLongest <= length(aValue) then
@ -280,27 +288,33 @@ var
hash: Byte;
i: NativeInt;
begin
result := false;
if length(aValue) > fLongest then exit;
if length(aValue) < fShortest then exit;
Result := False;
if length(aValue) > fLongest then
exit;
if length(aValue) < fShortest then
exit;
hash := toHash(aValue);
if (not fEntries[hash].filled) then exit(false);
for i:= 0 to high(fEntries[hash].values) do
if fEntries[hash].values[i] = aValue then exit(true);
if (not fEntries[hash].filled) then
exit(False);
for i := 0 to high(fEntries[hash].values) do
if fEntries[hash].values[i] = aValue then
exit(True);
end;
{$ENDREGION}
{$REGION Lexing-----------------------------------------------------------------}
function TLexTokenList.getToken(index: integer): TLexToken;
begin
result := PLexToken(Items[index])^;
Result := PLexToken(Items[index])^;
end;
procedure TLexTokenList.clear;
procedure TLexTokenList.Clear;
begin
while Count > 0 do begin
Dispose( PLexToken(Items[Count-1]) );
Delete(Count-1);
while Count > 0 do
begin
Dispose(PLexToken(Items[Count - 1]));
Delete(Count - 1);
end;
end;
@ -322,9 +336,9 @@ end;
operator enumerator(aTokenList: TLexTokenList): TLexTokenEnumerator;
begin
result := TLexTokenEnumerator.Create;
result.fList := aTokenList;
result.fIndex := -1;
Result := TLexTokenEnumerator.Create;
Result.fList := aTokenList;
Result.fIndex := -1;
end;
{$BOOLEVAL ON}
@ -345,21 +359,21 @@ var
ptk := new(PLexToken);
ptk^.kind := aTk;
ptk^.position := reader.LineAnColumn;
ptk^.data := identifier;
ptk^.Data := identifier;
aList.Add(ptk);
end;
function callBackDoStop: boolean;
begin
result := false;
Result := False;
if aCallBack <> nil then
aCallBack(PLexToken(aList.Items[aList.Count-1]), result);
aCallBack(PLexToken(aList.Items[aList.Count - 1]), Result);
end;
begin
reader.create(@aText[1], Point(0,0));
while (true) do
reader.Create(@aText[1], Point(0, 0));
while (True) do
begin
if isOutOfBound then
@ -370,25 +384,29 @@ begin
// skip blanks
while isWhite(reader.head^) do
begin
reader.next;
if isOutOfBound then exit;
reader.Next;
if isOutOfBound then
exit;
end;
// line comment
if (reader.head^ = '/') then
begin
if (reader.next^ = '/') then
if (reader.Next^ = '/') then
begin
if isOutOfBound then exit;
if isOutOfBound then
exit;
while (reader.head^ <> #10) do
begin
reader.next;
reader.Next;
identifier += reader.head^;
if isOutOfBound then exit;
if isOutOfBound then
exit;
end;
reader.next;
reader.Next;
addToken(ltkComment);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end
else
@ -398,14 +416,17 @@ begin
// block comments 1
if (reader.head^ = '/') then
begin
if (reader.next^ = '*') then
if (reader.Next^ = '*') then
begin
if isOutOfBound then exit;
while (reader.head^ <> '*') or (reader.next^ <> '/') do
if isOutOfBound then exit;
reader.next;
if isOutOfBound then
exit;
while (reader.head^ <> '*') or (reader.Next^ <> '/') do
if isOutOfBound then
exit;
reader.Next;
addToken(ltkComment);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end
else
@ -415,14 +436,17 @@ begin
// block comments 2
if (reader.head^ = '/') then
begin
if (reader.next^ = '+') then
if (reader.Next^ = '+') then
begin
if isOutOfBound then exit;
while (reader.head^ <> '+') or (reader.next^ <> '/') do
if isOutOfBound then exit;
reader.next;
if isOutOfBound then
exit;
while (reader.head^ <> '+') or (reader.Next^ <> '/') do
if isOutOfBound then
exit;
reader.Next;
addToken(ltkComment);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end
else
@ -432,112 +456,129 @@ begin
// string 1, note: same escape error as in SynD2Syn
if (reader.head^ in ['r', 'x']) then
begin
if not (reader.next^ = '"') then
if not (reader.Next^ = '"') then
reader.previous;
end;
if (reader.head^ = '"') then
begin
reader.next;
if isOutOfBound then exit;
reader.Next;
if isOutOfBound then
exit;
if (reader.head^ = '"') then
begin
reader.next;
reader.Next;
addToken(ltkString);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end;
while (true) do
while (True) do
begin
if reader.head^ = '\' then
begin
reader.next;
reader.Next;
if (reader.head^ = '"') then
begin
reader.next;
reader.Next;
continue;
end;
end;
if (reader.head^ = '"') then
break;
identifier += reader.head^;
reader.next;
if isOutOfBound then exit;
reader.Next;
if isOutOfBound then
exit;
end;
if isStringPostfix(reader.next^) then
reader.next;
if isStringPostfix(reader.Next^) then
reader.Next;
addToken(ltkString);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end;
// string 2
if (reader.head^ = '`') then
begin
reader.next;
if isOutOfBound then exit;
reader.Next;
if isOutOfBound then
exit;
while (reader.head^ <> '`') do
begin
identifier += reader.head^;
reader.next;
if isOutOfBound then exit;
reader.Next;
if isOutOfBound then
exit;
end;
if isStringPostfix(reader.next^) then
reader.next;
if isOutOfBound then exit;
if isStringPostfix(reader.Next^) then
reader.Next;
if isOutOfBound then
exit;
addToken(ltkString);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end;
// token string
if (reader.head^ = 'q') and (reader.next^ = '{') then
if (reader.head^ = 'q') and (reader.Next^ = '{') then
begin
reader.next;
if isOutOfBound then exit;
reader.Next;
if isOutOfBound then
exit;
while (reader.head^ <> '}') do
begin
identifier += reader.head^;
reader.next;
if isOutOfBound then exit;
reader.Next;
if isOutOfBound then
exit;
end;
reader.next;
reader.Next;
addToken(ltkString);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end else reader.previous;
end
else
reader.previous;
//chars, note: same escape error as in SynD2Syn
if (reader.head^ = #39) then
begin
reader.next;
if isOutOfBound then exit;
reader.Next;
if isOutOfBound then
exit;
if (reader.head^ = #39) then
begin
reader.next;
reader.Next;
addToken(ltkString);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end;
while (true) do
while (True) do
begin
if reader.head^ = '\' then
begin
reader.next;
reader.Next;
if (reader.head^ = #39) then
begin
reader.next;
reader.Next;
continue;
end;
end;
if (reader.head^ = #39) then
break;
identifier += reader.head^;
reader.next;
if isOutOfBound then exit;
reader.Next;
if isOutOfBound then
exit;
end;
reader.next;
reader.Next;
addToken(ltkChar);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end;
@ -545,9 +586,9 @@ begin
if (reader.head^ = '-') then
begin
identifier += reader.head^;
if reader.next^ = '0' then
if reader.Next^ = '0' then
begin
if reader.next^ = '.' then
if reader.Next^ = '.' then
reader.previous // back to 0, get into "binary/hex numbr/float"
else
begin
@ -571,45 +612,54 @@ begin
if (reader.head^ = '0') then
begin
identifier += reader.head^;
if (reader.next^ in ['b','B']) then
if (reader.Next^ in ['b', 'B']) then
begin
identifier += reader.head^;
while isBit(reader.next^) or (reader.head^ = '_') do
while isBit(reader.Next^) or (reader.head^ = '_') do
begin
if isOutOfBound then exit;
if isOutOfBound then
exit;
identifier += reader.head^;
end;
addToken(ltkNumber);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end
else reader.previous;
if (reader.next^ in ['x','X']) then
else
reader.previous;
if (reader.Next^ in ['x', 'X']) then
begin
identifier += reader.head^;
while isHex(reader.next^) or (reader.head^ = '_') do
while isHex(reader.Next^) or (reader.head^ = '_') do
begin
if isOutOfBound then exit;
if isOutOfBound then
exit;
identifier += reader.head^;
end;
addToken(ltkNumber);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end
else reader.previous;
if (reader.next^ = '.') then
else
reader.previous;
if (reader.Next^ = '.') then
begin
identifier += reader.head^;
while isNumber(reader.next^) do
while isNumber(reader.Next^) do
begin
if isOutOfBound then exit;
if isOutOfBound then
exit;
identifier += reader.head^;
end;
addToken(ltkNumber);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end
else reader.previous;
else
reader.previous;
identifier := '';
end;
@ -617,7 +667,7 @@ begin
if (reader.head^ = '-') then
begin
identifier += reader.head^;
if not isNumber(reader.next^) then
if not isNumber(reader.Next^) then
begin
reader.previous; // back to '-'
identifier := '';
@ -628,13 +678,15 @@ begin
if isNumber(reader.head^) then
begin
identifier += reader.head^;
while isNumber(reader.next^) or (reader.head^ = '_') do
while isNumber(reader.Next^) or (reader.head^ = '_') do
begin
if isOutOfBound then exit;
if isOutOfBound then
exit;
identifier += reader.head^;
end;
addToken(ltkNumber);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end;
@ -642,10 +694,12 @@ begin
if isSymbol(reader.head^) then
begin
identifier += reader.head^;
reader.next;
reader.Next;
addToken(ltkSymbol);
if callBackDoStop then exit;
if isOutOfBound then exit;
if callBackDoStop then
exit;
if isOutOfBound then
exit;
continue;
end;
@ -653,45 +707,53 @@ begin
if isOperator1(reader.head^) then
begin
identifier += reader.head^;
while isOperator1(reader.next^) do
while isOperator1(reader.Next^) do
begin
if isOutOfBound then exit;
if isOutOfBound then
exit;
identifier += reader.head^;
end;
case length(identifier) of
4:begin
4:
begin
if (not isOperator1(reader.head^)) and
isOperator4(identifier) then
begin
addToken(ltkOperator);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end;
end;
3:begin
3:
begin
if (not isOperator1(reader.head^)) and
isOperator3(identifier) then
begin
addToken(ltkOperator);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end;
end;
2:begin
2:
begin
if (not isOperator1(reader.head^)) and
isOperator2(identifier) then
begin
addToken(ltkOperator);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end;
end;
1:begin
if not isOperator1(reader.head^)
then
1:
begin
if not isOperator1(reader.head^) then
begin
addToken(ltkOperator);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end;
end;
@ -704,14 +766,16 @@ begin
while isIdentifier(reader.head^) do
begin
identifier += reader.head^;
reader.next;
if isOutOfBound then exit;
reader.Next;
if isOutOfBound then
exit;
end;
if D2Dictionary.find(identifier) then
addToken(ltkKeyword)
else
addToken(ltkIdentifier);
if callBackDoStop then exit;
if callBackDoStop then
exit;
continue;
end;
@ -721,20 +785,22 @@ begin
end;
end;
{$BOOLEVAL OFF}
{$ENDREGION}
{$REGION Syntactic errors}
function TLexErrorList.getError(index: integer): TLexError;
begin
result := PLexError(Items[index])^;
Result := PLexError(Items[index])^;
end;
procedure TLexErrorList.clear;
procedure TLexErrorList.Clear;
begin
while Count > 0 do begin
Dispose( PLexError(Items[Count-1]) );
Delete(Count-1);
while Count > 0 do
begin
Dispose(PLexError(Items[Count - 1]));
Delete(Count - 1);
end;
end;
@ -756,9 +822,9 @@ end;
operator enumerator(anErrorList: TLexErrorList): TLexErrorEnumerator;
begin
result := TLexErrorEnumerator.Create;
result.fList := anErrorList;
result.fIndex := -1;
Result := TLexErrorEnumerator.Create;
Result.fList := anErrorList;
Result.fIndex := -1;
end;
procedure checkSyntacticErrors(const aTokenList: TLexTokenList; const anErrorList: TLexErrorList);
@ -770,13 +836,15 @@ var
tkIndex: NativeInt;
pareCnt, curlCnt, squaCnt: NativeInt;
pareLeft, curlLeft, squaLeft: boolean;
procedure addError(const aMsg: string);
begin
procedure addError(const aMsg: string);
begin
err := new(PLexError);
err^.msg := errPrefix + aMsg;
err^.position := aTokenList.token[tkIndex].position;
anErrorList.addError(err);
end;
end;
label
_preSeq;
begin
@ -785,12 +853,12 @@ begin
pareCnt := 0;
curlCnt := 0;
squaCnt := 0;
pareLeft:= False;
curlLeft:= False;
squaLeft:= False;
FillByte( old1, sizeOf(TLexToken), 0);
FillByte( old2, sizeOf(TLexToken), 0);
FillByte( lastSignifiant, sizeOf(TLexToken), 0);
pareLeft := False;
curlLeft := False;
squaLeft := False;
FillByte(old1, sizeOf(TLexToken), 0);
FillByte(old2, sizeOf(TLexToken), 0);
FillByte(lastSignifiant, sizeOf(TLexToken), 0);
for tk in aTokenList do
begin
@ -799,7 +867,7 @@ begin
// brackets count
if tk.kind = ltkSymbol then
begin
case tk.data of
case tk.Data of
'(': Inc(pareCnt);
'{': Inc(curlCnt);
'[': Inc(squaCnt);
@ -809,24 +877,27 @@ begin
end;
// only for the first occurence
if not pareLeft then if pareCnt = -1 then
if not pareLeft then
if pareCnt = -1 then
begin
addError('a left parenthesis is missing');
pareLeft := true;
pareLeft := True;
end;
if not curlLeft then if curlCnt = -1 then
if not curlLeft then
if curlCnt = -1 then
begin
addError('a left curly bracket is missing');
curlLeft := true;
curlLeft := True;
end;
if not squaLeft then if squaCnt = -1 then
if not squaLeft then
if squaCnt = -1 then
begin
addError('a left square bracket is missing');
squaLeft := true;
squaLeft := True;
end;
// at the end
if (tkIndex = aTokenList.Count-1) then
if (tkIndex = aTokenList.Count - 1) then
begin
if pareCnt > 0 then
addError('a right parenthesis is missing');
@ -842,24 +913,25 @@ begin
// lexer invalid token
if tk.kind = ltkIllegal then
begin
addError(tk.data);
addError(tk.Data);
goto _preSeq;
end;
_preSeq:
_preSeq:
// invalid sequences
if tkIndex > 0 then
begin
// empty statements:
if (tk.kind = ltkSymbol) and (tk.data = ';') then
if (lastSignifiant.kind = ltkSymbol) and (lastSignifiant.data = ';') then
if (tk.kind = ltkSymbol) and (tk.Data = ';') then
if (lastSignifiant.kind = ltkSymbol) and (lastSignifiant.Data = ';') then
addError('invalid syntax for empty statement');
if tk.kind <> ltkComment then lastSignifiant := tk;
if tk.kind <> ltkComment then
lastSignifiant := tk;
// suspicious double keywords
if (old1.kind = ltkKeyword) and (tk.kind = ltkKeyword) then
if old1.data = tk.data then
if old1.Data = tk.Data then
addError('keyword is duplicated');
// suspicious double numbers
@ -882,31 +954,34 @@ var
ltk: TLexToken;
mtok: boolean;
begin
result := '';
mtok := false;
Result := '';
mtok := False;
for ltk in aTokenList do
begin
if mtok then begin
if mtok then
begin
case ltk.kind of
ltkIdentifier, ltkKeyword:
result += ltk.data;
Result += ltk.Data;
ltkSymbol:
case ltk.data of
'.': result += ltk.data;
case ltk.Data of
'.': Result += ltk.Data;
';': exit;
end;
end;
end
else
if ltk.kind = ltkKeyword then
if ltk.data = 'module' then
mtok := true;
if ltk.Data = 'module' then
mtok := True;
end;
end;
{$ENDREGION}
initialization
D2Dictionary.create;
D2Dictionary.Create;
finalization
D2Dictionary.destroy;
D2Dictionary.Destroy;
end.

28
src/ce_dockoptions.pas
View File

@ -36,7 +36,7 @@ var
constructor TDockOptionsEditor.Create(TheOwner: TComponent);
begin
inherited;
fBackup := TXMLConfigStorage.Create('', false);
fBackup := TXMLConfigStorage.Create('', False);
Master := AnchorDocking.DockMaster;
//
HeaderAlignLeftTrackBar.OnChange := @doChanged;
@ -44,7 +44,7 @@ begin
DragThresholdTrackBar.OnChange := @doChanged;
SplitterWidthTrackBar.OnChange := @doChanged;
//
HeaderStyleComboBox.OnChange:= @doChanged;
HeaderStyleComboBox.OnChange := @doChanged;
//
EntitiesConnector.addObserver(self);
end;
@ -94,14 +94,14 @@ end;
procedure TDockOptionsEditor.doChanged(Sender: TObject);
begin
DragThresholdLabel.Caption:=adrsDragThreshold +
' ('+IntToStr(DragThresholdTrackBar.Position)+')';
HeaderAlignTopLabel.Caption:=adrsHeaderAlignTop +
' ('+IntToStr(HeaderAlignTopTrackBar.Position) +')';
HeaderAlignLeftLabel.Caption:=adrsHeaderAlignLeft +
' ('+IntToStr(HeaderAlignLeftTrackBar.Position) +')';
SplitterWidthLabel.Caption:=adrsSplitterWidth +
' ('+IntToStr(SplitterWidthTrackBar.Position) +')';
DragThresholdLabel.Caption := adrsDragThreshold +
' (' + IntToStr(DragThresholdTrackBar.Position) + ')';
HeaderAlignTopLabel.Caption := adrsHeaderAlignTop +
' (' + IntToStr(HeaderAlignTopTrackBar.Position) + ')';
HeaderAlignLeftLabel.Caption := adrsHeaderAlignLeft +
' (' + IntToStr(HeaderAlignLeftTrackBar.Position) + ')';
SplitterWidthLabel.Caption := adrsSplitterWidth +
' (' + IntToStr(SplitterWidthTrackBar.Position) + ')';
FlattenHeaders.Enabled := adofShow_ShowHeader in Flags;
FilledHeaders.Enabled := adofShow_ShowHeader in Flags;
@ -112,8 +112,8 @@ begin
end;
initialization
DockOptionsEditor := TDockOptionsEditor.create(nil);
finalization
DockOptionsEditor.free;
end.
DockOptionsEditor := TDockOptionsEditor.Create(nil);
finalization
DockOptionsEditor.Free;
end.

36
src/ce_editoroptions.pas
View File

@ -74,7 +74,7 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
//
procedure assign(src: TPersistent); override;
procedure Assign(src: TPersistent); override;
end;
(**
@ -121,11 +121,11 @@ begin
fFont.Name := 'Courier New';
fFont.Quality := fqProof;
fFont.Pitch := fpFixed;
fFont.Size:= 10;
fFont.Size := 10;
//
fD2Syn := TSynD2Syn.create(self);
fD2Syn := TSynD2Syn.Create(self);
fD2Syn.Assign(D2Syn);
fTxtSyn := TSynTxtSyn.create(self);
fTxtSyn := TSynTxtSyn.Create(self);
fTxtSyn.Assign(TxtSyn);
//
fSelCol := TSynSelectedColor.Create;
@ -143,8 +143,8 @@ begin
fMouseLinkColor.Foreground := clNone;
fMouseLinkColor.Background := clNone;
//
fBracketMatchColor.Foreground:= clRed;
fBracketMatchColor.Background:= clNone;
fBracketMatchColor.Foreground := clRed;
fBracketMatchColor.Background := clNone;
//
rightEdge := 80;
tabulationWidth := 4;
@ -172,7 +172,7 @@ begin
inherited;
end;
procedure TCEEditorOptionsBase.assign(src: TPersistent);
procedure TCEEditorOptionsBase.Assign(src: TPersistent);
var
srcopt: TCEEditorOptionsBase;
begin
@ -191,14 +191,15 @@ begin
tabulationWidth := srcopt.tabulationWidth;
blockIdentation := srcopt.blockIdentation;
lineSpacing := srcopt.lineSpacing;
characterSpacing:= srcopt.characterSpacing;
characterSpacing := srcopt.characterSpacing;
options1 := srcopt.options1;
options2 := srcopt.options2;
mouseOptions := srcopt.mouseOptions;
rightEdge := srcopt.rightEdge;
rightEdgeColor := srcopt.rightEdgeColor;
end
else inherited;
else
inherited;
end;
procedure TCEEditorOptionsBase.setFont(aValue: TFont);
@ -245,7 +246,8 @@ begin
EntitiesConnector.addObserver(self);
//
fname := getCoeditDocPath + edoptFname;
if fileExists(fname) then loadFromFile(fname);
if fileExists(fname) then
loadFromFile(fname);
end;
destructor TCEEditorOptions.Destroy;
@ -262,6 +264,7 @@ begin
D2Syn.Assign(fD2Syn);
TxtSyn.Assign(fTxtSyn);
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ----------------------------------------------------}
@ -281,6 +284,7 @@ end;
procedure TCEEditorOptions.docClosing(aDoc: TCESynMemo);
begin
end;
{$ENDREGION}
{$REGION ICEEditableOptions ----------------------------------------------------}
@ -309,7 +313,7 @@ begin
// restores
if anEvent = oeeCancel then
begin
self.assign(fBackup);
self.Assign(fBackup);
D2Syn.Assign(fBackup.fD2Syn);
TxtSyn.Assign(fBackup.fTxtSyn);
end;
@ -319,11 +323,12 @@ begin
// new backup values based on accepted values.
if anEvent = oeeAccept then
begin
fBackup.assign(self);
fBackup.Assign(self);
fBackup.fD2Syn.Assign(D2Syn);
fBackup.fTxtSyn.Assign(TxtSyn);
end;
end;
{$ENDREGION}
{$REGION ICEEditableOptions ----------------------------------------------------}
@ -333,7 +338,7 @@ var
i: Integer;
begin
multied := getMultiDocHandler;
for i := 0 to multied.documentCount-1 do
for i := 0 to multied.documentCount - 1 do
applyChangeToEditor(multied.document[i]);
end;
@ -352,16 +357,17 @@ begin
anEditor.Options := options1;
anEditor.Options2 := options2;
anEditor.MouseOptions := mouseOptions;
anEditor.Color:= background;
anEditor.Color := background;
anEditor.RightEdge := rightEdge;
anEditor.RightEdgeColor := rightEdgeColor;
end;
{$ENDREGION}
initialization
EditorOptions := TCEEditorOptions.Create(nil);
finalization
EditorOptions.Free;
end.

11
src/ce_inspectors.pas
View File

@ -37,7 +37,7 @@ implementation
function TCECustomPathEditor.GetAttributes: TPropertyAttributes;
begin
exit( inherited GetAttributes() + [paDialog]);
exit(inherited GetAttributes() + [paDialog]);
end;
procedure TCECustomPathEditor.Edit;
@ -46,12 +46,14 @@ var
begin
case fType of
ptFile:
with TOpenDialog.create(nil) do try
with TOpenDialog.Create(nil) do
try
InitialDir := ExtractFileName(GetValue);
FileName := GetValue;
if Execute then SetValue(FileName);
if Execute then
SetValue(FileName);
finally
free;
Free;
end;
ptFolder:
if SelectDirectory(GetPropInfo^.Name, GetValue, newValue) then
@ -75,4 +77,3 @@ initialization
RegisterPropertyEditor(TypeInfo(TCEPathname), nil, '', TCEPathnameEditor);
RegisterPropertyEditor(TypeInfo(TCEFilename), nil, '', TCEfilenameEditor);
end.

54
src/ce_interfaces.pas
View File

@ -5,7 +5,7 @@ unit ce_interfaces;
interface
uses
Classes, SysUtils, actnList, menus, process,
Classes, SysUtils, ActnList, Menus, process,
ce_synmemo, ce_project, ce_observer;
type
@ -22,6 +22,7 @@ type
// persistent things have just been reloaded.
procedure sesoptAfterLoad;
end;
(**
* An implementer gets and gives back some things
*)
@ -61,6 +62,7 @@ type
// aDoc is about to be closed.
procedure docClosing(aDoc: TCESynMemo);
end;
(**
* An implementer informs some ICEMultiDocObserver about the current file(s)
*)
@ -87,6 +89,7 @@ type
// aProject is about to be compiled
procedure projCompiling(aProject: TCEProject);
end;
(**
* An implementer informs some ICEProjectObserver about the current project(s)
*)
@ -107,6 +110,7 @@ type
// item is the mainMenu entry declared previously. the sub items can be updated, deleted.
procedure menuUpdate(item: TMenuItem);
end;
(**
* An implementer collects and updates its observers menus.
*)
@ -132,6 +136,7 @@ type
// the handler update the state of a particular action.
procedure actHandleUpdater(action: TCustomAction);
end;
(**
* An implementer handles its observers actions.
*)
@ -154,6 +159,7 @@ type
// a TCEEditableShortCutSubject sends the possibly modified shortcut
procedure scedSendItem(const category, identifier: string; aShortcut: TShortcut);
end;
(**
* An implementer manages its observers shortcuts.
*)
@ -183,6 +189,7 @@ type
// the option editor informs that something has happened.
procedure optionedEvent(anEvent: TOptionEditorEvent);
end;
(**
* An implementer displays its observers editable options.
*)
@ -274,13 +281,13 @@ type
procedure subjSesOptsAfterLoad(aSubject: TCESessionOptionsSubject); {$IFDEF RELEASE}inline;{$ENDIF}
{
{
Service getters:
The first overload assign the variable only when not yet set, the second is
designed for a punctual usage, for example if a widget needs the service in
a single and rarely called method.
}
}
function getMessageDisplay(var obj: ICEMessagesDisplay): ICEMessagesDisplay; overload;
function getMessageDisplay: ICEMessagesDisplay; overload;
@ -303,7 +310,8 @@ procedure subjDocNew(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEMultiDocObserver).docNew(aDoc);
end;
@ -311,7 +319,8 @@ procedure subjDocClosing(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEMultiDocObserver).docClosing(aDoc);
end;
@ -319,7 +328,8 @@ procedure subjDocFocused(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEMultiDocObserver).docFocused(aDoc);
end;
@ -327,9 +337,11 @@ procedure subjDocChanged(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEMultiDocObserver).docChanged(aDoc);
end;
{$ENDREGION}
{$REGION TCEProjectSubject -----------------------------------------------------}
@ -342,7 +354,8 @@ procedure subjProjNew(aSubject: TCEProjectSubject; aProj: TCEProject);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEProjectObserver).ProjNew(aProj);
end;
@ -350,7 +363,8 @@ procedure subjProjClosing(aSubject: TCEProjectSubject; aProj: TCEProject);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEProjectObserver).projClosing(aProj);
end;
@ -358,7 +372,8 @@ procedure subjProjFocused(aSubject: TCEProjectSubject; aProj: TCEProject);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEProjectObserver).projFocused(aProj);
end;
@ -366,7 +381,8 @@ procedure subjProjChanged(aSubject: TCEProjectSubject; aProj: TCEProject);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEProjectObserver).projChanged(aProj);
end;
@ -374,9 +390,11 @@ procedure subjProjCompiling(aSubject: TCEProjectSubject; aProj: TCEProject);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEProjectObserver).projCompiling(aProj);
end;
{$ENDREGION}
{$REGION TCESessionOptionsSubject ----------------------------------------------}
@ -389,7 +407,8 @@ procedure subjSesOptsBeforeSave(aSubject: TCESessionOptionsSubject);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptBeforeSave;
end;
@ -397,7 +416,8 @@ procedure subjSesOptsDeclareProperties(aSubject: TCESessionOptionsSubject; aFile
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptDeclareProperties(aFiler);
end;
@ -405,9 +425,11 @@ procedure subjSesOptsAfterLoad(aSubject: TCESessionOptionsSubject);
var
i: Integer;
begin
with aSubject do for i:= 0 to fObservers.Count-1 do
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptAfterLoad;
end;
{$ENDREGION}
{$REGION Misc subjects ---------------------------------------------------------}
@ -430,6 +452,7 @@ function TCEActionProviderSubject.acceptObserver(aObject: TObject): boolean;
begin
exit(aObject is ICEActionProvider);
end;
{$ENDREGION}
{$REGION ICESingleService getters ----------------------------------------------}
@ -468,6 +491,7 @@ function getMultiDocHandler: ICEMultiDocHandler;
begin
exit(EntitiesConnector.getSingleService('ICEMultiDocHandler') as ICEMultiDocHandler);
end;
{$ENDREGION}
end.

56
src/ce_libmaneditor.pas
View File

@ -36,10 +36,11 @@ type
protected
procedure DoShow; override;
public
constructor create(aOwner: TComponent); override;
constructor Create(aOwner: TComponent); override;
end;
implementation
{$R *.lfm}
uses
@ -48,7 +49,7 @@ uses
const
notav: string = '< n/a >';
constructor TCELibManEditorWidget.create(aOwner: TComponent);
constructor TCELibManEditorWidget.Create(aOwner: TComponent);
var
png: TPortableNetworkGraphic;
begin
@ -72,12 +73,11 @@ begin
png.LoadFromLazarusResource('folder_add');
btnSelRoot.Glyph.Assign(png);
finally
png.free;
png.Free;
end;
end;
procedure TCELibManEditorWidget.ListEdited(Sender: TObject; Item: TListItem;
var AValue: string);
procedure TCELibManEditorWidget.ListEdited(Sender: TObject; Item: TListItem; var AValue: string);
begin
gridToData;
end;
@ -91,14 +91,15 @@ begin
itm.SubItems.Add(notav);
itm.SubItems.Add(notav);
SetFocus;
itm.Selected := true;
itm.Selected := True;
end;
procedure TCELibManEditorWidget.btnEditAliasClick(Sender: TObject);
var
al: string;
begin
if List.Selected = nil then exit;
if List.Selected = nil then
exit;
al := List.Selected.Caption;
if inputQuery('library alias', '', al) then
List.Selected.Caption := al;
@ -107,7 +108,8 @@ end;
procedure TCELibManEditorWidget.btnRemLibClick(Sender: TObject);
begin
if List.Selected = nil then exit;
if List.Selected = nil then
exit;
List.Items.Delete(List.Selected.Index);
gridToData;
end;
@ -116,7 +118,8 @@ procedure TCELibManEditorWidget.btnSelFileClick(Sender: TObject);
var
ini: string;
begin
if List.Selected = nil then exit;
if List.Selected = nil then
exit;
if List.Selected.SubItems.Count > 0 then
ini := List.Selected.SubItems[0]
else
@ -127,11 +130,12 @@ begin
with TOpenDialog.Create(nil) do
try
filename := ini;
if execute then
if Execute then
begin
if not fileExists(filename) then
List.Selected.SubItems[0] := extractFilePath(filename)
else begin
else
begin
List.Selected.SubItems[0] := filename;
if (List.Selected.Caption = '') or (List.Selected.Caption = notav) then
List.Selected.Caption := ChangeFileExt(extractFileName(filename), '');
@ -147,7 +151,8 @@ procedure TCELibManEditorWidget.btnSelfoldOfFilesClick(Sender: TObject);
var
dir, outdir: string;
begin
if List.Selected = nil then exit;
if List.Selected = nil then
exit;
if List.Selected.SubItems.Count > 0 then
dir := List.Selected.SubItems[0]
else
@ -155,7 +160,7 @@ begin
dir := '';
List.Selected.SubItems.Add(dir);
end;
if selectDirectory('folder of static libraries', dir, outdir, true, 0) then
if selectDirectory('folder of static libraries', dir, outdir, True, 0) then
List.Selected.SubItems[0] := outdir;
gridToData;
end;
@ -164,7 +169,8 @@ procedure TCELibManEditorWidget.btnSelRootClick(Sender: TObject);
var
dir, outdir: string;
begin
if List.Selected = nil then exit;
if List.Selected = nil then
exit;
if List.Selected.SubItems.Count > 1 then
dir := List.Selected.SubItems[1]
else
@ -173,15 +179,17 @@ begin
while List.Selected.SubItems.Count < 2 do
List.Selected.SubItems.Add(dir);
end;
if selectDirectory('sources root', dir, outdir, true, 0) then
if selectDirectory('sources root', dir, outdir, True, 0) then
List.Selected.SubItems[1] := outdir;
gridToData;
end;
procedure TCELibManEditorWidget.btnMoveUpClick(Sender: TObject);
begin
if list.Selected = nil then exit;
if list.Selected.Index = 0 then exit;
if list.Selected = nil then
exit;
if list.Selected.Index = 0 then
exit;
//
list.Items.Exchange(list.Selected.Index, list.Selected.Index - 1);
gridToData;
@ -189,8 +197,10 @@ end;
procedure TCELibManEditorWidget.btnMoveDownClick(Sender: TObject);
begin
if list.Selected = nil then exit;
if list.Selected.Index = list.Items.Count-1 then exit;
if list.Selected = nil then
exit;
if list.Selected.Index = list.Items.Count - 1 then
exit;
//
list.Items.Exchange(list.Selected.Index, list.Selected.Index + 1);
gridToData;
@ -209,8 +219,9 @@ var
i: NativeInt;
begin
List.Clear;
if LibMan = nil then exit;
for i:= 0 to LibMan.libraries.Count-1 do
if LibMan = nil then
exit;
for i := 0 to LibMan.libraries.Count - 1 do
begin
itm := TLibraryItem(LibMan.libraries.Items[i]);
row := List.Items.Add;
@ -225,7 +236,8 @@ var
itm: TLibraryItem;
row: TListItem;
begin
if LibMan = nil then exit;
if LibMan = nil then
exit;
LibMan.libraries.Clear;
for row in List.Items do
begin

559
src/ce_main.pas
View File

File diff suppressed because it is too large Load Diff

44
src/ce_observer.pas
View File

@ -33,8 +33,8 @@ type
procedure updateEntities;
function getIsUpdating: boolean;
public
constructor create;
destructor destroy; override;
constructor Create;
destructor Destroy; override;
// forces the update, fixes begin/add pair error or if immediate update is needed.
procedure forceUpdate;
// entities will be added in bulk, must be followed by an enUpdate().
@ -80,8 +80,8 @@ type
function getObserversCount: Integer;
function getObserver(index: Integer): TObject;
public
constructor create; virtual;
destructor destroy; override;
constructor Create; virtual;
destructor Destroy; override;
//
procedure addObserver(anObserver: TObject);
procedure removeObserver(anObserver: TObject);
@ -100,14 +100,14 @@ uses
LCLProc;
{$REGION TCEEntitiesConnector --------------------------------------------------}
constructor TCEEntitiesConnector.create;
constructor TCEEntitiesConnector.Create;
begin
fObservers := TObjectList.create(false);
fSubjects := TObjectList.create(false);
fServices := TObjectList.create(false);
fObservers := TObjectList.Create(False);
fSubjects := TObjectList.Create(False);
fServices := TObjectList.Create(False);
end;
destructor TCEEntitiesConnector.destroy;
destructor TCEEntitiesConnector.Destroy;
begin
fObservers.Free;
fSubjects.Free;
@ -139,14 +139,14 @@ end;
procedure TCEEntitiesConnector.updateEntities;
var
i,j: Integer;
i, j: Integer;
begin
fUpdatesCount := 0;
for i := 0 to fSubjects.Count-1 do
for i := 0 to fSubjects.Count - 1 do
begin
if not (fSubjects[i] is ICESubject) then
continue;
for j := 0 to fObservers.Count-1 do
for j := 0 to fObservers.Count - 1 do
begin
if fSubjects[i] <> fObservers[j] then
(fSubjects[i] as ICESubject).addObserver(fObservers[j]);
@ -188,7 +188,7 @@ var
i: Integer;
begin
fObservers.Remove(anObserver);
for i := 0 to fSubjects.Count-1 do
for i := 0 to fSubjects.Count - 1 do
if fSubjects[i] <> nil then
(fSubjects[i] as ICESubject).removeObserver(anObserver);
tryUpdate;
@ -215,24 +215,25 @@ var
i: Integer;
serv: ICESingleService;
begin
result := nil;
for i := 0 to fServices.Count-1 do
Result := nil;
for i := 0 to fServices.Count - 1 do
begin
serv := fServices[i] as ICESingleService;
if serv.singleServiceName = aName then
exit(fServices[i]);
end;
end;
{$ENDREGION}
{$REGION TCECustomSubject ------------------------------------------------------}
constructor TCECustomSubject.create;
constructor TCECustomSubject.Create;
begin
fObservers := TObjectList.create(false);
fObservers := TObjectList.Create(False);
EntitiesConnector.addSubject(Self);
end;
destructor TCECustomSubject.destroy;
destructor TCECustomSubject.Destroy;
begin
EntitiesConnector.removeSubject(Self);
fObservers.Free;
@ -241,7 +242,7 @@ end;
function TCECustomSubject.acceptObserver(aObject: TObject): boolean;
begin
exit(false);
exit(False);
end;
function TCECustomSubject.getObserversCount: Integer;
@ -271,13 +272,14 @@ end;
procedure TCECustomSubject.updateObservers;
begin
end;
{$ENDREGION}
initialization
EntitiesConnector := TCEEntitiesConnector.create;
EntitiesConnector := TCEEntitiesConnector.Create;
EntitiesConnector.beginUpdate;
finalization
EntitiesConnector.Free;
EntitiesConnector := nil;
end.

12
src/ce_options.pas
View File

@ -5,7 +5,7 @@ unit ce_options;
interface
uses
classes, sysutils, ce_common, ce_writableComponent, ce_observer;
Classes, SysUtils, ce_common, ce_writableComponent, ce_observer;
type
TCEOptions = class(TWritableLfmTextComponent)
@ -17,8 +17,8 @@ type
procedure beforeSave; override;
procedure afterLoad; override;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
@ -26,15 +26,15 @@ implementation
uses
ce_interfaces;
constructor TCEOptions.create(aOwner: TComponent);
constructor TCEOptions.Create(aOwner: TComponent);
begin
inherited;
fSubjPersObservers := TCESessionOptionsSubject.create;
fSubjPersObservers := TCESessionOptionsSubject.Create;
//
EntitiesConnector.addSubject(fSubjPersObservers);
end;
destructor TCEOptions.destroy;
destructor TCEOptions.Destroy;
begin
EntitiesConnector.removeSubject(fSubjPersObservers);
EntitiesConnector.endUpdate;

69
src/ce_optionseditor.pas
View File

@ -14,6 +14,7 @@ type
// store the information about the obsever
// exposing some editable options.
PCategoryData = ^TCategoryData;
TCategoryData = record
kind: TOptionEditorKind;
container: TPersistent;
@ -35,8 +36,7 @@ type
selCat: TTreeView;
procedure btnAcceptClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure inspectorEditorFilter(Sender: TObject; aEditor: TPropertyEditor;
var aShow: boolean);
procedure inspectorEditorFilter(Sender: TObject; aEditor: TPropertyEditor; var aShow: boolean);
procedure inspectorModified(Sender: TObject);
procedure selCatDeletion(Sender: TObject; Node: TTreeNode);
procedure selCatSelectionChanged(Sender: TObject);
@ -47,23 +47,24 @@ type
procedure updateCategories;
function sortCategories(Cat1, Cat2: TTreeNode): integer;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
{$R *.lfm}
{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TCEOptionEditorWidget.create(aOwner: TComponent);
constructor TCEOptionEditorWidget.Create(aOwner: TComponent);
var
png: TPortableNetworkGraphic;
begin
inherited;
fDockable := false;
fModal:= true;
fEdOptsSubj := TCEEditableOptionsSubject.create;
inspector.CheckboxForBoolean := true;
fDockable := False;
fModal := True;
fEdOptsSubj := TCEEditableOptionsSubject.Create;
inspector.CheckboxForBoolean := True;
//
png := TPortableNetworkGraphic.Create;
try
@ -76,7 +77,7 @@ begin
end;
end;
destructor TCEOptionEditorWidget.destroy;
destructor TCEOptionEditorWidget.Destroy;
begin
fEdOptsSubj.Free;
inherited;
@ -85,8 +86,10 @@ end;
procedure TCEOptionEditorWidget.UpdateShowing;
begin
inherited;
if Visible then updateCategories;
if Visible then
updateCategories;
end;
{$ENDREGION}
{$REGION Option editor things --------------------------------------------------}
@ -98,7 +101,7 @@ var
begin
inspector.TIObject := nil;
selCat.Items.Clear;
for i:= 0 to fEdOptsSubj.observersCount-1 do
for i := 0 to fEdOptsSubj.observersCount - 1 do
begin
dt := new(PCategoryData);
ed := fEdOptsSubj.observers[i] as ICEEditableOptions;
@ -112,7 +115,7 @@ end;
function TCEOptionEditorWidget.sortCategories(Cat1, Cat2: TTreeNode): integer;
begin
result := CompareText(Cat1.Text, Cat2.Text);
Result := CompareText(Cat1.Text, Cat2.Text);
end;
procedure TCEOptionEditorWidget.selCatDeletion(Sender: TObject; Node: TTreeNode);
@ -131,11 +134,14 @@ begin
if pnlEd.ControlCount > 0 then
pnlEd.Controls[0].Parent := nil;
//
if selCat.Selected = nil then exit;
if selCat.Selected.Data = nil then exit;
if selCat.Selected = nil then
exit;
if selCat.Selected.Data = nil then
exit;
//
dt := PCategoryData(selCat.Selected.Data);
if dt^.container = nil then exit;
if dt^.container = nil then
exit;
case dt^.kind of
oekControl:
begin
@ -146,8 +152,8 @@ begin
begin
TCustomForm(dt^.container).Parent := pnlEd;
TCustomForm(dt^.container).Align := alClient;
TCustomForm(dt^.container).BorderIcons:= [];
TCustomForm(dt^.container).BorderStyle:= bsNone;
TCustomForm(dt^.container).BorderIcons := [];
TCustomForm(dt^.container).BorderStyle := bsNone;
end;
oekGeneric:
begin
@ -160,8 +166,10 @@ end;
procedure TCEOptionEditorWidget.inspectorModified(Sender: TObject);
begin
if selCat.Selected = nil then exit;
if selcat.Selected.Data = nil then exit;
if selCat.Selected = nil then
exit;
if selcat.Selected.Data = nil then
exit;
//
PCategoryData(selCat.Selected.Data)^
.observer
@ -170,8 +178,10 @@ end;
procedure TCEOptionEditorWidget.btnCancelClick(Sender: TObject);
begin
if selCat.Selected = nil then exit;
if selcat.Selected.Data = nil then exit;
if selCat.Selected = nil then
exit;
if selcat.Selected.Data = nil then
exit;
//
if inspector.Parent <> nil then
inspector.ItemIndex := -1;
@ -180,22 +190,23 @@ begin
.optionedEvent(oeeCancel);
end;
procedure TCEOptionEditorWidget.inspectorEditorFilter(Sender: TObject;aEditor:
TPropertyEditor; var aShow: boolean);
procedure TCEOptionEditorWidget.inspectorEditorFilter(Sender: TObject; aEditor: TPropertyEditor; var aShow: boolean);
begin
if aEditor.GetComponent(0) is TComponent then
begin
if aEditor.GetPropInfo^.Name = 'Tag' then
aSHow := false;
aSHow := False;
if aEditor.GetPropInfo^.Name = 'Name' then
aSHow := false;
aSHow := False;
end;
end;
procedure TCEOptionEditorWidget.btnAcceptClick(Sender: TObject);
begin
if selCat.Selected = nil then exit;
if selcat.Selected.Data = nil then exit;
if selCat.Selected = nil then
exit;
if selcat.Selected.Data = nil then
exit;
//
if inspector.Parent <> nil then
inspector.ItemIndex := -1;
@ -203,7 +214,7 @@ begin
.observer
.optionedEvent(oeeAccept);
end;
{$ENDREGION}
end.

33
src/ce_plugin.pas
View File

@ -11,16 +11,17 @@ type
TCEHost = type Pointer;
TCEPlugin = type Pointer;
const
// API version
CE_PLG_API_VER = 0;
// opcodes constants -------------------------------------------------------------]
// opcodes constants -------------------------------------------------------------]
HELLO_PLUGIN = $FFFFFFFF; // hello world
// Denotes the emiter and the message kind -------------------------------------
// Denotes the emiter and the message kind -------------------------------------
/// Coedit sends an event.
HOST_EVENT = $10000000;
@ -31,7 +32,7 @@ const
/// The plug-in sends some data.
PLUG_DATA = $40000000;
// Denotes the message context -------------------------------------------------
// Denotes the message context -------------------------------------------------
/// the dispatcher call is related to the project(s)
CTXT_PROJ = $01000000;
@ -44,7 +45,7 @@ const
/// the dispatcher call is related to the Coedit dialogs.
CTXT_DLGS = $05000000;
// The events kinds ------------------------------------------------------------
// The events kinds ------------------------------------------------------------
/// somethings's just changed.
EV_CHANGED = $00000001;
@ -59,7 +60,7 @@ const
/// something gonna be executed.
EV_RUN = $00000006;
// The data kinds --------------------------------------------------------------
// The data kinds --------------------------------------------------------------
/// data1 is used to set/get a filename. data1 is a PChar. data0 represents an index.
DT_FNAME = $00000001;
@ -73,7 +74,7 @@ const
DATA_FNAME = $00000001;
// terminal opCodes (emiter + context + event/data kind) -----------------------
// terminal opCodes (emiter + context + event/data kind) -----------------------
/// Coedit says that the project's just been modified.
HOST_PROJ_CHANGED = HOST_EVENT + CTXT_PROJ + EV_CHANGED;
@ -109,7 +110,7 @@ type
*)
TPlugDispatchToHost = procedure(aPlugin: TCEPlugin; opCode: LongWord; data0: Integer; data1, data2: Pointer); cdecl;
// plugin-side prototypes ------------------------------------------------------
// plugin-side prototypes ------------------------------------------------------
(**
* Coedit initializes a plugin, the result is passed during the runtime as "aTarget".
@ -134,9 +135,10 @@ type
// internal --------------------------------------------------------------------
// internal --------------------------------------------------------------------
PPlugDescriptor = ^TPlugDescriptor;
TPlugDescriptor = record
Handle: TLibHandle;
Plugin: TCEPlugin;
@ -152,6 +154,7 @@ type
procedure addPlugin(aValue: PPlugDescriptor);
property plugin[index: integer]: TPlugDescriptor read getPlugin;
end;
TPlugDescriptorEnumerator = class
fList: TCEPlugDescriptorList;
fIndex: Integer;
@ -160,13 +163,13 @@ type
property current: TPlugDescriptor read getCurrent;
end;
operator enumerator(aPlugDescrList: TCEPlugDescriptorList): TPlugDescriptorEnumerator;
operator enumerator(aPlugDescrList: TCEPlugDescriptorList): TPlugDescriptorEnumerator;
implementation
function TCEPlugDescriptorList.getPlugin(index: integer): TPlugDescriptor;
begin
result := TPlugDescriptor(Items[index]^);
Result := TPlugDescriptor(Items[index]^);
end;
procedure TCEPlugDescriptorList.addPlugin(aValue: PPlugDescriptor);
@ -176,20 +179,20 @@ end;
function TPlugDescriptorEnumerator.getCurrent: TPlugDescriptor;
begin
result := fList.plugin[fIndex];
Result := fList.plugin[fIndex];
end;
function TPlugDescriptorEnumerator.moveNext: boolean;
begin
Inc(fIndex);
result := fIndex < fList.Count;
Result := fIndex < fList.Count;
end;
operator enumerator(aPlugDescrList: TCEPlugDescriptorList): TPlugDescriptorEnumerator;
begin
result := TPlugDescriptorEnumerator.Create;
result.fList := aPlugDescrList;
result.fIndex := -1;
Result := TPlugDescriptorEnumerator.Create;
Result.fList := aPlugDescrList;
Result.fIndex := -1;
end;
end.

35
src/ce_procinput.pas
View File

@ -28,20 +28,21 @@ type
procedure addProcess(aProcess: TProcess);
procedure removeProcess(aProcess: TProcess);
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
//
procedure sesoptDeclareProperties(aFiler: TFiler); override;
end;
implementation
{$R *.lfm}
uses
ce_symstring, LCLType;
{$REGION Standard Comp/Obj -----------------------------------------------------}
constructor TCEProcInputWidget.create(aOwner: TComponent);
constructor TCEProcInputWidget.Create(aOwner: TComponent);
begin
inherited;
fMru := TMRUList.Create;
@ -49,18 +50,19 @@ begin
EntitiesConnector.addSingleService(self);
end;
destructor TCEProcInputWidget.destroy;
destructor TCEProcInputWidget.Destroy;
begin
fMru.Free;
inherited;
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION ICESessionOptionsObserver ---------------------------------------------}
procedure TCEProcInputWidget.sesoptDeclareProperties(aFiler: TFiler);
begin
inherited;
aFiler.DefineProperty(Name + '_inputMru', @optset_InputMru, @optget_InputMru, true);
aFiler.DefineProperty(Name + '_inputMru', @optset_InputMru, @optget_InputMru, True);
end;
procedure TCEProcInputWidget.optset_InputMru(aReader: TReader);
@ -72,6 +74,7 @@ procedure TCEProcInputWidget.optget_InputMru(aWriter: TWriter);
begin
aWriter.WriteString(fMru.DelimitedText);
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION ICEProcInputHandler ---------------------------------------------------}
@ -102,6 +105,7 @@ begin
if fProc = aProcess then
addProcess(nil);
end;
{$ENDREGION}
{$REGION Process input things --------------------------------------------------}
@ -109,7 +113,7 @@ procedure TCEProcInputWidget.sendInput;
var
inp: string;
begin
fMru.Insert(0,txtInp.Text);
fMru.Insert(0, txtInp.Text);
fMruPos := 0;
if txtInp.Text <> '' then
inp := symbolExpander.get(txtInp.Text) + lineEnding
@ -126,24 +130,29 @@ begin
sendInput;
end;
procedure TCEProcInputWidget.txtInpKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure TCEProcInputWidget.txtInpKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
case Key of
VK_RETURN:
if fProc <> nil then sendInput;
VK_UP: begin
if fProc <> nil then
sendInput;
VK_UP:
begin
fMruPos += 1;
if fMruPos > fMru.Count-1 then fMruPos := 0;
if fMruPos > fMru.Count - 1 then
fMruPos := 0;
txtInp.Text := fMru.Strings[fMruPos];
end;
VK_DOWN: begin
VK_DOWN:
begin
fMruPos -= 1;
if fMruPos < 0 then fMruPos := fMru.Count-1;
if fMruPos < 0 then
fMruPos := fMru.Count - 1;
txtInp.Text := fMru.Strings[fMruPos];
end;
end;
end;
{$ENDREGION --------------------------------------------------------------------}
end.

206
src/ce_projconf.pas
View File

@ -30,7 +30,7 @@ type
procedure inspectorModified(Sender: TObject);
procedure selConfChange(Sender: TObject);
procedure TreeChange(Sender: TObject; Node: TTreeNode);
procedure GridFilter(Sender: TObject; aEditor: TPropertyEditor;var aShow: boolean);
procedure GridFilter(Sender: TObject; aEditor: TPropertyEditor; var aShow: boolean);
private
fProj: TCEProject;
fSyncroMode: boolean;
@ -50,15 +50,16 @@ type
procedure updateImperative; override;
procedure SetVisible(Value: boolean); override;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
{$R *.lfm}
{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TCEProjectConfigurationWidget.create(aOwner: TComponent);
constructor TCEProjectConfigurationWidget.Create(aOwner: TComponent);
var
png: TPortableNetworkGraphic;
begin
@ -78,12 +79,12 @@ begin
end;
Tree.Selected := Tree.Items.GetLastNode;
inspector.OnEditorFilter := @GridFilter;
inspector.CheckboxForBoolean := true;
inspector.CheckboxForBoolean := True;
//
EntitiesConnector.addObserver(self);
end;
destructor TCEProjectConfigurationWidget.destroy;
destructor TCEProjectConfigurationWidget.Destroy;
begin
EntitiesConnector.removeObserver(self);
inherited;
@ -92,7 +93,8 @@ end;
procedure TCEProjectConfigurationWidget.SetVisible(Value: boolean);
begin
inherited;
if Visible then updateImperative;
if Visible then
updateImperative;
end;
{$ENDREGION --------------------------------------------------------------------}
@ -102,8 +104,9 @@ procedure TCEProjectConfigurationWidget.projNew(aProject: TCEProject);
begin
beginImperativeUpdate;
fProj := aProject;
if Visible then updateImperative;
syncroMode := false;
if Visible then
updateImperative;
syncroMode := False;
end;
procedure TCEProjectConfigurationWidget.projClosing(aProject: TCEProject);
@ -113,42 +116,48 @@ begin
inspector.TIObject := nil;
inspector.ItemIndex := -1;
self.selConf.Clear;
syncroMode := false;
syncroMode := False;
fProj := nil;
end;
procedure TCEProjectConfigurationWidget.projChanged(aProject: TCEProject);
begin
if fProj <> aProject then exit;
if fProj <> aProject then
exit;
fProj := aProject;
if Visible then updateImperative;
if Visible then
updateImperative;
end;
procedure TCEProjectConfigurationWidget.projFocused(aProject: TCEProject);
begin
fProj := aProject;
if Visible then updateImperative;
if Visible then
updateImperative;
end;
procedure TCEProjectConfigurationWidget.projCompiling(aProject: TCEProject);
begin
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION config. things --------------------------------------------------------}
procedure TCEProjectConfigurationWidget.selConfChange(Sender: TObject);
begin
if fProj = nil then exit;
if Updating then exit;
if selConf.ItemIndex = -1 then exit;
if fProj = nil then
exit;
if Updating then
exit;
if selConf.ItemIndex = -1 then
exit;
//
beginImperativeUpdate;
fProj.ConfigurationIndex := selConf.ItemIndex;
endImperativeUpdate;
end;
procedure TCEProjectConfigurationWidget.TreeChange(Sender: TObject;
Node: TTreeNode);
procedure TCEProjectConfigurationWidget.TreeChange(Sender: TObject; Node: TTreeNode);
begin
inspector.TIObject := getGridTarget;
end;
@ -157,13 +166,16 @@ procedure TCEProjectConfigurationWidget.setSyncroMode(aValue: boolean);
var
png: TPortableNetworkGraphic;
begin
if fSyncroMode = aValue then exit;
if fSyncroMode = aValue then
exit;
//
fSyncroMode := aValue;
png := TPortableNetworkGraphic.Create;
try
if fSyncroMode then png.LoadFromLazarusResource('link')
else png.LoadFromLazarusResource('link_break');
if fSyncroMode then
png.LoadFromLazarusResource('link')
else
png.LoadFromLazarusResource('link_break');
btnSyncEdit.Glyph.Assign(png);
finally
png.Free;
@ -172,7 +184,7 @@ end;
function TCEProjectConfigurationWidget.syncroSetPropAsString(const ASection, Item, Default: string): string;
begin
result := fSyncroPropValue;
Result := fSyncroPropValue;
end;
procedure TCEProjectConfigurationWidget.syncroGetPropAsString(const ASection, Item, Value: string);
@ -189,50 +201,65 @@ var
trg_obj: TPersistent;
i: Integer;
begin
if fProj = nil then exit;
if not fSyncroMode then exit;
if inspector.TIObject = nil then exit;
if inspector.ItemIndex = -1 then exit;
if fProj = nil then
exit;
if not fSyncroMode then
exit;
if inspector.TIObject = nil then
exit;
if inspector.ItemIndex = -1 then
exit;
//
storage := nil;
src_prop:= nil;
trg_prop:= nil;
src_prop := nil;
trg_prop := nil;
trg_obj := nil;
propstr := inspector.PropertyPath(inspector.ItemIndex);
storage := rttiutils.TPropsStorage.Create;
storage.OnReadString := @syncroSetPropAsString;
storage.OnWriteString := @syncroGetPropAsString;
src_list:= rttiutils.TPropInfoList.Create(getGridTarget, tkAny);
src_list := rttiutils.TPropInfoList.Create(getGridTarget, tkAny);
fProj.beginUpdate;
try
src_prop := src_list.Find(propstr);
if src_prop = nil then exit;
if src_prop = nil then
exit;
storage.AObject := getGridTarget;
storage.StoreAnyProperty(src_prop);
for i:= 0 to fProj.OptionsCollection.Count-1 do
for i := 0 to fProj.OptionsCollection.Count - 1 do
begin
// skip current config
if i = fProj.ConfigurationIndex then continue;
if i = fProj.ConfigurationIndex then
continue;
// find target persistent
if inspector.TIObject = fProj.currentConfiguration.messagesOptions then
trg_obj := fProj.configuration[i].messagesOptions else
trg_obj := fProj.configuration[i].messagesOptions
else
if inspector.TIObject = fProj.currentConfiguration.debugingOptions then
trg_obj := fProj.configuration[i].debugingOptions else
trg_obj := fProj.configuration[i].debugingOptions
else
if inspector.TIObject = fProj.currentConfiguration.documentationOptions then
trg_obj := fProj.configuration[i].documentationOptions else
trg_obj := fProj.configuration[i].documentationOptions
else
if inspector.TIObject = fProj.currentConfiguration.outputOptions then
trg_obj := fProj.configuration[i].outputOptions else
trg_obj := fProj.configuration[i].outputOptions
else
if inspector.TIObject = fProj.currentConfiguration.otherOptions then
trg_obj := fProj.configuration[i].otherOptions else
trg_obj := fProj.configuration[i].otherOptions
else
if inspector.TIObject = fProj.currentConfiguration.pathsOptions then
trg_obj := fProj.configuration[i].pathsOptions else
trg_obj := fProj.configuration[i].pathsOptions
else
if inspector.TIObject = fProj.currentConfiguration.preBuildProcess then
trg_obj := fProj.configuration[i].preBuildProcess else
trg_obj := fProj.configuration[i].preBuildProcess
else
if inspector.TIObject = fProj.currentConfiguration.postBuildProcess then
trg_obj := fProj.configuration[i].postBuildProcess else
trg_obj := fProj.configuration[i].postBuildProcess
else
if inspector.TIObject = fProj.currentConfiguration.runOptions then
trg_obj := fProj.configuration[i].runOptions
else continue;
else
continue;
// find target property
storage.AObject := trg_obj;
trg_list := rttiutils.TPropInfoList.Create(trg_obj, tkAny);
@ -246,8 +273,8 @@ begin
end;
end;
finally
storage.free;
src_list.free;
storage.Free;
src_list.Free;
fProj.endUpdate;
fSyncroPropValue := '';
end;
@ -258,21 +285,25 @@ var
nme: string;
cfg: TCompilerConfiguration;
begin
if fProj = nil then exit;
if fProj = nil then
exit;
//
nme := '';
beginImperativeUpdate;
cfg := fProj.addConfiguration;
// note: Cancel is actually related to the conf. name not to the add operation.
if InputQuery('Configuration name', '', nme) then cfg.name := nme;
if InputQuery('Configuration name', '', nme) then
cfg.Name := nme;
fProj.ConfigurationIndex := cfg.Index;
endImperativeUpdate;
end;
procedure TCEProjectConfigurationWidget.btnDelConfClick(Sender: TObject);
begin
if fProj = nil then exit;
if fProj.OptionsCollection.Count = 1 then exit;
if fProj = nil then
exit;
if fProj.OptionsCollection.Count = 1 then
exit;
//
beginImperativeUpdate;
inspector.TIObject := nil;
@ -286,82 +317,89 @@ end;
procedure TCEProjectConfigurationWidget.btnCloneCurrClick(Sender: TObject);
var
nme: string;
trg,src: TCompilerConfiguration;
trg, src: TCompilerConfiguration;
begin
if fProj = nil then exit;
if fProj = nil then
exit;
//
nme := '';
beginImperativeUpdate;
src := fProj.currentConfiguration;
trg := fProj.addConfiguration;
trg.assign(src);
if InputQuery('Configuration name', '', nme) then trg.name := nme;
trg.Assign(src);
if InputQuery('Configuration name', '', nme) then
trg.Name := nme;
fProj.ConfigurationIndex := trg.Index;
endImperativeUpdate;
end;
procedure TCEProjectConfigurationWidget.btnSyncEditClick(Sender: TObject);
begin
if fProj = nil then exit;
if fProj = nil then
exit;
syncroMode := not syncroMode;
end;
procedure TCEProjectConfigurationWidget.GridFilter(Sender: TObject; aEditor: TPropertyEditor;
var aShow: boolean);
procedure TCEProjectConfigurationWidget.GridFilter(Sender: TObject; aEditor: TPropertyEditor; var aShow: boolean);
begin
if fProj = nil then exit;
if fProj = nil then
exit;
// filter TComponent things.
if getGridTarget = fProj then
begin
if aEditor.GetName = 'Name' then
aShow := false
aShow := False
else if aEditor.GetName = 'Tag' then
aShow := false
aShow := False
else if aEditor.ClassType = TCollectionPropertyEditor then
aShow := false;
aShow := False;
end;
// deprecated field
if getGridTarget = fProj.currentConfiguration.pathsOptions then
begin
if aEditor.GetName = 'Sources' then
aShow := false
aShow := False
else if aEditor.GetName = 'includes' then
aShow := false
aShow := False
else if aEditor.GetName = 'imports' then
aShow := false;
aShow := False;
end;
if getGridTarget = fProj.currentConfiguration.outputOptions then
if aEditor.GetName = 'noBoundsCheck' then
aShow := false;
aShow := False;
if getGridTarget = fProj.currentConfiguration.debugingOptions then
begin
if aEditor.GetName = 'addCInformations' then
aShow := false
aShow := False
else if aEditor.GetName = 'addDInformations' then
aShow := false;
aShow := False;
end;
end;
function TCEProjectConfigurationWidget.getGridTarget: TPersistent;
begin
if fProj = nil then exit(nil);
if fProj.ConfigurationIndex = -1 then exit(nil);
if Tree.Selected = nil then exit(nil);
if fProj = nil then
exit(nil);
if fProj.ConfigurationIndex = -1 then
exit(nil);
if Tree.Selected = nil then
exit(nil);
// Warning: TTreeNode.StateIndex is usually made for the images...it's not a tag
case Tree.Selected.StateIndex of
1: exit( fProj );
2: exit( fProj.currentConfiguration.messagesOptions );
3: exit( fProj.currentConfiguration.debugingOptions );
4: exit( fProj.currentConfiguration.documentationOptions );
5: exit( fProj.currentConfiguration.outputOptions );
6: exit( fProj.currentConfiguration.otherOptions );
7: exit( fProj.currentConfiguration.pathsOptions );
8: exit( fProj.currentConfiguration.preBuildProcess );
9: exit( fProj.currentConfiguration.postBuildProcess );
10:exit( fProj.currentConfiguration.runOptions );
11:exit( fProj.currentConfiguration );
else result := nil;
1: exit(fProj);
2: exit(fProj.currentConfiguration.messagesOptions);
3: exit(fProj.currentConfiguration.debugingOptions);
4: exit(fProj.currentConfiguration.documentationOptions);
5: exit(fProj.currentConfiguration.outputOptions);
6: exit(fProj.currentConfiguration.otherOptions);
7: exit(fProj.currentConfiguration.pathsOptions);
8: exit(fProj.currentConfiguration.preBuildProcess);
9: exit(fProj.currentConfiguration.postBuildProcess);
10: exit(fProj.currentConfiguration.runOptions);
11: exit(fProj.currentConfiguration);
else
Result := nil;
end;
end;
@ -369,15 +407,17 @@ procedure TCEProjectConfigurationWidget.updateImperative;
var
i: NativeInt;
begin
selConf.ItemIndex:= -1;
selConf.ItemIndex := -1;
selConf.Clear;
if fProj = nil then exit;
if fProj = nil then
exit;
//
for i:= 0 to fProj.OptionsCollection.Count-1 do
selConf.Items.Add(fProj.configuration[i].name);
for i := 0 to fProj.OptionsCollection.Count - 1 do
selConf.Items.Add(fProj.configuration[i].Name);
selConf.ItemIndex := fProj.ConfigurationIndex;
inspector.TIObject := getGridTarget;
end;
{$ENDREGION --------------------------------------------------------------------}
end.

137
src/ce_projinspect.pas
View File

@ -5,7 +5,7 @@ unit ce_projinspect;
interface
uses
Classes, SysUtils, FileUtil, TreeFilterEdit, Forms, Controls, Graphics, actnlist,
Classes, SysUtils, FileUtil, TreeFilterEdit, Forms, Controls, Graphics, ActnList,
Dialogs, ExtCtrls, ComCtrls, Menus, Buttons, lcltype, ce_project, ce_interfaces,
ce_common, ce_widget, ce_observer;
@ -38,9 +38,9 @@ type
fFileNode, fConfNode: TTreeNode;
fImpsNode, fInclNode: TTreeNode;
fXtraNode: TTreeNode;
procedure actUpdate(sender: TObject);
procedure TreeDblClick(sender: TObject);
procedure actOpenFileExecute(sender: TObject);
procedure actUpdate(Sender: TObject);
procedure TreeDblClick(Sender: TObject);
procedure actOpenFileExecute(Sender: TObject);
//
procedure projNew(aProject: TCEProject);
procedure projClosing(aProject: TCEProject);
@ -52,18 +52,19 @@ type
function contextActionCount: integer; override;
function contextAction(index: integer): TAction; override;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
{$R *.lfm}
uses
ce_symstring;
{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TCEProjectInspectWidget.create(aOwner: TComponent);
constructor TCEProjectInspectWidget.Create(aOwner: TComponent);
var
png: TPortableNetworkGraphic;
begin
@ -105,7 +106,7 @@ begin
EntitiesConnector.addObserver(self);
end;
destructor TCEProjectInspectWidget.destroy;
destructor TCEProjectInspectWidget.Destroy;
begin
EntitiesConnector.removeObserver(self);
inherited;
@ -114,8 +115,10 @@ end;
procedure TCEProjectInspectWidget.SetVisible(Value: boolean);
begin
inherited;
if Value then updateImperative;
if Value then
updateImperative;
end;
{$ENDREGION}
{$REGION ICEContextualActions---------------------------------------------------}
@ -134,21 +137,24 @@ begin
case index of
0: exit(fActOpenFile);
1: exit(fActSelConf);
else exit(nil);
else
exit(nil);
end;
end;
procedure TCEProjectInspectWidget.actOpenFileExecute(sender: TObject);
procedure TCEProjectInspectWidget.actOpenFileExecute(Sender: TObject);
begin
TreeDblClick(sender);
TreeDblClick(Sender);
end;
{$ENDREGION}
{$REGION ICEProjectMonitor -----------------------------------------------------}
procedure TCEProjectInspectWidget.projNew(aProject: TCEProject);
begin
fProject := aProject;
if Visible then updateImperative;
if Visible then
updateImperative;
end;
procedure TCEProjectInspectWidget.projClosing(aProject: TCEProject);
@ -162,18 +168,22 @@ end;
procedure TCEProjectInspectWidget.projFocused(aProject: TCEProject);
begin
fProject := aProject;
if Visible then beginDelayedUpdate;
if Visible then
beginDelayedUpdate;
end;
procedure TCEProjectInspectWidget.projChanged(aProject: TCEProject);
begin
if fProject <> aProject then exit;
if Visible then beginDelayedUpdate;
if fProject <> aProject then
exit;
if Visible then
beginDelayedUpdate;
end;
procedure TCEProjectInspectWidget.projCompiling(aProject: TCEProject);
begin
end;
{$ENDREGION}
{$REGION Inspector things -------------------------------------------------------}
@ -185,16 +195,18 @@ end;
procedure TCEProjectInspectWidget.TreeSelectionChanged(Sender: TObject);
begin
actUpdate(sender);
actUpdate(Sender);
end;
procedure TCEProjectInspectWidget.TreeDblClick(sender: TObject);
procedure TCEProjectInspectWidget.TreeDblClick(Sender: TObject);
var
fname: string;
i: NativeInt;
begin
if fProject = nil then exit;
if Tree.Selected = nil then exit;
if fProject = nil then
exit;
if Tree.Selected = nil then
exit;
//
if (Tree.Selected.Parent = fFileNode) or (Tree.Selected.Parent = fXtraNode) then
begin
@ -214,29 +226,32 @@ begin
end;
end;
procedure TCEProjectInspectWidget.actUpdate(sender: TObject);
procedure TCEProjectInspectWidget.actUpdate(Sender: TObject);
begin
fActSelConf.Enabled := false;
fActOpenFile.Enabled := false;
if Tree.Selected = nil then exit;
fActSelConf.Enabled := False;
fActOpenFile.Enabled := False;
if Tree.Selected = nil then
exit;
fActSelConf.Enabled := Tree.Selected.Parent = fConfNode;
fActOpenFile.Enabled := Tree.Selected.Parent = fFileNode;
end;
procedure TCEProjectInspectWidget.btnAddFileClick(Sender: TObject);
begin
if fProject = nil then exit;
if fProject = nil then
exit;
//
with TOpenDialog.Create(nil) do
try
filter := DdiagFilter;
if execute then begin
if Execute then
begin
fProject.beginUpdate;
fProject.addSource(filename);
fProject.endUpdate;
end;
finally
free;
Free;
end;
end;
@ -246,18 +261,20 @@ var
lst: TStringList;
i: NativeInt;
begin
if fProject = nil then exit;
if fProject = nil then
exit;
//
if fileExists(fProject.fileName) then
dir := extractFilePath(fProject.fileName)
else dir := '';
if selectDirectory('sources', dir, dir, true, 0) then
else
dir := '';
if selectDirectory('sources', dir, dir, True, 0) then
begin
fProject.beginUpdate;
lst := TStringList.Create;
try
listFiles(lst, dir, true);
for i := 0 to lst.Count-1 do
listFiles(lst, dir, True);
for i := 0 to lst.Count - 1 do
begin
fname := lst.Strings[i];
ext := extractFileExt(fname);
@ -276,19 +293,24 @@ var
dir, fname: string;
i: Integer;
begin
if fProject = nil then exit;
if Tree.Selected = nil then exit;
if Tree.Selected.Parent <> fFileNode then exit;
if fProject = nil then
exit;
if Tree.Selected = nil then
exit;
if Tree.Selected.Parent <> fFileNode then
exit;
//
fname := Tree.Selected.Text;
i := fProject.Sources.IndexOf(fname);
if i = -1 then exit;
if i = -1 then
exit;
fname := fProject.getAbsoluteSourceName(i);
dir := extractFilePath(fname);
if not DirectoryExists(dir) then exit;
if not DirectoryExists(dir) then
exit;
//
fProject.beginUpdate;
for i:= fProject.Sources.Count-1 downto 0 do
for i := fProject.Sources.Count - 1 downto 0 do
if extractFilePath(fProject.getAbsoluteSourceName(i)) = dir then
fProject.Sources.Delete(i);
fProject.endUpdate;
@ -299,14 +321,17 @@ var
fname: string;
i: NativeInt;
begin
if fProject = nil then exit;
if Tree.Selected = nil then exit;
if fProject = nil then
exit;
if Tree.Selected = nil then
exit;
//
if Tree.Selected.Parent = fFileNode then
begin
fname := Tree.Selected.Text;
i := fProject.Sources.IndexOf(fname);
if i > -1 then begin
if i > -1 then
begin
fProject.beginUpdate;
fProject.Sources.Delete(i);
fProject.endUpdate;
@ -319,7 +344,8 @@ var
fname: string;
multidoc: ICEMultiDocHandler;
begin
if fProject = nil then exit;
if fProject = nil then
exit;
multidoc := getMultiDocHandler;
for fname in Filenames do
if FileExists(fname) then
@ -348,7 +374,8 @@ begin
fImpsNode.DeleteChildren;
fInclNode.DeleteChildren;
fXtraNode.DeleteChildren;
if fProject = nil then exit;
if fProject = nil then
exit;
Tree.BeginUpdate;
// display main sources
for src in fProject.Sources do
@ -358,13 +385,14 @@ begin
itm.SelectedIndex := 2;
end;
// display configurations
for i := 0 to fProject.OptionsCollection.Count-1 do
for i := 0 to fProject.OptionsCollection.Count - 1 do
begin
conf := fProject.configuration[i].name;
if i = fProject.ConfigurationIndex then conf += ' (active)';
conf := fProject.configuration[i].Name;
if i = fProject.ConfigurationIndex then
conf += ' (active)';
itm := Tree.Items.AddChild(fConfNode, conf);
itm.ImageIndex := 3;
itm.SelectedIndex:= 3;
itm.SelectedIndex := 3;
end;
// display Imports (-J)
for fold in FProject.currentConfiguration.pathsOptions.importStringPaths do
@ -377,7 +405,7 @@ begin
itm.ImageIndex := 5;
itm.SelectedIndex := 5;
end;
fImpsNode.Collapse(false);
fImpsNode.Collapse(False);
// display Includes (-I)
for fold in FProject.currentConfiguration.pathsOptions.importModulePaths do
begin
@ -389,7 +417,7 @@ begin
itm.ImageIndex := 5;
itm.SelectedIndex := 5;
end;
fInclNode.Collapse(false);
fInclNode.Collapse(False);
// display extra sources (external .lib, *.a, *.d)
for src in FProject.currentConfiguration.pathsOptions.extraSources do
begin
@ -399,11 +427,15 @@ begin
src := symbolExpander.get(src);
lst := TStringList.Create;
try
if listAsteriskPath(src, lst) then for src in lst do begin
if listAsteriskPath(src, lst) then
for src in lst do
begin
itm := Tree.Items.AddChild(fXtraNode, src);
itm.ImageIndex := 2;
itm.SelectedIndex := 2;
end else begin
end
else
begin
itm := Tree.Items.AddChild(fXtraNode, src);
itm.ImageIndex := 2;
itm.SelectedIndex := 2;
@ -412,9 +444,10 @@ begin
lst.Free;
end;
end;
fXtraNode.Collapse(false);
fXtraNode.Collapse(False);
Tree.EndUpdate;
end;
{$ENDREGION --------------------------------------------------------------------}
end.

116
src/ce_search.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Menus, StdCtrls, actnList, Buttons, SynEdit, SynEditSearch, SynEditTypes, ce_common,
Menus, StdCtrls, ActnList, Buttons, SynEdit, SynEditSearch, SynEditTypes, ce_common,
ce_widget, ce_synmemo, ce_interfaces, ce_observer, SynEditHighlighter;
type
@ -47,9 +47,8 @@ type
procedure optset_ReplaceMru(aReader: TReader);
procedure optget_ReplaceMru(aWriter: TWriter);
function getOptions: TSynSearchOptions;
procedure actReplaceAllExecute(sender: TObject);
procedure replaceEvent(Sender: TObject; const ASearch, AReplace:
string; Line, Column: integer; var ReplaceAction: TSynReplaceAction);
procedure actReplaceAllExecute(Sender: TObject);
procedure replaceEvent(Sender: TObject; const ASearch, AReplace: string; Line, Column: integer; var ReplaceAction: TSynReplaceAction);
protected
procedure updateImperative; override;
public
@ -67,11 +66,12 @@ type
//
procedure sesoptDeclareProperties(aFiler: TFiler); override;
//
procedure actFindNextExecute(sender: TObject);
procedure actReplaceNextExecute(sender: TObject);
procedure actFindNextExecute(Sender: TObject);
procedure actReplaceNextExecute(Sender: TObject);
end;
implementation
{$R *.lfm}
{$REGION Standard Comp/Obj------------------------------------------------------}
@ -93,7 +93,7 @@ begin
btnReplaceAll.Action := fActReplaceAll;
//
fSearchMru := TMruList.Create;
fReplaceMru:= TMruList.Create;
fReplaceMru := TMruList.Create;
//
EntitiesConnector.addObserver(self);
end;
@ -105,14 +105,15 @@ begin
fReplaceMru.Free;
inherited;
end;
{$ENDREGION}
{$REGION ICESessionOptionsObserver ---------------------------------------------}
procedure TCESearchWidget.sesoptDeclareProperties(aFiler: TFiler);
begin
inherited;
aFiler.DefineProperty(Name + '_FindMRU', @optset_SearchMru, @optget_SearchMru, true);
aFiler.DefineProperty(Name + '_ReplaceMRU', @optset_ReplaceMru, @optget_ReplaceMru, true);
aFiler.DefineProperty(Name + '_FindMRU', @optset_SearchMru, @optget_SearchMru, True);
aFiler.DefineProperty(Name + '_ReplaceMRU', @optset_ReplaceMru, @optget_ReplaceMru, True);
end;
procedure TCESearchWidget.optset_SearchMru(aReader: TReader);
@ -129,12 +130,14 @@ end;
procedure TCESearchWidget.optset_ReplaceMru(aReader: TReader);
begin
fReplaceMru.DelimitedText := aReader.ReadString;
cbReplaceWth.Items.DelimitedText := fReplaceMru.DelimitedText ;
cbReplaceWth.Items.DelimitedText := fReplaceMru.DelimitedText;
end;
procedure TCESearchWidget.optget_ReplaceMru(aWriter: TWriter);
begin
aWriter.WriteString(fReplaceMru.DelimitedText);
end;
{$ENDREGION}
{$REGION ICEContextualActions---------------------------------------------------}
@ -154,29 +157,34 @@ begin
0: exit(fActFindNext);
1: exit(fActReplaceNext);
2: exit(fActReplaceAll);
else exit(nil);
else
exit(nil);
end;
end;
function TCESearchWidget.getOptions: TSynSearchOptions;
begin
result := [];
if chkRegex.Checked then result += [ssoRegExpr];
if chkWWord.Checked then result += [ssoWholeWord];
if chkBack.Checked then result += [ssoBackwards];
if chkCaseSens.Checked then result += [ssoMatchCase];
if chkPrompt.Checked then result += [ssoPrompt];
Result := [];
if chkRegex.Checked then
Result += [ssoRegExpr];
if chkWWord.Checked then
Result += [ssoWholeWord];
if chkBack.Checked then
Result += [ssoBackwards];
if chkCaseSens.Checked then
Result += [ssoMatchCase];
if chkPrompt.Checked then
Result += [ssoPrompt];
end;
function dlgReplaceAll: TModalResult;
const
Btns = [mbYes, mbNo, mbYesToAll, mbNoToAll];
begin
exit( MessageDlg('Coedit', 'Replace this match ?', mtConfirmation, Btns, ''));
exit(MessageDlg('Coedit', 'Replace this match ?', mtConfirmation, Btns, ''));
end;
procedure TCESearchWidget.replaceEvent(Sender: TObject; const ASearch, AReplace:
string; Line, Column: integer; var ReplaceAction: TSynReplaceAction);
procedure TCESearchWidget.replaceEvent(Sender: TObject; const ASearch, AReplace: string; Line, Column: integer; var ReplaceAction: TSynReplaceAction);
begin
case dlgReplaceAll of
mrYes: ReplaceAction := raReplace;
@ -185,16 +193,17 @@ begin
mrCancel, mrClose, mrNoToAll:
begin
ReplaceAction := raCancel;
fCancelAll := true;
fCancelAll := True;
end;
end;
end;
procedure TCESearchWidget.actFindNextExecute(sender: TObject);
procedure TCESearchWidget.actFindNextExecute(Sender: TObject);
begin
if fDoc = nil then exit;
if fDoc = nil then
exit;
//
fSearchMru.Insert(0,fToFind);
fSearchMru.Insert(0, fToFind);
if not chkFromCur.Checked then
begin
if chkBack.Checked then
@ -202,8 +211,8 @@ begin
else
begin
if not fHasRestarted then
fDoc.CaretXY := Point(0,0);
fHasRestarted := true;
fDoc.CaretXY := Point(0, 0);
fHasRestarted := True;
end;
end
else if fHasSearched then
@ -217,16 +226,17 @@ begin
dlgOkInfo('the expression cannot be found')
else
begin
fHasSearched := true;
fHasRestarted := false;
chkFromCur.Checked := true;
fHasSearched := True;
fHasRestarted := False;
chkFromCur.Checked := True;
end;
updateImperative;
end;
procedure TCESearchWidget.actReplaceNextExecute(sender: TObject);
procedure TCESearchWidget.actReplaceNextExecute(Sender: TObject);
begin
if fDoc = nil then exit;
if fDoc = nil then
exit;
//
fSearchMru.Insert(0, fToFind);
fReplaceMru.Insert(0, fReplaceWth);
@ -237,7 +247,7 @@ begin
if chkBack.Checked then
fDoc.CaretXY := Point(high(Integer), high(Integer))
else
fDoc.CaretXY := Point(0,0);
fDoc.CaretXY := Point(0, 0);
end
else if fHasSearched then
begin
@ -247,36 +257,39 @@ begin
fDoc.CaretX := fDoc.CaretX + length(fToFind);
end;
if fDoc.SearchReplace(fToFind, fReplaceWth, getOptions + [ssoReplace]) <> 0 then
fHasSearched := true;
fHasSearched := True;
fDoc.OnReplaceText := nil;
updateImperative;
end;
procedure TCESearchWidget.actReplaceAllExecute(sender: TObject);
procedure TCESearchWidget.actReplaceAllExecute(Sender: TObject);
var
opts: TSynSearchOptions;
begin
if fDoc = nil then exit;
if fDoc = nil then
exit;
opts := getOptions + [ssoReplace];
opts -= [ssoBackwards];
//
fSearchMru.Insert(0, fToFind);
fReplaceMru.Insert(0, fReplaceWth);
if chkPrompt.Checked then fDoc.OnReplaceText := @replaceEvent;
fDoc.CaretXY := Point(0,0);
while(true) do
if chkPrompt.Checked then
fDoc.OnReplaceText := @replaceEvent;
fDoc.CaretXY := Point(0, 0);
while (True) do
begin
if fDoc.SearchReplace(fToFind, fReplaceWth, opts) = 0
then break;
if fDoc.SearchReplace(fToFind, fReplaceWth, opts) = 0 then
break;
if fCancelAll then
begin
fCancelAll := false;
fCancelAll := False;
break;
end;
end;
fDoc.OnReplaceText := nil;
updateImperative;
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ---------------------------------------------------}
@ -288,13 +301,15 @@ end;
procedure TCESearchWidget.docClosing(aDoc: TCESynMemo);
begin
if fDoc = aDoc then fDoc := nil;
if fDoc = aDoc then
fDoc := nil;
updateImperative;
end;
procedure TCESearchWidget.docFocused(aDoc: TCESynMemo);
begin
if fDoc = aDoc then exit;
if fDoc = aDoc then
exit;
fDoc := aDoc;
updateImperative;
end;
@ -302,27 +317,31 @@ end;
procedure TCESearchWidget.docChanged(aDoc: TCESynMemo);
begin
end;
{$ENDREGION}
{$REGION Misc. -----------------------------------------------------------------}
procedure TCESearchWidget.cbToFindChange(Sender: TObject);
begin
if Updating then exit;
if Updating then
exit;
fToFind := cbToFind.Text;
fHasSearched := false;
fHasSearched := False;
end;
procedure TCESearchWidget.chkEnableRepChange(Sender: TObject);
begin
if Updating then exit;
if Updating then
exit;
updateImperative;
end;
procedure TCESearchWidget.cbReplaceWthChange(Sender: TObject);
begin
if Updating then exit;
if Updating then
exit;
fReplaceWth := cbReplaceWth.Text;
fHasSearched := false;
fHasSearched := False;
end;
procedure TCESearchWidget.updateImperative;
@ -336,6 +355,7 @@ begin
cbToFind.Items.Assign(fSearchMru);
cbReplaceWth.Items.Assign(fReplaceMru);
end;
{$ENDREGION}
end.

121
src/ce_shortcutseditor.pas
View File

@ -19,7 +19,7 @@ type
property declarator: ICEEditableShortCut read fDeclarator write fDeclarator;
published
property identifier: string read fIdentifier write fIdentifier;
property data: TShortcut read fData write fData;
property Data: TShortcut read fData write fData;
public
function combination: string;
end;
@ -33,13 +33,13 @@ type
published
property items: TCollection read fItems write setItems;
public
constructor create(AOwner: TComponent); override;
destructor destroy; override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
//
function findIdentifier(const identifier: string): boolean;
function findShortcut(aShortcut: Word): boolean;
//
property count: Integer read getCount;
property Count: Integer read getCount;
property item[index: Integer]: TShortcutItem read getItem; default;
end;
@ -52,7 +52,7 @@ type
btnActivate: TSpeedButton;
tree: TTreeView;
procedure btnActivateClick(Sender: TObject);
procedure LabeledEdit1KeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
procedure LabeledEdit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure shortcutCatcherExit(Sender: TObject);
procedure shortcutCatcherMouseLeave(Sender: TObject);
procedure treeSelectionChanged(Sender: TObject);
@ -73,11 +73,12 @@ type
protected
procedure UpdateShowing; override;
public
constructor create(TheOwner: TComponent); override;
destructor destroy; override;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
{$R *.lfm}
var
@ -86,16 +87,16 @@ var
{$REGION TShortCutCollection ---------------------------------------------------}
function TShortcutItem.combination: string;
begin
result := ShortCutToText(fData);
Result := ShortCutToText(fData);
end;
constructor TShortCutCollection.create(AOwner: TComponent);
constructor TShortCutCollection.Create(AOwner: TComponent);
begin
inherited;
fItems := TCollection.Create(TShortcutItem);
end;
destructor TShortCutCollection.destroy;
destructor TShortCutCollection.Destroy;
begin
fItems.Free;
inherited;
@ -120,35 +121,36 @@ function TShortCutCollection.findIdentifier(const identifier: string): boolean;
var
i: Integer;
begin
result := false;
for i := 0 to count-1 do
Result := False;
for i := 0 to Count - 1 do
if item[i].identifier = identifier then
exit(true);
exit(True);
end;
function TShortCutCollection.findShortcut(aShortcut: Word): boolean;
var
i: Integer;
begin
result := false;
for i := 0 to count-1 do
if item[i].data = aShortcut then
exit(true);
Result := False;
for i := 0 to Count - 1 do
if item[i].Data = aShortcut then
exit(True);
end;
{$ENDREGION}
{$REGION Standard Comp/Object things -------------------------------------------}
constructor TCEShortcutEditor.create(TheOwner: TComponent);
constructor TCEShortcutEditor.Create(TheOwner: TComponent);
begin
inherited;
fObservers := TCEEditableShortCutSubject.create;
fShortcuts := TShortCutCollection.create(self);
fBackup := TShortCutCollection.create(self);
fObservers := TCEEditableShortCutSubject.Create;
fShortcuts := TShortCutCollection.Create(self);
fBackup := TShortCutCollection.Create(self);
//
EntitiesConnector.addObserver(self);
end;
destructor TCEShortcutEditor.destroy;
destructor TCEShortcutEditor.Destroy;
begin
fObservers.Free;
inherited;
@ -156,19 +158,21 @@ end;
procedure TCEShortcutEditor.UpdateShowing;
var
png : TPortableNetworkGraphic;
png: TPortableNetworkGraphic;
begin
inherited;
if not visible then exit;
if not Visible then
exit;
//
png := TPortableNetworkGraphic.Create;
try
png.LoadFromLazarusResource('keyboard_pencil');
btnActivate.Glyph.Assign(png);
finally
png.free;
png.Free;
end;
end;
{$ENDREGION}
{$REGION ICEEditableOptions ----------------------------------------------------}
@ -192,6 +196,7 @@ procedure TCEShortcutEditor.optionedEvent(anEvent: TOptionEditorEvent);
begin
// TODO-cfeature: pass new shortcut to observer
end;
{$ENDREGION}
{$REGION shortcut editor things ------------------------------------------------}
@ -202,21 +207,24 @@ end;
procedure TCEShortcutEditor.shortcutCatcherExit(Sender: TObject);
begin
shortcutCatcher.Enabled := false;
shortcutCatcher.Enabled := False;
updateEditCtrls;
end;
procedure TCEShortcutEditor.shortcutCatcherMouseLeave(Sender: TObject);
begin
shortcutCatcher.Enabled := false;
shortcutCatcher.Enabled := False;
updateEditCtrls;
end;
procedure TCEShortcutEditor.btnActivateClick(Sender: TObject);
begin
if tree.Selected = nil then exit;
if tree.Selected.Level = 0 then exit;
if tree.Selected.Data = nil then exit;
if tree.Selected = nil then
exit;
if tree.Selected.Level = 0 then
exit;
if tree.Selected.Data = nil then
exit;
//
shortcutCatcher.Enabled := not shortcutCatcher.Enabled;
end;
@ -225,19 +233,22 @@ procedure TCEShortcutEditor.LabeledEdit1KeyDown(Sender: TObject; var Key: Word;
var
sh: TShortCut;
begin
if tree.Selected = nil then exit;
if tree.Selected.Level = 0 then exit;
if tree.Selected.Data = nil then exit;
if tree.Selected = nil then
exit;
if tree.Selected.Level = 0 then
exit;
if tree.Selected.Data = nil then
exit;
//
if Key = VK_RETURN then
shortcutCatcher.Enabled := false
shortcutCatcher.Enabled := False
else
begin
sh := Shortcut(Key, Shift);
TShortcutItem(tree.Selected.Data).data := sh;
TShortcutItem(tree.Selected.Data).Data := sh;
TShortcutItem(tree.Selected.Data).declarator.scedSendItem(
tree.Selected.Parent.Text,
tree.Selected.Text, sh );
tree.Selected.Text, sh);
end;
//
updateEditCtrls;
@ -247,9 +258,12 @@ procedure TCEShortcutEditor.updateEditCtrls;
begin
schrtText.Caption := '';
//
if tree.Selected = nil then exit;
if tree.Selected.Level = 0 then exit;
if tree.Selected.Data = nil then exit;
if tree.Selected = nil then
exit;
if tree.Selected.Level = 0 then
exit;
if tree.Selected.Data = nil then
exit;
//
schrtText.Caption := TShortcutItem(tree.Selected.Data).combination;
shortcutCatcher.Text := '';
@ -259,8 +273,8 @@ function TCEShortcutEditor.findCategory(const aName: string; aData: Pointer): TT
var
i: Integer;
begin
result := nil;
for i:= 0 to tree.Items.Count-1 do
Result := nil;
for i := 0 to tree.Items.Count - 1 do
if tree.Items[i].Text = aName then
if tree.Items[i].Data = aData then
exit(tree.Items[i]);
@ -268,7 +282,7 @@ end;
function TCEShortcutEditor.sortCategories(Cat1, Cat2: TTreeNode): integer;
begin
result := CompareText(Cat1.Text, Cat2.Text);
Result := CompareText(Cat1.Text, Cat2.Text);
end;
procedure TCEShortcutEditor.updateFromObservers;
@ -279,32 +293,36 @@ var
sht: word;
idt: string;
itm: TShortcutItem;
procedure addItem();
var
procedure addItem();
var
prt: TTreeNode;
begin
begin
// root category
if cat = '' then exit;
if idt = '' then exit;
if cat = '' then
exit;
if idt = '' then
exit;
prt := findCategory(cat, obs);
if prt = nil then
prt := tree.Items.AddObject(nil, cat, obs);
// item as child
itm := TShortcutItem(fShortcuts.items.Add);
itm.identifier := idt;
itm.data:= sht;
itm.Data := sht;
itm.declarator := obs;
tree.Items.AddChildObject(prt, idt, itm);
cat := '';
idt := '';
end;
end;
begin
tree.Items.Clear;
fShortcuts.items.Clear;
fBackup.items.Clear;
cat := '';
idt := '';
for i:= 0 to fObservers.observersCount-1 do
for i := 0 to fObservers.observersCount - 1 do
begin
obs := fObservers.observers[i] as ICEEditableShortCut;
if obs.scedWantFirst then
@ -316,11 +334,12 @@ begin
end;
tree.Items.SortTopLevelNodes(@sortCategories);
end;
{$ENDREGION}
initialization
CEShortcutEditor := TCEShortcutEditor.Create(nil);
finalization
CEShortcutEditor.Free;
end.

64
src/ce_staticmacro.pas
View File

@ -5,7 +5,7 @@ unit ce_staticmacro;
interface
uses
Classes, Sysutils, SynEdit, SynCompletion,
Classes, SysUtils, SynEdit, SynCompletion,
ce_interfaces, ce_writableComponent, ce_synmemo;
type
@ -25,8 +25,8 @@ type
property macros: TStringList read fMacros write setMacros;
property shortcut: TShortCut read fShortCut write fShortCut;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure AssignTo(Dest: TPersistent); override;
end;
@ -71,8 +71,8 @@ type
property macros: TStringList read fMacros write setMacros;
property automatic: boolean read fAutomatic write fAutomatic;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
// execute using the editor
procedure Execute; overload;
// execute in aEditor, according to aToken
@ -110,13 +110,13 @@ const
{$REGION TStaticMacrosOptions --------------------------------------------------}
constructor TStaticMacrosOptions.create(aOwner: TComponent);
constructor TStaticMacrosOptions.Create(aOwner: TComponent);
begin
inherited;
fMacros := TStringList.Create;
end;
destructor TStaticMacrosOptions.destroy;
destructor TStaticMacrosOptions.Destroy;
begin
fMacros.Free;
inherited;
@ -143,7 +143,8 @@ begin
macros.Assign(opt.fMacros);
shortcut := opt.shortcut;
end
else inherited;
else
inherited;
end;
procedure TStaticMacrosOptions.AssignTo(Dest: TPersistent);
@ -170,31 +171,33 @@ begin
opt.macros.Assign(fMacros);
opt.shortcut := shortcut;
end
else inherited;
else
inherited;
end;
procedure TStaticMacrosOptions.setMacros(aValue: TStringList);
begin
fMacros.Assign(aValue);
end;
{$ENDREGION}
{$REGION Standard Comp/Obj -----------------------------------------------------}
constructor TCEStaticEditorMacro.create(aOwner: TComponent);
constructor TCEStaticEditorMacro.Create(aOwner: TComponent);
var
fname: string;
begin
inherited;
fAutomatic := true;
fAutomatic := True;
fCompletor := TSynAutoComplete.Create(self);
fCompletor.ShortCut := 8224; // SHIFT + SPACE
fMacros := TStringList.Create;
fMacros.Delimiter := '=';
addDefaults;
//
fOptions := TStaticMacrosOptions.create(self);
fOptionBackup := TStaticMacrosOptions.create(self);
fOptions := TStaticMacrosOptions.Create(self);
fOptionBackup := TStaticMacrosOptions.Create(self);
fname := getCoeditDocPath + OptFname;
if fileExists(fname) then
begin
@ -205,7 +208,8 @@ begin
else
fOptions.Assign(self);
end
else fOptions.Assign(self);
else
fOptions.Assign(self);
//
sanitize;
updateCompletor;
@ -213,7 +217,7 @@ begin
EntitiesConnector.addObserver(Self);
end;
destructor TCEStaticEditorMacro.destroy;
destructor TCEStaticEditorMacro.Destroy;
begin
fOptions.saveToFile(getCoeditDocPath + OptFname);
EntitiesConnector.removeObserver(Self);
@ -229,6 +233,7 @@ begin
sanitize;
updateCompletor;
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ---------------------------------------------------}
@ -240,7 +245,8 @@ end;
procedure TCEStaticEditorMacro.docFocused(aDoc: TCESynMemo);
begin
if fDoc = aDoc then exit;
if fDoc = aDoc then
exit;
fDoc := aDoc;
fCompletor.Editor := fDoc;
end;
@ -257,6 +263,7 @@ begin
exit;
fDoc := nil;
end;
{$ENDREGION}
{$REGION ICEEditableOptions ----------------------------------------------------}
@ -293,21 +300,22 @@ begin
oeeChange: fOptions.AssignTo(self);
end;
end;
{$ENDREGION}
{$REGION Macros things ---------------------------------------------------------}
procedure TCEStaticEditorMacro.sanitize;
var
i: Integer;
text: string;
Text: string;
macro: string;
begin
for i := fMacros.Count-1 downto 0 do
for i := fMacros.Count - 1 downto 0 do
begin
text := fMacros.Strings[i];
if length(text) >= 4 then
if text[1] = '$' then
if Pos('=', text) > 2 then
Text := fMacros.Strings[i];
if length(Text) >= 4 then
if Text[1] = '$' then
if Pos('=', Text) > 2 then
begin
macro := fMacros.Names[i];
if (macro[length(macro)] in ['a'..'z', 'A'..'Z', '0'..'9']) then
@ -332,7 +340,7 @@ var
tok, val: string;
begin
fCompletor.AutoCompleteList.Clear;
for i := 0 to fMacros.Count-1 do
for i := 0 to fMacros.Count - 1 do
begin
tok := fMacros.Names[i];
val := fMacros.ValueFromIndex[i];
@ -352,11 +360,13 @@ begin
if aEditor <> nil then
fCompletor.Execute(aToken, aEditor);
end;
{$ENDREGION}
initialization
StaticEditorMacro := TCEStaticEditorMacro.create(nil);
finalization
StaticEditorMacro.Free;;
end.
StaticEditorMacro := TCEStaticEditorMacro.Create(nil);
finalization
StaticEditorMacro.Free;
;
end.

332
src/ce_symlist.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, TreeFilterEdit, Forms, Controls, Graphics, ExtCtrls, Menus,
ComCtrls, ce_widget, jsonparser, process, actnlist, Buttons, Clipbrd, LCLProc,
ComCtrls, ce_widget, jsonparser, process, ActnList, Buttons, Clipbrd, LCLProc,
ce_common, ce_observer, ce_synmemo, ce_interfaces, ce_writableComponent, EditBtn;
type
@ -39,12 +39,12 @@ type
published
property line: Integer read fline write fLine;
property col: Integer read fCol write fCol;
property name: string read fName write fName;
property Name: string read fName write fName;
property symType: TSymbolType read fType write fType;
property subs: TSymbolCollection read fSubs write setSubs;
public
constructor Create(ACollection: TCollection); override;
destructor destroy; override;
destructor Destroy; override;
end;
// Encapsulates a ssymbol ub symbols.
@ -52,7 +52,7 @@ type
private
function getSub(index: Integer): TSymbol;
public
constructor create;
constructor Create;
property sub[index: Integer]: TSymbol read getSub; default;
end;
@ -64,8 +64,8 @@ type
published
property symbols: TSymbolCollection read fSymbols write setSymbols;
public
constructor create(aOwner: TCOmponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
//
procedure LoadFromTool(str: TStream);
end;
@ -135,8 +135,8 @@ type
procedure clearTree;
//
procedure callToolProc;
procedure toolOutputData(sender: TObject);
procedure toolTerminated(sender: TObject);
procedure toolOutputData(Sender: TObject);
procedure toolTerminated(Sender: TObject);
//
procedure docNew(aDoc: TCESynMemo);
procedure docClosing(aDoc: TCESynMemo);
@ -160,24 +160,25 @@ type
property refreshOnChange: boolean read fRefreshOnChange write fRefreshOnChange;
property refreshOnFocus: boolean read fRefreshOnFocus write fRefreshOnFocus;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
end;
implementation
{$R *.lfm}
const
OptsFname = 'symbollist.txt';
{$REGION Serializable symbols---------------------------------------------------}
constructor TSymbol.create(ACollection: TCollection);
constructor TSymbol.Create(ACollection: TCollection);
begin
inherited create(ACollection);
fSubs := TSymbolCollection.create;
inherited Create(ACollection);
fSubs := TSymbolCollection.Create;
end;
destructor TSymbol.destroy;
destructor TSymbol.Destroy;
begin
fSubs.Free;
inherited;
@ -188,9 +189,9 @@ begin
fSubs.Assign(aValue);
end;
constructor TSymbolCollection.create;
constructor TSymbolCollection.Create;
begin
inherited create(TSymbol);
inherited Create(TSymbol);
end;
function TSymbolCollection.getSub(index: Integer): TSymbol;
@ -198,15 +199,15 @@ begin
exit(TSymbol(self.Items[index]));
end;
constructor TSymbolList.create(aOwner: TCOmponent);
constructor TSymbolList.Create(aOwner: TComponent);
begin
inherited;
fSymbols := TSymbolCollection.create;
fSymbols := TSymbolCollection.Create;
end;
destructor TSymbolList.destroy;
destructor TSymbolList.Destroy;
begin
fSymbols.free;
fSymbols.Free;
inherited;
end;
@ -221,23 +222,24 @@ var
begin
bin := TMemoryStream.Create;
try
str.Position:=0;
str.Position := 0;
ObjectTextToBinary(str, bin);
bin.Position:=0;
bin.Position := 0;
bin.ReadComponent(self);
finally
bin.Free;
end;
end;
{$ENDREGION}
{$REGION TCESymbolListOptions --------------------------------------------------}
constructor TCESymbolListOptions.Create(AOwner: TComponent);
begin
inherited;
fRefreshOnFocus := true;
fShowChildCategories := true;
fSmartFilter := true;
fRefreshOnFocus := True;
fShowChildCategories := True;
fSmartFilter := True;
fAutoRefreshDelay := 1500;
end;
@ -256,7 +258,8 @@ begin
fShowChildCategories := widg.fShowChildCategories;
fSmartFilter := widg.fSmartFilter;
end
else inherited;
else
inherited;
end;
procedure TCESymbolListOptions.AssignTo(Dest: TPersistent);
@ -275,25 +278,27 @@ begin
widg.fSmartFilter := fSmartFilter;
//
widg.fActAutoRefresh.Checked := fAutoRefresh;
widg.fActRefreshOnChange.Checked:= fRefreshOnChange;
widg.fActRefreshOnChange.Checked := fRefreshOnChange;
widg.fActRefreshOnFocus.Checked := fRefreshOnFocus;
end
else inherited;
else
inherited;
end;
{$ENDREGIOn}
{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TCESymbolListWidget.create(aOwner: TComponent);
constructor TCESymbolListWidget.Create(aOwner: TComponent);
var
png: TPortableNetworkGraphic;
fname: string;
begin
fAutoRefresh := false;
fRefreshOnFocus := true;
fRefreshOnChange := false;
fAutoRefresh := False;
fRefreshOnFocus := True;
fRefreshOnChange := False;
//
fActCopyIdent := TAction.Create(self);
fActCopyIdent.OnExecute:=@actCopyIdentExecute;
fActCopyIdent.OnExecute := @actCopyIdentExecute;
fActCopyIdent.Caption := 'Copy identifier';
fActRefresh := TAction.Create(self);
fActRefresh.OnExecute := @actRefreshExecute;
@ -301,17 +306,17 @@ begin
fActAutoRefresh := TAction.Create(self);
fActAutoRefresh.OnExecute := @actAutoRefreshExecute;
fActAutoRefresh.Caption := 'Auto-refresh';
fActAutoRefresh.AutoCheck := true;
fActAutoRefresh.AutoCheck := True;
fActAutoRefresh.Checked := fAutoRefresh;
fActRefreshOnChange := TAction.Create(self);
fActRefreshOnChange.OnExecute := @actRefreshOnChangeExecute;
fActRefreshOnChange.Caption := 'Refresh on change';
fActRefreshOnChange.AutoCheck := true;
fActRefreshOnChange.AutoCheck := True;
fActRefreshOnChange.Checked := fRefreshOnChange;
fActRefreshOnFocus := TAction.Create(self);
fActRefreshOnFocus.OnExecute := @actRefreshOnFocusExecute;
fActRefreshOnFocus.Caption := 'Refresh on focused';
fActRefreshOnFocus.AutoCheck := true;
fActRefreshOnFocus.AutoCheck := True;
fActRefreshOnFocus.Checked := fRefreshOnFocus;
fActSelectInSource := TAction.Create(self);
fActSelectInSource.OnExecute := @TreeDblClick;
@ -319,11 +324,11 @@ begin
//
inherited;
// allow empty name if owner is nil
fSyms := TSymbolList.create(nil);
fToolOutput := TMemoryStream.create;
fSyms := TSymbolList.Create(nil);
fToolOutput := TMemoryStream.Create;
//
fOptions := TCESymbolListOptions.Create(self);
fOptions.Name:= 'symbolListOptions';
fOptions.Name := 'symbolListOptions';
fname := getCoeditDocPath + OptsFname;
if FileExists(fname) then
fOptions.loadFromFile(fname);
@ -355,12 +360,12 @@ begin
EntitiesConnector.addObserver(self);
end;
destructor TCESymbolListWidget.destroy;
destructor TCESymbolListWidget.Destroy;
begin
EntitiesConnector.removeObserver(self);
//
killProcess(fToolProc);
fToolOutput.free;
fToolOutput.Free;
fSyms.Free;
//
fOptions.saveToFile(getCoeditDocPath + OptsFname);
@ -376,17 +381,18 @@ begin
if Value then
callToolProc;
end;
{$ENDREGION}
{$REGION ICEContextualActions---------------------------------------------------}
function TCESymbolListWidget.contextName: string;
begin
result := 'Static explorer';
Result := 'Static explorer';
end;
function TCESymbolListWidget.contextActionCount: integer;
begin
result := 6;
Result := 6;
end;
function TCESymbolListWidget.contextAction(index: integer): TAction;
@ -398,13 +404,15 @@ begin
3: exit(fActAutoRefresh);
4: exit(fActRefreshOnChange);
5: exit(fActRefreshOnFocus);
else result := nil;
else
Result := nil;
end;
end;
procedure TCESymbolListWidget.actRefreshExecute(Sender: TObject);
begin
if Updating then exit;
if Updating then
exit;
callToolProc;
end;
@ -428,9 +436,11 @@ end;
procedure TCESymbolListWidget.actCopyIdentExecute(Sender: TObject);
begin
if Tree.Selected = nil then exit;
Clipboard.AsText:= Tree.Selected.Text;
if Tree.Selected = nil then
exit;
Clipboard.AsText := Tree.Selected.Text;
end;
{$ENDREGION}
{$REGION ICEEditableOptions ----------------------------------------------------}
@ -452,10 +462,12 @@ end;
procedure TCESymbolListWidget.optionedEvent(anEvent: TOptionEditorEvent);
begin
if anEvent <> oeeAccept then exit;
if anEvent <> oeeAccept then
exit;
fOptions.AssignTo(self);
callToolProc;
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ---------------------------------------------------}
@ -467,7 +479,8 @@ end;
procedure TCESymbolListWidget.docClosing(aDoc: TCESynMemo);
begin
if fDoc <> aDoc then exit;
if fDoc <> aDoc then
exit;
fDoc := nil;
clearTree;
updateVisibleCat;
@ -475,28 +488,38 @@ end;
procedure TCESymbolListWidget.docFocused(aDoc: TCESynMemo);
begin
if fDoc = aDoc then exit;
if fDoc = aDoc then
exit;
fDoc := aDoc;
if not Visible then exit;
if not Visible then
exit;
//
if fAutoRefresh then beginDelayedUpdate
else if fRefreshOnFocus then callToolProc;
if fAutoRefresh then
beginDelayedUpdate
else if fRefreshOnFocus then
callToolProc;
end;
procedure TCESymbolListWidget.docChanged(aDoc: TCESynMemo);
begin
if fDoc <> aDoc then exit;
if not Visible then exit;
if fDoc <> aDoc then
exit;
if not Visible then
exit;
//
if fAutoRefresh then beginDelayedUpdate
else if fRefreshOnChange then callToolProc;
if fAutoRefresh then
beginDelayedUpdate
else if fRefreshOnChange then
callToolProc;
end;
{$ENDREGION}
{$REGION Symbol-tree things ----------------------------------------------------}
procedure TCESymbolListWidget.updateDelayed;
begin
if not fAutoRefresh then exit;
if not fAutoRefresh then
exit;
callToolProc;
end;
@ -522,23 +545,24 @@ begin
ndImp.Visible := ndImp.Count > 0;
ndIntf.Visible := ndIntf.Count > 0;
ndMix.Visible := ndMix.Count > 0;
ndStruct.Visible:= ndStruct.Count > 0;
ndStruct.Visible := ndStruct.Count > 0;
ndTmp.Visible := ndTmp.Count > 0;
ndUni.Visible := ndUni.Count > 0;
ndVar.Visible := ndVar.Count > 0;
end else
end
else
begin
ndAlias.Visible := true;
ndClass.Visible := true;
ndEnum.Visible := true;
ndFunc.Visible := true;
ndImp.Visible := true;
ndIntf.Visible := true;
ndMix.Visible := true;
ndStruct.Visible:= true;
ndTmp.Visible := true;
ndUni.Visible := true;
ndVar.Visible := true;
ndAlias.Visible := True;
ndClass.Visible := True;
ndEnum.Visible := True;
ndFunc.Visible := True;
ndImp.Visible := True;
ndIntf.Visible := True;
ndMix.Visible := True;
ndStruct.Visible := True;
ndTmp.Visible := True;
ndUni.Visible := True;
ndVar.Visible := True;
end;
end;
@ -559,42 +583,48 @@ end;
procedure TCESymbolListWidget.TreeFilterEdit1AfterFilter(Sender: TObject);
begin
if TreeFilterEdit1.Filter ='' then
if TreeFilterEdit1.Filter = '' then
updateVisibleCat;
end;
function TCESymbolListWidget.TreeFilterEdit1FilterItem(Item: TObject; out
Done: Boolean): Boolean;
function TCESymbolListWidget.TreeFilterEdit1FilterItem(Item: TObject; out Done: Boolean): Boolean;
begin
if not fSmartFilter then exit;
if not fSmartFilter then
exit;
//
if TreeFilterEdit1.Filter <> '' then
tree.FullExpand
else if tree.Selected = nil then
tree.FullCollapse
else tree.MakeSelectionVisible;
result := false;
else
tree.MakeSelectionVisible;
Result := False;
end;
procedure TCESymbolListWidget.TreeFilterEdit1MouseEnter(Sender: TObject);
begin
if not fSmartFilter then exit;
if not fSmartFilter then
exit;
//
tree.Selected := nil;
end;
procedure TCESymbolListWidget.TreeKeyPress(Sender: TObject; var Key: char);
begin
if Key = #13 then TreeDblClick(nil);
if Key = #13 then
TreeDblClick(nil);
end;
procedure TCESymbolListWidget.TreeDblClick(Sender: TObject);
var
line: Int64;
begin
if fDoc = nil then exit;
if Tree.Selected = nil then exit;
if Tree.Selected.Data = nil then exit;
if fDoc = nil then
exit;
if Tree.Selected = nil then
exit;
if Tree.Selected.Data = nil then
exit;
//
line := PInt64(Tree.Selected.Data)^;
fDoc.CaretY := line;
@ -605,8 +635,10 @@ procedure TCESymbolListWidget.callToolProc;
var
srcFname: string;
begin
if fDoc = nil then exit;
if fDoc.Lines.Count = 0 then exit;
if fDoc = nil then
exit;
if fDoc.Lines.Count = 0 then
exit;
// standard process options
killProcess(fToolProc);
@ -628,112 +660,129 @@ begin
fToolProc.Execute;
end;
procedure TCESymbolListWidget.toolOutputData(sender: TObject);
procedure TCESymbolListWidget.toolOutputData(Sender: TObject);
begin
processOutputToStream(TProcess(sender), fToolOutput);
processOutputToStream(TProcess(Sender), fToolOutput);
end;
procedure TCESymbolListWidget.toolTerminated(sender: TObject);
procedure TCESymbolListWidget.toolTerminated(Sender: TObject);
//
function getCatNode(node: TTreeNode; stype: TSymbolType ): TTreeNode;
begin
if node = nil then case stype of
_alias : exit(ndAlias);
_class : exit(ndClass);
_enum : exit(ndEnum);
_function : exit(ndFunc);
_import : exit(ndImp);
function getCatNode(node: TTreeNode; stype: TSymbolType): TTreeNode;
begin
if node = nil then
case stype of
_alias: exit(ndAlias);
_class: exit(ndClass);
_enum: exit(ndEnum);
_function: exit(ndFunc);
_import: exit(ndImp);
_interface: exit(ndIntf);
_mixin : exit(ndMix);
_struct : exit(ndStruct);
_template : exit(ndTmp);
_union : exit(ndUni);
_variable : exit(ndVar);
end else case stype of
_mixin: exit(ndMix);
_struct: exit(ndStruct);
_template: exit(ndTmp);
_union: exit(ndUni);
_variable: exit(ndVar);
end
else
case stype of
_alias:
begin
result := node.FindNode('Alias');
if result = nil then result := node.TreeNodes.AddChild(node, 'Alias');
Result := node.FindNode('Alias');
if Result = nil then
Result := node.TreeNodes.AddChild(node, 'Alias');
end;
_class:
begin
result := node.FindNode('Class');
if result = nil then result := node.TreeNodes.AddChild(node, 'Class');
Result := node.FindNode('Class');
if Result = nil then
Result := node.TreeNodes.AddChild(node, 'Class');
end;
_enum:
begin
result := node.FindNode('Enum');
if result = nil then result := node.TreeNodes.AddChild(node, 'Enum');
Result := node.FindNode('Enum');
if Result = nil then
Result := node.TreeNodes.AddChild(node, 'Enum');
end;
_function:
begin
result := node.FindNode('Function');
if result = nil then result := node.TreeNodes.AddChild(node, 'Function');
Result := node.FindNode('Function');
if Result = nil then
Result := node.TreeNodes.AddChild(node, 'Function');
end;
_import:
begin
result := node.FindNode('Import');
if result = nil then result := node.TreeNodes.AddChild(node, 'Import');
Result := node.FindNode('Import');
if Result = nil then
Result := node.TreeNodes.AddChild(node, 'Import');
end;
_interface:
begin
result := node.FindNode('Interface');
if result = nil then result := node.TreeNodes.AddChild(node, 'Interface');
Result := node.FindNode('Interface');
if Result = nil then
Result := node.TreeNodes.AddChild(node, 'Interface');
end;
_mixin:
begin
result := node.FindNode('Mixin');
if result = nil then result := node.TreeNodes.AddChild(node, 'Mixin');
Result := node.FindNode('Mixin');
if Result = nil then
Result := node.TreeNodes.AddChild(node, 'Mixin');
end;
_struct:
begin
result := node.FindNode('Struct');
if result = nil then result := node.TreeNodes.AddChild(node, 'Struct');
Result := node.FindNode('Struct');
if Result = nil then
Result := node.TreeNodes.AddChild(node, 'Struct');
end;
_template:
begin
result := node.FindNode('Template');
if result = nil then result := node.TreeNodes.AddChild(node, 'Template');
Result := node.FindNode('Template');
if Result = nil then
Result := node.TreeNodes.AddChild(node, 'Template');
end;
_union:
begin
result := node.FindNode('Union');
if result = nil then result := node.TreeNodes.AddChild(node, 'Union');
Result := node.FindNode('Union');
if Result = nil then
Result := node.TreeNodes.AddChild(node, 'Union');
end;
_variable:
begin
result := node.FindNode('Variable');
if result = nil then result := node.TreeNodes.AddChild(node, 'Variable');
Result := node.FindNode('Variable');
if Result = nil then
Result := node.TreeNodes.AddChild(node, 'Variable');
end;
end;
end;
//
procedure symbolToTreeNode(origin: TTreenode; sym: TSymbol);
var
data: PInt64;
end;
//
procedure symbolToTreeNode(origin: TTreenode; sym: TSymbol);
var
Data: PInt64;
cat: TTreeNode;
node: TTreeNode;
i: Integer;
begin
begin
cat := getCatNode(origin, sym.symType);
data := new(PInt64);
data^ := sym.fline;
node := tree.Items.AddChildObject(cat, sym.name, data);
if not fShowChildCategories then node := nil;
cat.Visible:=true;
for i := 0 to sym.subs.Count-1 do
Data := new(PInt64);
Data^ := sym.fline;
node := tree.Items.AddChildObject(cat, sym.Name, Data);
if not fShowChildCategories then
node := nil;
cat.Visible := True;
for i := 0 to sym.subs.Count - 1 do
symbolToTreeNode(node, sym.subs[i]);
end;
//
end;
//
var
i: Integer;
begin
if ndAlias = nil then exit;
if ndAlias = nil then
exit;
clearTree;
updateVisibleCat;
if fDoc = nil then exit;
if fDoc = nil then
exit;
//
processOutputToStream(TProcess(sender), fToolOutput);
processOutputToStream(TProcess(Sender), fToolOutput);
fToolOutput.Position := 0;
fSyms.LoadFromTool(fToolOutput);
fToolProc.OnTerminate := nil;
@ -741,10 +790,11 @@ begin
fToolOutput.Clear;
//
tree.BeginUpdate;
for i := 0 to fSyms.symbols.Count-1 do
for i := 0 to fSyms.symbols.Count - 1 do
symbolToTreeNode(nil, fSyms.symbols[i]);
tree.EndUpdate;
end;
{$ENDREGION --------------------------------------------------------------------}
end.

114
src/ce_symstring.pas
View File

@ -36,8 +36,8 @@ type
procedure docFocused(aDoc: TCESynMemo);
procedure docChanged(aDoc: TCESynMemo);
public
constructor create;
destructor destroy; override;
constructor Create;
destructor Destroy; override;
// expands the symbols contained in symString
function get(const symString: string): string;
end;
@ -48,19 +48,20 @@ var
implementation
uses
Forms, sysutils, classes;
Forms, SysUtils, Classes;
{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TCESymbolExpander.create;
constructor TCESymbolExpander.Create;
begin
EntitiesConnector.addObserver(self);
end;
destructor TCESymbolExpander.destroy;
destructor TCESymbolExpander.Destroy;
begin
EntitiesConnector.removeObserver(self);
inherited;
end;
{$ENDREGION}
{$REGION ICEProjectObserver ----------------------------------------------------}
@ -71,7 +72,8 @@ end;
procedure TCESymbolExpander.projClosing(aProject: TCEProject);
begin
if fProj <> aProject then exit;
if fProj <> aProject then
exit;
fProj := nil;
end;
@ -82,12 +84,14 @@ end;
procedure TCESymbolExpander.projChanged(aProject: TCEProject);
begin
if fProj <> aProject then exit;
if fProj <> aProject then
exit;
end;
procedure TCESymbolExpander.projCompiling(aProject: TCEProject);
begin
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ---------------------------------------------------}
@ -98,7 +102,8 @@ end;
procedure TCESymbolExpander.docClosing(aDoc: TCESynMemo);
begin
if aDoc <> fDoc then exit;
if aDoc <> fDoc then
exit;
fDoc := nil;
end;
@ -109,8 +114,10 @@ end;
procedure TCESymbolExpander.docChanged(aDoc: TCESynMemo);
begin
if aDoc <> fDoc then exit;
if aDoc <> fDoc then
exit;
end;
{$ENDREGION}
{$REGION Symbol things ---------------------------------------------------------}
@ -131,33 +138,42 @@ begin
// document
if hasDoc then
begin
if fileExists(fDoc.fileName) then begin
if fileExists(fDoc.fileName) then
begin
fSymbols[CFF] := fDoc.fileName;
fSymbols[CFP] := ExtractFilePath(fDoc.fileName);
end
else begin
else
begin
fSymbols[CFF] := na;
fSymbols[CFP] := na;
end;
if fDoc.Identifier <> '' then
fSymbols[CI] := fDoc.Identifier
else fSymbols[CI] := na;
end else begin
else
fSymbols[CI] := na;
end
else
begin
fSymbols[CFF] := na;
fSymbols[CFP] := na;
fSymbols[CI ] := na;
fSymbols[CI] := na;
end;
// project
if hasProj then
begin
if fileExists(fProj.fileName) then begin
if fileExists(fProj.fileName) then
begin
fSymbols[CPF] := fProj.fileName;
fSymbols[CPP] := ExtractFilePath(fProj.fileName);
fSymbols[CPR] := fProj.getAbsoluteFilename(fProj.RootFolder);
fSymbols[CPN] := stripFileExt(extractFileName(fProj.fileName));
fSymbols[CPO] := fProj.outputFilename;
if fSymbols[CPR] = '' then fSymbols[CPR] := fSymbols[CPP];
end else begin
if fSymbols[CPR] = '' then
fSymbols[CPR] := fSymbols[CPP];
end
else
begin
fSymbols[CPF] := na;
fSymbols[CPP] := na;
fSymbols[CPR] := na;
@ -165,24 +181,27 @@ begin
fSymbols[CPO] := na;
end;
fSymbols[CPFS] := '';
for i := 0 to fProj.Sources.Count-1 do
for i := 0 to fProj.Sources.Count - 1 do
begin
fname := fProj.getAbsoluteSourceName(i);
if dExtList.IndexOf(ExtractFileExt(fname)) = -1 then
continue;
fSymbols[CPFS] += fname;
if fProj.Sources.Count > 1 then
if i <> fProj.Sources.Count-1 then
if i <> fProj.Sources.Count - 1 then
fSymbols[CPFS] += LineEnding;
end;
if fProj.Sources.Count = 0 then fSymbols[CPFS] := na;
end else begin
if fProj.Sources.Count = 0 then
fSymbols[CPFS] := na;
end
else
begin
fSymbols[CPF] := na;
fSymbols[CPP] := na;
fSymbols[CPR] := na;
fSymbols[CPN] := na;
fSymbols[CPO] := na;
fSymbols[CPFS]:= na;
fSymbols[CPFS] := na;
end;
end;
@ -193,8 +212,9 @@ var
begs, ends: boolean;
i: integer;
begin
result := '';
if symString = '' then exit;
Result := '';
if symString = '' then
exit;
updateSymbols;
//
elems := TStringList.Create;
@ -202,58 +222,60 @@ begin
i := 0;
elem := '';
repeat
inc(i);
Inc(i);
if not (symString[i] in ['<', '>']) then
elem += symString[i]
else
begin
if symString[i] = '<' then
begs := true;
begs := True;
ends := symString[i] = '>';
elems.Add(elem);
elem := '';
if begs and ends then
begin
begs := false;
ends := false;
begs := False;
ends := False;
// elem.obj is a flag to diferenciate symbols from elements
elems.Objects[elems.Count-1] := Self;
elems.Objects[elems.Count - 1] := Self;
end;
end;
until
i = length(symString);
elems.Add(elem);
elem := '';
for i:= 0 to elems.Count-1 do
for i := 0 to elems.Count - 1 do
begin
if elems.Objects[i] = nil then
result += elems.Strings[i]
else case elems.Strings[i] of
'<','>': continue;
'CAF', 'CoeditApplicationFile':result += fSymbols[CAF];
'CAP', 'CoeditApplicationPath':result += fSymbols[CAP];
Result += elems.Strings[i]
else
case elems.Strings[i] of
'<', '>': continue;
'CAF', 'CoeditApplicationFile': Result += fSymbols[CAF];
'CAP', 'CoeditApplicationPath': Result += fSymbols[CAP];
//
'CFF', 'CurrentFileFile': result += fSymbols[CFF];
'CFP', 'CurrentFilePath': result += fSymbols[CFP];
'CI', 'CurrentIdentifier': result += fSymbols[CI];
'CFF', 'CurrentFileFile': Result += fSymbols[CFF];
'CFP', 'CurrentFilePath': Result += fSymbols[CFP];
'CI', 'CurrentIdentifier': Result += fSymbols[CI];
//
'CPF', 'CurrentProjectFile': result += fSymbols[CPF];
'CPFS', 'CurrentProjectFiles': result += fSymbols[CPFS];
'CPN', 'CurrentProjectName': result += fSymbols[CPN];
'CPO', 'CurrentProjectOutput': result += fSymbols[CPO];
'CPP', 'CurrentProjectPath': result += fSymbols[CPP];
'CPR', 'CurrentProjectRoot': result += fSymbols[CPR];
'CPF', 'CurrentProjectFile': Result += fSymbols[CPF];
'CPFS', 'CurrentProjectFiles': Result += fSymbols[CPFS];
'CPN', 'CurrentProjectName': Result += fSymbols[CPN];
'CPO', 'CurrentProjectOutput': Result += fSymbols[CPO];
'CPP', 'CurrentProjectPath': Result += fSymbols[CPP];
'CPR', 'CurrentProjectRoot': Result += fSymbols[CPR];
end;
end;
finally
elems.Free;
end;
end;
{$ENDREGION}
initialization
symbolExpander := TCESymbolExpander.create;
symbolExpander := TCESymbolExpander.Create;
finalization
symbolExpander.Free;
end.

3
src/ce_synmemo.pas
View File

@ -338,6 +338,9 @@ begin
Gutter.SeparatorPart.MarkupInfo.Foreground := clGray;
Gutter.CodeFoldPart.MarkupInfo.Foreground := clGray;
BracketMatchColor.Foreground:=clRed;
//
self.BookMarkOptions.GlyphsVisible:= true;
self.BookMarkOptions.BookmarkImages;
//
MouseLinkColor.Style:= [fsUnderline];
with MouseActions.Add do begin

228
src/ce_todolist.pas
View File

@ -38,13 +38,13 @@ type
fCategory: string;
fStatus: string;
published
property filename:string read fFile write fFile;
property filename: string read fFile write fFile;
property line: string read fLine write fLine;
property text: string read fText write fText;
property assignee:string read fAssignee write fAssignee;
property category:string read fCategory write fCategory;
property Text: string read fText write fText;
property assignee: string read fAssignee write fAssignee;
property category: string read fCategory write fCategory;
property status: string read fStatus write fStatus;
property priority:string read fPriority write fPriority;
property priority: string read fPriority write fPriority;
end;
// encapsulates / makes serializable a collection of TODO item.
@ -59,11 +59,11 @@ type
// warning, "items" must be kept in sync with...
property items: TCollection read fItems write setItems;
public
constructor create(AOwner: TComponent); override;
destructor destroy; override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
// str is the output stream of the tool process.
procedure loadFromTxtStream(str: TMemoryStream);
property count: integer read getCount;
property Count: integer read getCount;
property item[index: integer]: TTodoItem read getItem; default;
end;
@ -108,28 +108,29 @@ type
function getContext: TTodoContext;
procedure killToolProcess;
procedure callToolProcess;
procedure toolTerminated(sender: TObject);
procedure toolOutputData(sender: TObject);
procedure procOutputDbg(sender: TObject);
procedure toolTerminated(Sender: TObject);
procedure toolOutputData(Sender: TObject);
procedure procOutputDbg(Sender: TObject);
procedure clearTodoList;
procedure fillTodoList;
procedure lstItemsColumnClick(Sender : TObject; Column : TListColumn);
procedure lstItemsCompare(Sender : TObject; item1, item2: TListItem;Data : Integer; var Compare : Integer);
procedure btnRefreshClick(sender: TObject);
procedure filterItems(sender: TObject);
procedure lstItemsColumnClick(Sender: TObject; Column: TListColumn);
procedure lstItemsCompare(Sender: TObject; item1, item2: TListItem; Data: Integer; var Compare: Integer);
procedure btnRefreshClick(Sender: TObject);
procedure filterItems(Sender: TObject);
procedure setSingleClick(aValue: boolean);
procedure setAutoRefresh(aValue: boolean);
protected
procedure SetVisible(Value: boolean); override;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
//
property singleClickSelect: boolean read fSingleClick write setSingleClick;
property autoRefresh: boolean read fAutoRefresh write setAutoRefresh;
end;
implementation
{$R *.lfm}
const
@ -137,13 +138,13 @@ const
OptFname = 'todolist.txt';
{$REGION TTodoItems ------------------------------------------------------------}
constructor TTodoItems.create(aOwner: TComponent);
constructor TTodoItems.Create(aOwner: TComponent);
begin
inherited;
fItems := TCollection.Create(TTodoItem);
end;
destructor TTodoItems.destroy;
destructor TTodoItems.Destroy;
begin
fItems.Free;
inherited;
@ -156,12 +157,12 @@ end;
function TTodoItems.getItem(index: Integer): TTodoItem;
begin
result := TTodoItem(fItems.Items[index]);
Result := TTodoItem(fItems.Items[index]);
end;
function TTodoItems.getCount: integer;
begin
result := fItems.Count;
Result := fItems.Count;
end;
procedure TTodoItems.loadFromTxtStream(str: TMemoryStream);
@ -169,12 +170,13 @@ var
bin: TMemoryStream;
begin
// empty collection ~ length
if str.Size < 50 then exit;
if str.Size < 50 then
exit;
//
try
bin := TMemoryStream.Create;
try
str.Position:=0;
str.Position := 0;
ObjectTextToBinary(str, bin);
bin.Position := 0;
bin.ReadComponent(self);
@ -185,10 +187,11 @@ begin
fItems.Clear;
end;
end;
{$ENDREGIOn}
{$REGION Standard Comp/Obj -----------------------------------------------------}
constructor TCETodoListWidget.create(aOwner: TComponent);
constructor TCETodoListWidget.Create(aOwner: TComponent);
var
png: TPortableNetworkGraphic;
fname: string;
@ -197,19 +200,19 @@ begin
//
fToolOutput := TMemoryStream.Create;
fOptions := TCETodoOptions.Create(self);
fOptions.autoRefresh := true;
fOptions.autoRefresh := True;
fOptions.Name := 'todolistOptions';
//
fTodos := TTodoItems.Create(self);
lstItems.OnDblClick := @handleListClick;
btnRefresh.OnClick := @btnRefreshClick;
lstItems.OnColumnClick:= @lstItemsColumnClick;
lstItems.OnColumnClick := @lstItemsColumnClick;
lstItems.OnCompare := @lstItemsCompare;
fAutoRefresh := true;
fSingleClick := false;
mnuAutoRefresh.Checked := true;
lstfilter.OnChange:= @filterItems;
btnGo.OnClick:= @handleListClick;
fAutoRefresh := True;
fSingleClick := False;
mnuAutoRefresh.Checked := True;
lstfilter.OnChange := @filterItems;
btnGo.OnClick := @handleListClick;
//
png := TPortableNetworkGraphic.Create;
try
@ -229,7 +232,7 @@ begin
EntitiesConnector.addObserver(self);
end;
destructor TCETodoListWidget.destroy;
destructor TCETodoListWidget.Destroy;
begin
fOptions.saveToFile(getCoeditDocPath + OptFname);
killToolProcess;
@ -243,6 +246,7 @@ begin
if Value and fAutoRefresh then
callToolProcess;
end;
{$ENDREGION}
{$REGION ICEEditableOptions ----------------------------------------------------}
@ -256,7 +260,8 @@ begin
widg.singleClickSelect := fSingleClick;
widg.autoRefresh := fAutoRefresh;
end
else inherited;
else
inherited;
end;
procedure TCETodoOptions.Assign(Src: TPersistent);
@ -269,7 +274,8 @@ begin
fSingleClick := widg.singleClickSelect;
fAutoRefresh := widg.autoRefresh;
end
else inherited;
else
inherited;
end;
function TCETodoListWidget.optionedWantCategory(): string;
@ -290,9 +296,11 @@ end;
procedure TCETodoListWidget.optionedEvent(anEvent: TOptionEditorEvent);
begin
if anEvent <> oeeAccept then exit;
if anEvent <> oeeAccept then
exit;
fOptions.AssignTo(self);
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ---------------------------------------------------}
@ -302,7 +310,8 @@ end;
procedure TCETodoListWidget.docFocused(aDoc: TCESynMemo);
begin
if aDoc = fDoc then exit;
if aDoc = fDoc then
exit;
fDoc := aDoc;
if Visible and fAutoRefresh then
callToolProcess;
@ -314,11 +323,13 @@ end;
procedure TCETodoListWidget.docClosing(aDoc: TCESynMemo);
begin
if fDoc <> aDoc then exit;
if fDoc <> aDoc then
exit;
fDoc := nil;
if Visible and fAutoRefresh then
callToolProcess;
end;
{$ENDREGION}
{$REGION ICEProjectObserver ----------------------------------------------------}
@ -329,14 +340,16 @@ end;
procedure TCETodoListWidget.projChanged(aProject: TCEProject);
begin
if fProj <> aProject then exit;
if fProj <> aProject then
exit;
if Visible and fAutoRefresh then
callToolProcess;
end;
procedure TCETodoListWidget.projClosing(aProject: TCEProject);
begin
if fProj <> aProject then exit;
if fProj <> aProject then
exit;
fProj := nil;
if Visible and fAutoRefresh then
callToolProcess;
@ -344,7 +357,8 @@ end;
procedure TCETodoListWidget.projFocused(aProject: TCEProject);
begin
if aProject = fProj then exit;
if aProject = fProj then
exit;
fProj := aProject;
if Visible and fAutoRefresh then
callToolProcess;
@ -353,22 +367,29 @@ end;
procedure TCETodoListWidget.projCompiling(aProject: TCEProject);
begin
end;
{$ENDREGION}
{$REGION Todo list things ------------------------------------------------------}
function TCETodoListWidget.getContext: TTodoContext;
begin
if ((fProj = nil) and (fDoc = nil)) then exit(tcNone);
if ((fProj = nil) and (fDoc <> nil)) then exit(tcFile);
if ((fProj <> nil) and (fDoc = nil)) then exit(tcProject);
if ((fProj = nil) and (fDoc = nil)) then
exit(tcNone);
if ((fProj = nil) and (fDoc <> nil)) then
exit(tcFile);
if ((fProj <> nil) and (fDoc = nil)) then
exit(tcProject);
//
if fProj.isProjectSource(fDoc.fileName) then
exit(tcProject) else exit(tcFile);
exit(tcProject)
else
exit(tcFile);
end;
procedure TCETodoListWidget.killToolProcess;
begin
if fToolProc = nil then exit;
if fToolProc = nil then
exit;
//
fToolProc.Terminate(0);
fToolProc.Free;
@ -380,9 +401,11 @@ var
ctxt: TTodoContext;
begin
clearTodoList;
if not exeInSysPath(ToolExeName) then exit;
if not exeInSysPath(ToolExeName) then
exit;
ctxt := getContext;
if ctxt = tcNone then exit;
if ctxt = tcNone then
exit;
//
killToolProcess;
// process parameter
@ -395,13 +418,15 @@ begin
fToolProc.OnReadData := @toolOutputData;
// files passed to the tool argument
if ctxt = tcProject then fToolProc.Parameters.AddText(symbolExpander.get('<CPFS>'))
else fToolProc.Parameters.Add(symbolExpander.get('<CFF>'));
if ctxt = tcProject then
fToolProc.Parameters.AddText(symbolExpander.get('<CPFS>'))
else
fToolProc.Parameters.Add(symbolExpander.get('<CFF>'));
//
fToolProc.Execute;
end;
procedure TCETodoListWidget.procOutputDbg(sender: TObject);
procedure TCETodoListWidget.procOutputDbg(Sender: TObject);
var
str: TStringList;
msg: string;
@ -412,22 +437,23 @@ begin
try
processOutputToStrings(fToolProc, str);
ctxt := getContext;
for msg in str do case ctxt of
for msg in str do
case ctxt of
tcNone: fMsgs.message(msg, nil, amcMisc, amkAuto);
tcFile: fMsgs.message(msg, fDoc, amcEdit, amkAuto);
tcProject:fMsgs.message(msg, fProj, amcProj, amkAuto);
tcProject: fMsgs.message(msg, fProj, amcProj, amkAuto);
end;
finally
str.Free;
end;
end;
procedure TCETodoListWidget.toolOutputData(sender: TObject);
procedure TCETodoListWidget.toolOutputData(Sender: TObject);
begin
processOutputToStream(fToolProc, fToolOutput);
end;
procedure TCETodoListWidget.toolTerminated(sender: TObject);
procedure TCETodoListWidget.toolTerminated(Sender: TObject);
begin
processOutputToStream(fToolProc, fToolOutput);
fToolOutput.Position := 0;
@ -454,46 +480,54 @@ var
flt: string;
begin
lstItems.Clear;
lstItems.Column[1].Visible:=false;
lstItems.Column[2].Visible:=false;
lstItems.Column[3].Visible:=false;
lstItems.Column[4].Visible:=false;
lstItems.Column[1].Visible := False;
lstItems.Column[2].Visible := False;
lstItems.Column[3].Visible := False;
lstItems.Column[4].Visible := False;
flt := lstfilter.Text;
for i:= 0 to fTodos.count -1 do begin
for i := 0 to fTodos.Count - 1 do
begin
src := fTodos[i];
trg := lstItems.Items.Add;
trg.Data := src;
trg.Caption := src.text;
trg.Caption := src.Text;
trg.SubItems.Add(src.category);
trg.SubItems.Add(src.assignee);
trg.SubItems.Add(src.status);
trg.SubItems.Add(src.priority);
//
if flt <> '' then if flt <> '(filter)' then
if not AnsiContainsText(src.text,flt) then
if not AnsiContainsText(src.category,flt) then
if not AnsiContainsText(src.assignee,flt) then
if not AnsiContainsText(src.status,flt) then
if not AnsiContainsText(src.priority,flt) then
if flt <> '' then
if flt <> '(filter)' then
if not AnsiContainsText(src.Text, flt) then
if not AnsiContainsText(src.category, flt) then
if not AnsiContainsText(src.assignee, flt) then
if not AnsiContainsText(src.status, flt) then
if not AnsiContainsText(src.priority, flt) then
begin
lstItems.Items.Delete(trg.Index);
continue;
end;
//
if src.category <> '' then lstItems.Column[1].Visible := true;
if src.assignee <> '' then lstItems.Column[2].Visible := true;
if src.status <> '' then lstItems.Column[3].Visible := true;
if src.priority <> '' then lstItems.Column[4].Visible := true;
if src.category <> '' then
lstItems.Column[1].Visible := True;
if src.assignee <> '' then
lstItems.Column[2].Visible := True;
if src.status <> '' then
lstItems.Column[3].Visible := True;
if src.priority <> '' then
lstItems.Column[4].Visible := True;
end;
end;
procedure TCETodoListWidget.handleListClick(Sender: TObject);
var
itm : TTodoItem;
fname, ln : string;
itm: TTodoItem;
fname, ln: string;
begin
if lstItems.Selected = nil then exit;
if lstItems.Selected.Data = nil then exit;
if lstItems.Selected = nil then
exit;
if lstItems.Selected.Data = nil then
exit;
// the collection will be cleared if a file is opened
// docFocused->callToolProcess->fTodos....clear
// so line and filename must be copied
@ -502,8 +536,9 @@ begin
ln := itm.line;
getMultiDocHandler.openDocument(fname);
//
if fDoc = nil then exit;
fDoc.CaretY := strToInt(ln);
if fDoc = nil then
exit;
fDoc.CaretY := StrToInt(ln);
fDoc.SelectLine;
end;
@ -513,25 +548,25 @@ begin
fOptions.autoRefresh := autoRefresh;
end;
procedure TCETodoListWidget.lstItemsColumnClick(Sender : TObject; Column :
TListColumn);
procedure TCETodoListWidget.lstItemsColumnClick(Sender: TObject; Column: TListColumn);
var
curr: TListItem;
begin
if lstItems.Selected = nil then exit;
if lstItems.Selected = nil then
exit;
curr := lstItems.Selected;
//
if lstItems.SortDirection = sdAscending then
lstItems.SortDirection := sdDescending
else lstItems.SortDirection := sdAscending;
else
lstItems.SortDirection := sdAscending;
lstItems.SortColumn := Column.Index;
lstItems.Selected := nil;
lstItems.Selected := curr;
lstItems.Update;
end;
procedure TCETodoListWidget.lstItemsCompare(Sender : TObject; item1, item2:
TListItem;Data : Integer; var Compare : Integer);
procedure TCETodoListWidget.lstItemsCompare(Sender: TObject; item1, item2: TListItem; Data: Integer; var Compare: Integer);
var
txt1, txt2: string;
col: Integer;
@ -543,21 +578,25 @@ begin
begin
txt1 := item1.Caption;
txt2 := item2.Caption;
end else
end
else
begin
if col < item1.SubItems.Count then txt1 := item1.SubItems.Strings[col];
if col < item2.SubItems.Count then txt2 := item2.SubItems.Strings[col];
if col < item1.SubItems.Count then
txt1 := item1.SubItems.Strings[col];
if col < item2.SubItems.Count then
txt2 := item2.SubItems.Strings[col];
end;
Compare := AnsiCompareStr(txt1, txt2);
if lstItems.SortDirection = sdDescending then Compare := -Compare;
if lstItems.SortDirection = sdDescending then
Compare := -Compare;
end;
procedure TCETodoListWidget.btnRefreshClick(sender: TObject);
procedure TCETodoListWidget.btnRefreshClick(Sender: TObject);
begin
callToolProcess;
end;
procedure TCETodoListWidget.filterItems(sender: TObject);
procedure TCETodoListWidget.filterItems(Sender: TObject);
begin
fillTodoList;
end;
@ -565,10 +604,12 @@ end;
procedure TCETodoListWidget.setSingleClick(aValue: boolean);
begin
fSingleClick := aValue;
if fSingleClick then begin
if fSingleClick then
begin
lstItems.OnClick := @handleListClick;
lstItems.OnDblClick := nil;
end else
end
else
begin
lstItems.OnClick := nil;
lstItems.OnDblClick := @handleListClick;
@ -578,10 +619,11 @@ end;
procedure TCETodoListWidget.setAutoRefresh(aValue: boolean);
begin
fAutoRefresh := aValue;
mnuAutoRefresh.Checked:= aValue;
if fAutoRefresh then callToolProcess;
mnuAutoRefresh.Checked := aValue;
if fAutoRefresh then
callToolProcess;
end;
{$ENDREGION}
end.

100
src/ce_tools.pas
View File

@ -5,7 +5,7 @@ unit ce_tools;
interface
uses
Classes, SysUtils, FileUtil, process, menus,
Classes, SysUtils, FileUtil, process, Menus,
ce_common, ce_writableComponent, ce_interfaces, ce_observer, ce_inspectors;
type
@ -28,8 +28,8 @@ type
procedure setParameters(aValue: TStringList);
procedure setChainBefore(aValue: TStringList);
procedure setChainAfter(aValue: TStringList);
procedure processOutput(sender: TObject);
procedure execute;
procedure processOutput(Sender: TObject);
procedure Execute;
published
property toolAlias: string read fToolAlias write fToolAlias;
property options: TProcessOptions read fOpts write fOpts;
@ -43,8 +43,8 @@ type
property chainAfter: TStringList read fChainAfter write setChainAfter;
property shortcut: TShortcut read fShortcut write fShortcut;
public
constructor create(ACollection: TCollection); override;
destructor destroy; override;
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
end;
TCETools = class(TWritableLfmTextComponent, ICEMainMenuProvider, ICEEditableShortcut)
@ -56,7 +56,7 @@ type
//
procedure menuDeclare(item: TMenuItem);
procedure menuUpdate(item: TMenuItem);
procedure executeToolFromMenu(sender: TObject);
procedure executeToolFromMenu(Sender: TObject);
//
function scedWantFirst: boolean;
function scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
@ -64,8 +64,8 @@ type
published
property tools: TCollection read fTools write setTools;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
//
function addTool: TCEToolItem;
procedure executeTool(aTool: TCEToolItem); overload;
@ -81,22 +81,22 @@ var
implementation
uses
ce_symstring, dialogs;
ce_symstring, Dialogs;
const
toolsFname = 'tools.txt';
{$REGION TCEToolItem -----------------------------------------------------------}
constructor TCEToolItem.create(ACollection: TCollection);
constructor TCEToolItem.Create(ACollection: TCollection);
begin
inherited;
fToolAlias := format('<tool %d>', [ID]);
fParameters := TStringList.create;
fParameters := TStringList.Create;
fChainBefore := TStringList.Create;
fChainAfter := TStringList.Create;
end;
destructor TCEToolItem.destroy;
destructor TCEToolItem.Destroy;
begin
fParameters.Free;
fChainAfter.Free;
@ -130,7 +130,7 @@ begin
fChainAfter.Delete(i);
end;
procedure TCEToolItem.execute;
procedure TCEToolItem.Execute;
var
i: Integer;
prms: string;
@ -141,8 +141,8 @@ begin
getMessageDisplay(fMsgs).clearByContext(amcMisc);
//
fProcess := TCheckedAsyncProcess.Create(nil);
fProcess.OnReadData:= @processOutput;
fProcess.OnTerminate:= @processOutput;
fProcess.OnReadData := @processOutput;
fProcess.OnTerminate := @processOutput;
fProcess.Options := fOpts;
fProcess.Executable := symbolExpander.get(fExecutable);
fProcess.ShowWindow := fShowWin;
@ -151,14 +151,15 @@ begin
begin
prms := '';
if InputQuery('Parameters', '', prms) then
if prms <> '' then fProcess.Parameters.DelimitedText := symbolExpander.get(prms);
if prms <> '' then
fProcess.Parameters.DelimitedText := symbolExpander.get(prms);
end;
for i:= 0 to fParameters.Count-1 do
for i := 0 to fParameters.Count - 1 do
fProcess.Parameters.AddText(symbolExpander.get(fParameters.Strings[i]));
fProcess.Execute;
end;
procedure TCEToolItem.processOutput(sender: TObject);
procedure TCEToolItem.processOutput(Sender: TObject);
var
lst: TStringList;
str: string;
@ -173,22 +174,24 @@ begin
lst.Free;
end;
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION Standard Comp/Obj -----------------------------------------------------}
constructor TCETools.create(aOwner: TComponent);
constructor TCETools.Create(aOwner: TComponent);
var
fname: string;
begin
inherited;
fTools := TCollection.Create(TCEToolItem);
fname := getCoeditDocPath + toolsFname;
if fileExists(fname) then loadFromFile(fname);
if fileExists(fname) then
loadFromFile(fname);
//
EntitiesConnector.addObserver(self);
end;
destructor TCETools.destroy;
destructor TCETools.Destroy;
begin
EntitiesConnector.removeObserver(self);
//
@ -197,12 +200,13 @@ begin
fTools.Free;
inherited;
end;
{$ENDREGION}
{$REGION ICEMainMenuProvider ---------------------------------------------------}
procedure TCETools.executeToolFromMenu(sender: TObject);
procedure TCETools.executeToolFromMenu(Sender: TObject);
begin
executeTool(TCEToolItem(TMenuItem(sender).tag));
executeTool(TCEToolItem(TMenuItem(Sender).tag));
end;
procedure TCETools.menuDeclare(item: TMenuItem);
@ -211,16 +215,17 @@ var
itm: TMenuItem;
colitm: TCEToolItem;
begin
if tools.Count = 0 then exit;
if tools.Count = 0 then
exit;
//
item.Caption := 'Custom tools';
item.Clear;
for i := 0 to tools.Count-1 do
for i := 0 to tools.Count - 1 do
begin
colitm := tool[i];
//
itm := TMenuItem.Create(item);
itm.ShortCut:= colitm.shortcut;
itm.ShortCut := colitm.shortcut;
itm.Caption := colitm.toolAlias;
itm.tag := ptrInt(colitm);
itm.onClick := @executeToolFromMenu;
@ -234,10 +239,12 @@ var
colitm: TCEToolItem;
mnuitm: TMenuItem;
begin
if item = nil then exit;
if item = nil then
exit;
if item.Count <> tools.Count then
menuDeclare(item)
else for i:= 0 to tools.Count-1 do
else
for i := 0 to tools.Count - 1 do
begin
colitm := tool[i];
mnuitm := item.Items[i];
@ -250,37 +257,41 @@ begin
mnuitm.shortcut := colitm.shortcut;
end;
end;
{$ENDREGION}
{$REGION ICEEditableShortcut ---------------------------------------------------}
function TCETools.scedWantFirst: boolean;
begin
result := fTools.Count > 0;
Result := fTools.Count > 0;
fShctCount := 0;
end;
function TCETools.scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
begin
category := 'Tools';
identifier:= tool[fShctCount].toolAlias;
identifier := tool[fShctCount].toolAlias;
aShortcut := tool[fShctCount].shortcut;
//
fShctCount += 1;
result := fShctCount < fTools.Count;
Result := fShctCount < fTools.Count;
end;
procedure TCETools.scedSendItem(const category, identifier: string; aShortcut: TShortcut);
var
i: Integer;
begin
if category <> 'Tools' then exit;
if category <> 'Tools' then
exit;
//
for i := 0 to tools.Count-1 do if tool[i].toolAlias = identifier then
for i := 0 to tools.Count - 1 do
if tool[i].toolAlias = identifier then
begin
tool[i].shortcut := aShortcut;
break;
end;
end;
{$ENDREGION}
{$REGION Tools things ----------------------------------------------------------}
@ -291,12 +302,12 @@ end;
function TCETools.getTool(index: Integer): TCEToolItem;
begin
result := TCEToolItem(fTools.Items[index]);
Result := TCEToolItem(fTools.Items[index]);
end;
function TCETools.addTool: TCEToolItem;
begin
result := TCEToolItem(fTools.Add);
Result := TCEToolItem(fTools.Add);
end;
procedure TCETools.executeTool(aTool: TCEToolItem);
@ -304,7 +315,8 @@ var
nme: string;
chained: TCollectionItem;
begin
if aTool = nil then exit;
if aTool = nil then
exit;
if not exeInSysPath(aTool.executable) then
if (aTool.chainAfter.Count = 0) and (aTool.chainBefore.Count = 0) then
exit;
@ -312,28 +324,32 @@ begin
for chained in fTools do
if TCEToolItem(chained).toolAlias = nme then
if TCEToolItem(chained).toolAlias <> aTool.toolAlias then
TCEToolItem(chained).execute;
TCEToolItem(chained).Execute;
if exeInSysPath(aTool.executable) then
aTool.execute;
aTool.Execute;
for nme in aTool.chainAfter do
for chained in fTools do
if TCEToolItem(chained).toolAlias = nme then
if TCEToolItem(chained).toolAlias <> aTool.toolAlias then
TCEToolItem(chained).execute;
TCEToolItem(chained).Execute;
end;
procedure TCETools.executeTool(aToolIndex: Integer);
begin
if aToolIndex < 0 then exit;
if aToolIndex > fTools.Count-1 then exit;
if aToolIndex < 0 then
exit;
if aToolIndex > fTools.Count - 1 then
exit;
//
executeTool(tool[aToolIndex]);
end;
{$ENDREGION}
initialization
RegisterClasses([TCEToolItem, TCETools]);
CustomTools := TCETools.create(nil);
CustomTools := TCETools.Create(nil);
finalization
CustomTools.Free;
end.

29
src/ce_toolseditor.pas
View File

@ -34,18 +34,19 @@ type
procedure rebuildToolList;
procedure updateToolList;
public
constructor create(aOwner: TComponent); override;
constructor Create(aOwner: TComponent); override;
end;
implementation
{$R *.lfm}
constructor TCEToolsEditorWidget.create(aOwner: TComponent);
constructor TCEToolsEditorWidget.Create(aOwner: TComponent);
var
png: TPortableNetworkGraphic;
begin
inherited;
propsEd.CheckboxForBoolean := true;
propsEd.CheckboxForBoolean := True;
png := TPortableNetworkGraphic.Create;
try
png.LoadFromLazarusResource('arrow_up');
@ -59,7 +60,7 @@ begin
png.LoadFromLazarusResource('application_flash');
btnRun.Glyph.Assign(png);
finally
png.free;
png.Free;
end;
rebuildToolList;
end;
@ -77,7 +78,7 @@ begin
clearInspector;
lstTools.Clear;
//
for i := 0 to CustomTools.tools.Count-1 do
for i := 0 to CustomTools.tools.Count - 1 do
lstTools.AddItem(CustomTools[i].toolAlias, nil);
if lstTools.Count > 0 then
lstTools.ItemIndex := 0;
@ -87,12 +88,11 @@ procedure TCEToolsEditorWidget.updateToolList;
var
i: Integer;
begin
for i := 0 to CustomTools.tools.Count-1 do
for i := 0 to CustomTools.tools.Count - 1 do
lstTools.Items.Strings[i] := CustomTools[i].toolAlias;
end;
procedure TCEToolsEditorWidget.lstToolsSelectionChange(Sender: TObject;
User: boolean);
procedure TCEToolsEditorWidget.lstToolsSelectionChange(Sender: TObject; User: boolean);
begin
if lstTools.ItemIndex = -1 then
exit;
@ -124,8 +124,10 @@ end;
procedure TCEToolsEditorWidget.btnMoveUpClick(Sender: TObject);
begin
if lstTools.ItemIndex = -1 then exit;
if lstTools.ItemIndex = 0 then exit;
if lstTools.ItemIndex = -1 then
exit;
if lstTools.ItemIndex = 0 then
exit;
//
CustomTools.tools.Exchange(lstTools.ItemIndex, lstTools.ItemIndex - 1);
lstTools.ItemIndex := lstTools.ItemIndex - 1;
@ -134,8 +136,10 @@ end;
procedure TCEToolsEditorWidget.btnMoveDownClick(Sender: TObject);
begin
if lstTools.ItemIndex = -1 then exit;
if lstTools.ItemIndex = lstTools.Items.Count-1 then exit;
if lstTools.ItemIndex = -1 then
exit;
if lstTools.ItemIndex = lstTools.Items.Count - 1 then
exit;
//
CustomTools.tools.Exchange(lstTools.ItemIndex, lstTools.ItemIndex + 1);
lstTools.ItemIndex := lstTools.ItemIndex + 1;
@ -160,4 +164,3 @@ begin
end;
end.

73
src/ce_txtsyn.pas
View File

@ -30,10 +30,10 @@ type
property textAttributes: TSynHighlighterAttributes read fTxtAttribs write setTxtAttribs;
property whitAttributes: TSynHighlighterAttributes read fWhiAttribs write setWhiAttribs;
public
constructor create(aOwner: TComponent); override;
constructor Create(aOwner: TComponent); override;
//
procedure setLine(const NewValue: String; LineNumber: Integer); override;
procedure next; override;
procedure Next; override;
procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override;
function GetTokenAttribute: TSynHighlighterAttributes; override;
function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override;
@ -45,7 +45,8 @@ type
property CurrIdent: string read fCurrIdent write setCurrIdent;
end;
const txtSym : TCharSet = [
const
txtSym: TCharSet = [
'&', '~', '#', '"', #39, '(', '-', ')', '=',
'{', '[', '|', '`', '\', '^', '@', ']', '}',
'+', '$', '*', '%',
@ -56,10 +57,10 @@ implementation
uses
Graphics;
constructor TSynTxtSyn.create(aOwner: TComponent);
constructor TSynTxtSyn.Create(aOwner: TComponent);
begin
inherited;
SetSubComponent(true);
SetSubComponent(True);
//
fSymAttribs := TSynHighlighterAttributes.Create('Symbols', 'Symbols');
fTxtAttribs := TSynHighlighterAttributes.Create('Text', 'Text');
@ -99,11 +100,13 @@ end;
procedure TSynTxtSyn.setCurrIdent(const aValue: string);
begin
if aValue = '' then exit;
if fCurrIdent = aValue then Exit;
if aValue = '' then
exit;
if fCurrIdent = aValue then
Exit;
fCurrIdent := aValue;
BeginUpdate;
fUpdateChange := true;
fUpdateChange := True;
EndUpdate;
end;
@ -112,16 +115,17 @@ begin
inherited;
fLineBuf := NewValue + #10;
fTokStop := 1;
next;
Next;
end;
procedure TSynTxtSyn.next;
procedure TSynTxtSyn.Next;
begin
fTokStart := fTokStop;
fTokStop := fTokStart;
// EOL
if fTokStop > length(fLineBuf) then exit;
if fTokStop > length(fLineBuf) then
exit;
// spaces
if (isWhite(fLineBuf[fTokStop])) then
@ -130,7 +134,8 @@ begin
while isWhite(fLineBuf[fTokStop]) do
begin
Inc(fTokStop);
if fTokStop > length(fLineBuf) then exit;
if fTokStop > length(fLineBuf) then
exit;
end;
exit;
end;
@ -139,10 +144,11 @@ begin
if (fLineBuf[fTokStop] in txtSym) then
begin
fToken := tkSym;
while(fLineBuf[fTokStop] in txtSym) do
while (fLineBuf[fTokStop] in txtSym) do
begin
Inc(fTokStop);
if fLineBuf[fTokStop] = #10 then exit;
if fLineBuf[fTokStop] = #10 then
exit;
end;
exit;
end;
@ -152,37 +158,40 @@ begin
while not ((fLineBuf[fTokStop] in txtSym) or isWhite(fLineBuf[fTokStop])) do
begin
Inc(fTokStop);
if fLineBuf[fTokStop] = #10 then exit;
if fLineBuf[fTokStop] = #10 then
exit;
end;
if fLineBuf[fTokStop] = #10 then exit;
if fLineBuf[fTokStop] = #10 then
exit;
end;
function TSynTxtSyn.GetEol: Boolean;
begin
result := fTokStop > length(fLineBuf);
Result := fTokStop > length(fLineBuf);
end;
function TSynTxtSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
result := fTokToAttri[fToken];
result.FrameEdges := sfeNone;
Result := fTokToAttri[fToken];
Result.FrameEdges := sfeNone;
if fCurrIdent <> '' then
if GetToken = fCurrIdent then begin
result.FrameColor := result.Foreground;
result.FrameStyle := slsSolid;
result.FrameEdges := sfeAround;
if GetToken = fCurrIdent then
begin
Result.FrameColor := Result.Foreground;
Result.FrameStyle := slsSolid;
Result.FrameEdges := sfeAround;
end;
end;
function TSynTxtSyn.GetTokenPos: Integer;
begin
result := fTokStart - 1;
Result := fTokStart - 1;
end;
function TSynTxtSyn.GetToken: string;
begin
result := copy(fLineBuf, FTokStart, fTokStop - FTokStart);
Result := copy(fLineBuf, FTokStart, fTokStop - FTokStart);
end;
procedure TSynTxtSyn.GetTokenEx(out TokenStart: PChar; out TokenLength: integer);
@ -197,9 +206,14 @@ var
begin
Result := SYN_ATTR_IDENTIFIER;
a := GetTokenAttribute;
if a = fTxtAttribs then Result := SYN_ATTR_IDENTIFIER else
if a = fWhiAttribs then Result := SYN_ATTR_WHITESPACE else
if a = fSymAttribs then Result := SYN_ATTR_SYMBOL;
if a = fTxtAttribs then
Result := SYN_ATTR_IDENTIFIER
else
if a = fWhiAttribs then
Result := SYN_ATTR_WHITESPACE
else
if a = fSymAttribs then
Result := SYN_ATTR_SYMBOL;
end;
function TSynTxtSyn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
@ -211,7 +225,8 @@ begin
SYN_ATTR_STRING: Result := fTxtAttribs;
SYN_ATTR_WHITESPACE: Result := fWhiAttribs;
SYN_ATTR_SYMBOL: Result := fSymAttribs;
else Result := fTxtAttribs;
else
Result := fTxtAttribs;
end;
end;

87
src/ce_widget.pas
View File

@ -14,6 +14,7 @@ type
* Base type for an UI module.
*)
PTCEWidget = ^TCEWidget;
TCEWidget = class(TForm, ICEContextualActions, ICESessionOptionsObserver)
Content: TPanel;
Back: TPanel;
@ -59,8 +60,8 @@ type
property updaterByLoopInterval: Integer read fLoopInter write setLoopInt;
property updaterByDelayDuration: Integer read fDelayDur write setDelayDur;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
// restarts the wait period to the delayed update event.
// if not re-called during 'updaterByDelayDuration' ms then
// 'UpdateByDelay' is called once.
@ -108,22 +109,23 @@ type
property current: TCEWidget read getCurrent;
end;
operator enumerator(aWidgetList: TCEWidgetList): TWidgetEnumerator;
operator enumerator(aWidgetList: TCEWidgetList): TWidgetEnumerator;
implementation
{$R *.lfm}
uses
ce_observer;
{$REGION Standard Comp/Obj------------------------------------------------------}
constructor TCEWidget.create(aOwner: TComponent);
constructor TCEWidget.Create(aOwner: TComponent);
var
i: Integer;
itm: TmenuItem;
begin
inherited;
fDockable := true;
fDockable := True;
fUpdaterAuto := TTimer.Create(self);
fUpdaterAuto.Interval := 70;
fUpdaterAuto.OnTimer := @updaterAutoProc;
@ -132,7 +134,7 @@ begin
updaterByLoopInterval := 70;
updaterByDelayDuration := 500;
for i := 0 to contextActionCount-1 do
for i := 0 to contextActionCount - 1 do
begin
itm := TMenuItem.Create(self);
itm.Action := contextAction(i);
@ -143,7 +145,7 @@ begin
EntitiesConnector.addObserver(self);
end;
destructor TCEWidget.destroy;
destructor TCEWidget.Destroy;
begin
EntitiesConnector.removeObserver(self);
inherited;
@ -151,8 +153,10 @@ end;
function TCEWidget.getIfModal: boolean;
begin
if isDockable then result := false
else result := fModal;
if isDockable then
Result := False
else
Result := fModal;
end;
{$ENDREGION}
@ -165,8 +169,8 @@ end;
procedure TCEWidget.sesoptDeclareProperties(aFiler: TFiler);
begin
// override rules: inherited must be called. No dots in the property name, property name prefixed with the widget Name
aFiler.DefineProperty(Name + '_updaterByLoopInterval', @optset_LoopInterval, @optget_LoopInterval, true);
aFiler.DefineProperty(Name + '_updaterByDelayDuration', @optset_UpdaterDelay, @optget_UpdaterDelay, true);
aFiler.DefineProperty(Name + '_updaterByLoopInterval', @optset_LoopInterval, @optget_LoopInterval, True);
aFiler.DefineProperty(Name + '_updaterByDelayDuration', @optset_UpdaterDelay, @optget_UpdaterDelay, True);
end;
procedure TCEWidget.sesoptAfterLoad;
@ -192,45 +196,51 @@ procedure TCEWidget.optset_UpdaterDelay(aReader: TReader);
begin
updaterByDelayDuration := aReader.ReadInteger;
end;
{$ENDREGION}
{$REGION ICEContextualActions---------------------------------------------------}
function TCEWidget.contextName: string;
begin
result := '';
Result := '';
end;
function TCEWidget.contextActionCount: integer;
begin
result := 0;
Result := 0;
end;
function TCEWidget.contextAction(index: integer): TAction;
begin
result := nil;
Result := nil;
end;
{$ENDREGION}
{$REGION Updaters---------------------------------------------------------------}
procedure TCEWidget.setDelayDur(aValue: Integer);
begin
if aValue < 100 then aValue := 100;
if fDelayDur = aValue then exit;
if aValue < 100 then
aValue := 100;
if fDelayDur = aValue then
exit;
fDelayDur := aValue;
fUpdaterDelay.Interval := fDelayDur;
end;
procedure TCEWidget.setLoopInt(aValue: Integer);
begin
if aValue < 30 then aValue := 30;
if fLoopInter = aValue then exit;
if aValue < 30 then
aValue := 30;
if fLoopInter = aValue then
exit;
fLoopInter := aValue;
fUpdaterAuto.Interval := fLoopInter;
end;
procedure TCEWidget.IncLoopUpdate;
begin
inc(fLoopUpdateCount);
Inc(fLoopUpdateCount);
end;
procedure TCEWidget.beginImperativeUpdate;
@ -241,25 +251,26 @@ end;
procedure TCEWidget.endImperativeUpdate;
begin
Dec(fImperativeUpdateCount);
if fImperativeUpdateCount > 0 then exit;
fUpdating := true;
if fImperativeUpdateCount > 0 then
exit;
fUpdating := True;
updateImperative;
fUpdating := false;
fUpdating := False;
fImperativeUpdateCount := 0;
end;
procedure TCEWidget.forceImperativeUpdate;
begin
fUpdating := true;
fUpdating := True;
updateImperative;
fUpdating := false;
fUpdating := False;
fImperativeUpdateCount := 0;
end;
procedure TCEWidget.beginDelayedUpdate;
begin
fUpdaterDelay.Enabled := false;
fUpdaterDelay.Enabled := true;
fUpdaterDelay.Enabled := False;
fUpdaterDelay.Enabled := True;
fUpdaterDelay.OnTimer := @updaterLatchProc;
end;
@ -275,18 +286,18 @@ end;
procedure TCEWidget.updaterAutoProc(Sender: TObject);
begin
fUpdating := true;
fUpdating := True;
if fLoopUpdateCount > 0 then
updateLoop;
fLoopUpdateCount := 0;
fUpdating := false;
fUpdating := False;
end;
procedure TCEWidget.updaterLatchProc(Sender: TObject);
begin
fUpdating := true;
fUpdating := True;
updateDelayed;
fUpdating := false;
fUpdating := False;
fUpdaterDelay.OnTimer := nil;
end;
@ -301,12 +312,13 @@ end;
procedure TCEWidget.updateDelayed;
begin
end;
{$ENDREGION}
{$REGION TCEWidgetList----------------------------------------------------------}
function TCEWidgetList.getWidget(index: integer): TCEWidget;
begin
result := PTCEWidget(Items[index])^;
Result := PTCEWidget(Items[index])^;
end;
procedure TCEWidgetList.addWidget(aValue: PTCEWidget);
@ -314,23 +326,24 @@ begin
add(Pointer(aValue));
end;
function TWidgetEnumerator.getCurrent:TCEWidget;
function TWidgetEnumerator.getCurrent: TCEWidget;
begin
result := fList.widget[fIndex];
Result := fList.widget[fIndex];
end;
function TWidgetEnumerator.moveNext: boolean;
begin
Inc(fIndex);
result := fIndex < fList.Count;
Result := fIndex < fList.Count;
end;
operator enumerator(aWidgetList: TCEWidgetList): TWidgetEnumerator;
begin
result := TWidgetEnumerator.Create;
result.fList := aWidgetList;
result.fIndex := -1;
Result := TWidgetEnumerator.Create;
Result.fList := aWidgetList;
Result.fIndex := -1;
end;
{$ENDREGION}
end.

47
src/ce_writablecomponent.pas
View File

@ -48,10 +48,8 @@ type
protected
procedure customLoadFromFile(const aFilename: string); override;
procedure customSaveToFile(const aFilename: string); override;
procedure readerPropNoFound(Reader: TReader; Instance: TPersistent;
var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); virtual;
procedure readerError(Reader: TReader; const Message: string;
var Handled: Boolean); virtual;
procedure readerPropNoFound(Reader: TReader; Instance: TPersistent; var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); virtual;
procedure readerError(Reader: TReader; const Message: string; var Handled: Boolean); virtual;
end;
(**
@ -61,10 +59,8 @@ type
*)
TWritableJsonComponent = class(TCustomWritableComponent)
protected
procedure propertyError(Sender : TObject; AObject : TObject; Info : PPropInfo;
AValue : TJSONData; Error : Exception; Var doContinue : Boolean); virtual;
procedure restoreProperty(Sender : TObject; AObject : TObject; Info : PPropInfo;
AValue : TJSONData; Var Handled : Boolean); virtual;
procedure propertyError(Sender: TObject; AObject: TObject; Info: PPropInfo; AValue: TJSONData; Error: Exception; Var doContinue: Boolean); virtual;
procedure restoreProperty(Sender: TObject; AObject: TObject; Info: PPropInfo; AValue: TJSONData; Var Handled: Boolean); virtual;
procedure customLoadFromFile(const aFilename: string); override;
procedure customSaveToFile(const aFilename: string); override;
end;
@ -95,12 +91,12 @@ end;
procedure TCustomWritableComponent.saveToFile(const aFilename: string);
begin
fHasSaved := true;
fHasSaved := True;
beforeSave;
try
customSaveToFile(aFilename);
except
fHasSaved := false;
fHasSaved := False;
end;
setFilename(aFilename);
afterSave;
@ -108,12 +104,13 @@ end;
procedure TCustomWritableComponent.loadFromFile(const aFilename: string);
begin
fHasLoaded := true;
fHasLoaded := True;
beforeLoad;
setFilename(aFilename);
customLoadFromFile(aFilename);
afterLoad;
end;
{$ENDREGION}
{$REGION TWritableLfmTextComponent ---------------------------------------------}
@ -127,32 +124,29 @@ begin
loadCompFromTxtFile(self, aFilename, @readerPropNoFound, @readerError);
end;
procedure TWritableLfmTextComponent.readerPropNoFound(Reader: TReader; Instance: TPersistent;
var PropName: string; IsPath: boolean; var Handled, Skip: Boolean);
procedure TWritableLfmTextComponent.readerPropNoFound(Reader: TReader; Instance: TPersistent; var PropName: string; IsPath: boolean; var Handled, Skip: Boolean);
begin
Handled := true;
Skip := true;
Handled := True;
Skip := True;
end;
procedure TWritableLfmTextComponent.readerError(Reader: TReader; const Message: string;
var Handled: Boolean);
procedure TWritableLfmTextComponent.readerError(Reader: TReader; const Message: string; var Handled: Boolean);
begin
Handled := true;
fHasLoaded := false;
Handled := True;
fHasLoaded := False;
end;
{$ENDREGION}
{$REGION TWritableJsonComponent ------------------------------------------------}
procedure TWritableJsonComponent.propertyError(Sender : TObject; AObject : TObject; Info : PPropInfo;
AValue : TJSONData; Error : Exception; Var doContinue : Boolean);
procedure TWritableJsonComponent.propertyError(Sender: TObject; AObject: TObject; Info: PPropInfo; AValue: TJSONData; Error: Exception; Var doContinue: Boolean);
begin
doContinue := true;
doContinue := True;
end;
procedure TWritableJsonComponent.restoreProperty(Sender : TObject; AObject : TObject; Info : PPropInfo;
AValue : TJSONData; Var Handled : Boolean);
procedure TWritableJsonComponent.restoreProperty(Sender: TObject; AObject: TObject; Info: PPropInfo; AValue: TJSONData; Var Handled: Boolean);
begin
Handled := true;
Handled := True;
end;
procedure TWritableJsonComponent.customSaveToFile(const aFilename: string);
@ -182,7 +176,7 @@ begin
file_str := TMemoryStream.Create;
json_str := TJSONDeStreamer.Create(nil);
try
json_str.OnPropertyError:= @propertyError;
json_str.OnPropertyError := @propertyError;
json_str.OnRestoreProperty := @restoreProperty;
file_str.LoadFromFile(aFilename);
setLength(json_dat, file_str.Size);
@ -193,6 +187,7 @@ begin
json_str.Free;
end;
end;
{$ENDREGION}
initialization