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

29
lazproj/coedit.lpr
View File

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

30
src/ce_cdbcmd.pas
View File

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

401
src/ce_dlang.pas
View File

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

10
src/ce_dockoptions.pas
View File

@ -36,7 +36,7 @@ var
constructor TDockOptionsEditor.Create(TheOwner: TComponent); constructor TDockOptionsEditor.Create(TheOwner: TComponent);
begin begin
inherited; inherited;
fBackup := TXMLConfigStorage.Create('', false); fBackup := TXMLConfigStorage.Create('', False);
Master := AnchorDocking.DockMaster; Master := AnchorDocking.DockMaster;
// //
HeaderAlignLeftTrackBar.OnChange := @doChanged; HeaderAlignLeftTrackBar.OnChange := @doChanged;
@ -112,8 +112,8 @@ begin
end; end;
initialization initialization
DockOptionsEditor := TDockOptionsEditor.create(nil); DockOptionsEditor := TDockOptionsEditor.Create(nil);
finalization
DockOptionsEditor.free;
end.
finalization
DockOptionsEditor.Free;
end.

24
src/ce_editoroptions.pas
View File

@ -74,7 +74,7 @@ type
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
// //
procedure assign(src: TPersistent); override; procedure Assign(src: TPersistent); override;
end; end;
(** (**
@ -123,9 +123,9 @@ begin
fFont.Pitch := fpFixed; fFont.Pitch := fpFixed;
fFont.Size := 10; fFont.Size := 10;
// //
fD2Syn := TSynD2Syn.create(self); fD2Syn := TSynD2Syn.Create(self);
fD2Syn.Assign(D2Syn); fD2Syn.Assign(D2Syn);
fTxtSyn := TSynTxtSyn.create(self); fTxtSyn := TSynTxtSyn.Create(self);
fTxtSyn.Assign(TxtSyn); fTxtSyn.Assign(TxtSyn);
// //
fSelCol := TSynSelectedColor.Create; fSelCol := TSynSelectedColor.Create;
@ -172,7 +172,7 @@ begin
inherited; inherited;
end; end;
procedure TCEEditorOptionsBase.assign(src: TPersistent); procedure TCEEditorOptionsBase.Assign(src: TPersistent);
var var
srcopt: TCEEditorOptionsBase; srcopt: TCEEditorOptionsBase;
begin begin
@ -198,7 +198,8 @@ begin
rightEdge := srcopt.rightEdge; rightEdge := srcopt.rightEdge;
rightEdgeColor := srcopt.rightEdgeColor; rightEdgeColor := srcopt.rightEdgeColor;
end end
else inherited; else
inherited;
end; end;
procedure TCEEditorOptionsBase.setFont(aValue: TFont); procedure TCEEditorOptionsBase.setFont(aValue: TFont);
@ -245,7 +246,8 @@ begin
EntitiesConnector.addObserver(self); EntitiesConnector.addObserver(self);
// //
fname := getCoeditDocPath + edoptFname; fname := getCoeditDocPath + edoptFname;
if fileExists(fname) then loadFromFile(fname); if fileExists(fname) then
loadFromFile(fname);
end; end;
destructor TCEEditorOptions.Destroy; destructor TCEEditorOptions.Destroy;
@ -262,6 +264,7 @@ begin
D2Syn.Assign(fD2Syn); D2Syn.Assign(fD2Syn);
TxtSyn.Assign(fTxtSyn); TxtSyn.Assign(fTxtSyn);
end; end;
{$ENDREGION} {$ENDREGION}
{$REGION ICEMultiDocObserver ----------------------------------------------------} {$REGION ICEMultiDocObserver ----------------------------------------------------}
@ -281,6 +284,7 @@ end;
procedure TCEEditorOptions.docClosing(aDoc: TCESynMemo); procedure TCEEditorOptions.docClosing(aDoc: TCESynMemo);
begin begin
end; end;
{$ENDREGION} {$ENDREGION}
{$REGION ICEEditableOptions ----------------------------------------------------} {$REGION ICEEditableOptions ----------------------------------------------------}
@ -309,7 +313,7 @@ begin
// restores // restores
if anEvent = oeeCancel then if anEvent = oeeCancel then
begin begin
self.assign(fBackup); self.Assign(fBackup);
D2Syn.Assign(fBackup.fD2Syn); D2Syn.Assign(fBackup.fD2Syn);
TxtSyn.Assign(fBackup.fTxtSyn); TxtSyn.Assign(fBackup.fTxtSyn);
end; end;
@ -319,11 +323,12 @@ begin
// new backup values based on accepted values. // new backup values based on accepted values.
if anEvent = oeeAccept then if anEvent = oeeAccept then
begin begin
fBackup.assign(self); fBackup.Assign(self);
fBackup.fD2Syn.Assign(D2Syn); fBackup.fD2Syn.Assign(D2Syn);
fBackup.fTxtSyn.Assign(TxtSyn); fBackup.fTxtSyn.Assign(TxtSyn);
end; end;
end; end;
{$ENDREGION} {$ENDREGION}
{$REGION ICEEditableOptions ----------------------------------------------------} {$REGION ICEEditableOptions ----------------------------------------------------}
@ -356,12 +361,13 @@ begin
anEditor.RightEdge := rightEdge; anEditor.RightEdge := rightEdge;
anEditor.RightEdgeColor := rightEdgeColor; anEditor.RightEdgeColor := rightEdgeColor;
end; end;
{$ENDREGION} {$ENDREGION}
initialization initialization
EditorOptions := TCEEditorOptions.Create(nil); EditorOptions := TCEEditorOptions.Create(nil);
finalization finalization
EditorOptions.Free; EditorOptions.Free;
end. end.

9
src/ce_inspectors.pas
View File

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

50
src/ce_interfaces.pas
View File

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

54
src/ce_libmaneditor.pas
View File

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

513
src/ce_main.pas
View File

File diff suppressed because it is too large Load Diff

34
src/ce_observer.pas
View File

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

12
src/ce_options.pas
View File

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

63
src/ce_optionseditor.pas
View File

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

15
src/ce_plugin.pas
View File

@ -11,6 +11,7 @@ type
TCEHost = type Pointer; TCEHost = type Pointer;
TCEPlugin = type Pointer; TCEPlugin = type Pointer;
const const
// API version // API version
@ -137,6 +138,7 @@ type
// internal -------------------------------------------------------------------- // internal --------------------------------------------------------------------
PPlugDescriptor = ^TPlugDescriptor; PPlugDescriptor = ^TPlugDescriptor;
TPlugDescriptor = record TPlugDescriptor = record
Handle: TLibHandle; Handle: TLibHandle;
Plugin: TCEPlugin; Plugin: TCEPlugin;
@ -152,6 +154,7 @@ type
procedure addPlugin(aValue: PPlugDescriptor); procedure addPlugin(aValue: PPlugDescriptor);
property plugin[index: integer]: TPlugDescriptor read getPlugin; property plugin[index: integer]: TPlugDescriptor read getPlugin;
end; end;
TPlugDescriptorEnumerator = class TPlugDescriptorEnumerator = class
fList: TCEPlugDescriptorList; fList: TCEPlugDescriptorList;
fIndex: Integer; fIndex: Integer;
@ -166,7 +169,7 @@ implementation
function TCEPlugDescriptorList.getPlugin(index: integer): TPlugDescriptor; function TCEPlugDescriptorList.getPlugin(index: integer): TPlugDescriptor;
begin begin
result := TPlugDescriptor(Items[index]^); Result := TPlugDescriptor(Items[index]^);
end; end;
procedure TCEPlugDescriptorList.addPlugin(aValue: PPlugDescriptor); procedure TCEPlugDescriptorList.addPlugin(aValue: PPlugDescriptor);
@ -176,20 +179,20 @@ end;
function TPlugDescriptorEnumerator.getCurrent: TPlugDescriptor; function TPlugDescriptorEnumerator.getCurrent: TPlugDescriptor;
begin begin
result := fList.plugin[fIndex]; Result := fList.plugin[fIndex];
end; end;
function TPlugDescriptorEnumerator.moveNext: boolean; function TPlugDescriptorEnumerator.moveNext: boolean;
begin begin
Inc(fIndex); Inc(fIndex);
result := fIndex < fList.Count; Result := fIndex < fList.Count;
end; end;
operator enumerator(aPlugDescrList: TCEPlugDescriptorList): TPlugDescriptorEnumerator; operator enumerator(aPlugDescrList: TCEPlugDescriptorList): TPlugDescriptorEnumerator;
begin begin
result := TPlugDescriptorEnumerator.Create; Result := TPlugDescriptorEnumerator.Create;
result.fList := aPlugDescrList; Result.fList := aPlugDescrList;
result.fIndex := -1; Result.fIndex := -1;
end; end;
end. end.

33
src/ce_procinput.pas
View File

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

168
src/ce_projconf.pas
View File

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

129
src/ce_projinspect.pas
View File

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

102
src/ce_search.pas
View File

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

103
src/ce_shortcutseditor.pas
View File

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

60
src/ce_staticmacro.pas
View File

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

274
src/ce_symlist.pas
View File

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

100
src/ce_symstring.pas
View File

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

3
src/ce_synmemo.pas
View File

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

192
src/ce_todolist.pas
View File

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

88
src/ce_tools.pas
View File

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

25
src/ce_toolseditor.pas
View File

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

71
src/ce_txtsyn.pas
View File

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

81
src/ce_widget.pas
View File

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

45
src/ce_writablecomponent.pas
View File

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