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

re JCF

This commit is contained in:
Basile Burg 2015-03-10 15:02:53 +01:00
parent f29e57b751
commit 413e4496b2
18 changed files with 1062 additions and 1406 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lazproj/coedit.lpi
View File

@ -230,6 +230,7 @@
<ComponentName Value="CEProcInputWidget"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ce_procinput"/>
</Unit17>
<Unit18>
<Filename Value="..\src\ce_projconf.pas"/>

29
lazproj/coedit.lpr
View File

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

19
src/ce_inspectors.pas
View File

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

102
src/ce_interfaces.pas
View File

@ -5,7 +5,7 @@ unit ce_interfaces;
interface
uses
Classes, SysUtils, ActnList, Menus, process,
Classes, SysUtils, actnList, menus, process,
ce_synmemo, ce_project, ce_observer;
type
@ -14,7 +14,7 @@ type
* An implementer can save and load some stuffs when Coedit starts/quits
*)
ICESessionOptionsObserver = interface
['ICESessionOptionsObserver']
['ICESessionOptionsObserver']
// persistent things are about to be saved.
procedure sesoptBeforeSave;
// persistent things can be declared to aFiler.
@ -22,7 +22,6 @@ type
// persistent things have just been reloaded.
procedure sesoptAfterLoad;
end;
(**
* An implementer gets and gives back some things
*)
@ -37,7 +36,7 @@ type
* An implementer declares some actions on demand.
*)
ICEContextualActions = interface
['ICEContextualActions']
['ICEContextualActions']
// declares a context name for the actions
function contextName: string;
// action count, called before contextAction()
@ -52,7 +51,7 @@ type
* An implementer is informed about the current file(s).
*)
ICEMultiDocObserver = interface
['ICEMultiDocObserver']
['ICEMultiDocObserver']
// aDoc has been created (empty, runnable, project source, ...).
procedure docNew(aDoc: TCESynMemo);
// aDoc is the document being edited.
@ -62,7 +61,6 @@ type
// aDoc is about to be closed.
procedure docClosing(aDoc: TCESynMemo);
end;
(**
* An implementer informs some ICEMultiDocObserver about the current file(s)
*)
@ -77,7 +75,7 @@ type
* An implementer is informed about the current project(s).
*)
ICEProjectObserver = interface
['ICEProjectObserver']
['ICEProjectObserver']
// aProject has been created/opened
procedure projNew(aProject: TCEProject);
// aProject has been modified: switches, source name, ...
@ -89,7 +87,6 @@ type
// aProject is about to be compiled
procedure projCompiling(aProject: TCEProject);
end;
(**
* An implementer informs some ICEProjectObserver about the current project(s)
*)
@ -104,13 +101,12 @@ type
* An implementer can add a main menu entry.
*)
ICEMainMenuProvider = interface
['ICEMainMenuProvider']
['ICEMainMenuProvider']
// item is a new mainMenu entry. item must be filled with the sub-items to be added.
procedure menuDeclare(item: TMenuItem);
// item is the mainMenu entry declared previously. the sub items can be updated, deleted.
procedure menuUpdate(item: TMenuItem);
end;
(**
* An implementer collects and updates its observers menus.
*)
@ -126,7 +122,7 @@ type
* whose shortcuts are automatically handled
*)
ICEActionProvider = interface
['ICEActionProvider']
['ICEActionProvider']
// the action handler will clear the references to the actions collected previously and start collecting if result.
function actHandlerWantRecollect: boolean;
// the action handler starts to collect the actions if result.
@ -136,7 +132,6 @@ type
// the handler update the state of a particular action.
procedure actHandleUpdater(action: TCustomAction);
end;
(**
* An implementer handles its observers actions.
*)
@ -151,7 +146,7 @@ type
* An implementer can expose some customizable shortcuts to be edited in a dedicated widget.
*)
ICEEditableShortCut = interface
['ICEEditableShortCut']
['ICEEditableShortCut']
// a TCEEditableShortCutSubject will start to collect shortcuts if result
function scedWantFirst: boolean;
// a TCEEditableShortCutSubject collects the information on the shortcuts while result
@ -159,7 +154,6 @@ type
// a TCEEditableShortCutSubject sends the possibly modified shortcut
procedure scedSendItem(const category, identifier: string; aShortcut: TShortcut);
end;
(**
* An implementer manages its observers shortcuts.
*)
@ -179,7 +173,7 @@ type
* An implementer can expose some options to be edited in a dedicated widget.
*)
ICEEditableOptions = interface
['ICEEditableOptions']
['ICEEditableOptions']
// the widget wants the category.
function optionedWantCategory(): string;
// the widget wants to know if the options will use a generic editor or a custom form.
@ -189,7 +183,6 @@ type
// the option editor informs that something has happened.
procedure optionedEvent(anEvent: TOptionEditorEvent);
end;
(**
* An implementer displays its observers editable options.
*)
@ -281,13 +274,13 @@ type
procedure subjSesOptsAfterLoad(aSubject: TCESessionOptionsSubject); {$IFDEF RELEASE}inline;{$ENDIF}
{
Service getters:
{
Service getters:
The first overload assign the variable only when not yet set, the second is
designed for a punctual usage, for example if a widget needs the service in
a single and rarely called method.
}
The first overload assign the variable only when not yet set, the second is
designed for a punctual usage, for example if a widget needs the service in
a single and rarely called method.
}
function getMessageDisplay(var obj: ICEMessagesDisplay): ICEMessagesDisplay; overload;
function getMessageDisplay: ICEMessagesDisplay; overload;
@ -310,38 +303,33 @@ procedure subjDocNew(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEMultiDocObserver).docNew(aDoc);
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEMultiDocObserver).docNew(aDoc);
end;
procedure subjDocClosing(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEMultiDocObserver).docClosing(aDoc);
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEMultiDocObserver).docClosing(aDoc);
end;
procedure subjDocFocused(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEMultiDocObserver).docFocused(aDoc);
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEMultiDocObserver).docFocused(aDoc);
end;
procedure subjDocChanged(aSubject: TCEMultiDocSubject; aDoc: TCESynMemo);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEMultiDocObserver).docChanged(aDoc);
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEMultiDocObserver).docChanged(aDoc);
end;
{$ENDREGION}
{$REGION TCEProjectSubject -----------------------------------------------------}
@ -354,47 +342,41 @@ procedure subjProjNew(aSubject: TCEProjectSubject; aProj: TCEProject);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEProjectObserver).ProjNew(aProj);
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEProjectObserver).ProjNew(aProj);
end;
procedure subjProjClosing(aSubject: TCEProjectSubject; aProj: TCEProject);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEProjectObserver).projClosing(aProj);
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEProjectObserver).projClosing(aProj);
end;
procedure subjProjFocused(aSubject: TCEProjectSubject; aProj: TCEProject);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEProjectObserver).projFocused(aProj);
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEProjectObserver).projFocused(aProj);
end;
procedure subjProjChanged(aSubject: TCEProjectSubject; aProj: TCEProject);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEProjectObserver).projChanged(aProj);
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEProjectObserver).projChanged(aProj);
end;
procedure subjProjCompiling(aSubject: TCEProjectSubject; aProj: TCEProject);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICEProjectObserver).projCompiling(aProj);
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICEProjectObserver).projCompiling(aProj);
end;
{$ENDREGION}
{$REGION TCESessionOptionsSubject ----------------------------------------------}
@ -407,29 +389,25 @@ procedure subjSesOptsBeforeSave(aSubject: TCESessionOptionsSubject);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptBeforeSave;
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptBeforeSave;
end;
procedure subjSesOptsDeclareProperties(aSubject: TCESessionOptionsSubject; aFiler: TFiler);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptDeclareProperties(aFiler);
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptDeclareProperties(aFiler);
end;
procedure subjSesOptsAfterLoad(aSubject: TCESessionOptionsSubject);
var
i: Integer;
begin
with aSubject do
for i := 0 to fObservers.Count - 1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptAfterLoad;
with aSubject do for i:= 0 to fObservers.Count-1 do
(fObservers.Items[i] as ICESessionOptionsObserver).sesoptAfterLoad;
end;
{$ENDREGION}
{$REGION Misc subjects ---------------------------------------------------------}
@ -452,7 +430,6 @@ function TCEActionProviderSubject.acceptObserver(aObject: TObject): boolean;
begin
exit(aObject is ICEActionProvider);
end;
{$ENDREGION}
{$REGION ICESingleService getters ----------------------------------------------}
@ -491,7 +468,6 @@ function getMultiDocHandler: ICEMultiDocHandler;
begin
exit(EntitiesConnector.getSingleService('ICEMultiDocHandler') as ICEMultiDocHandler);
end;
{$ENDREGION}
end.

651
src/ce_main.pas
View File

File diff suppressed because it is too large Load Diff

95
src/ce_optionseditor.pas
View File

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

35
src/ce_procinput.pas
View File

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

216
src/ce_projconf.pas
View File

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

157
src/ce_projinspect.pas
View File

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

122
src/ce_search.pas
View File

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

145
src/ce_shortcutseditor.pas
View File

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

88
src/ce_staticmacro.pas
View File

@ -5,7 +5,7 @@ unit ce_staticmacro;
interface
uses
Classes, SysUtils, SynEdit, SynCompletion,
Classes, Sysutils, SynEdit, SynCompletion,
ce_interfaces, ce_writableComponent, ce_synmemo;
type
@ -24,9 +24,9 @@ type
property autoInsert: boolean read fAutoInsert write fAutoInsert;
property macros: TStringList read fMacros write setMacros;
property shortcut: TShortCut read fShortCut write fShortCut;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
procedure Assign(Source: TPersistent); override;
procedure AssignTo(Dest: TPersistent); override;
end;
@ -71,8 +71,8 @@ type
property macros: TStringList read fMacros write setMacros;
property automatic: boolean read fAutomatic write fAutomatic;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
constructor create(aOwner: TComponent); override;
destructor destroy; override;
// execute using the editor
procedure Execute; overload;
// execute in aEditor, according to aToken
@ -106,17 +106,17 @@ const
'$fo=for(auto i = 0; ; )',
'$fe=foreach(elem; )',
'$v=void (){}'
);
);
{$REGION TStaticMacrosOptions --------------------------------------------------}
constructor TStaticMacrosOptions.Create(aOwner: TComponent);
constructor TStaticMacrosOptions.create(aOwner: TComponent);
begin
inherited;
inherited;
fMacros := TStringList.Create;
end;
destructor TStaticMacrosOptions.Destroy;
destructor TStaticMacrosOptions.destroy;
begin
fMacros.Free;
inherited;
@ -127,7 +127,7 @@ var
edmac: TCEStaticEditorMacro;
opt: TStaticMacrosOptions;
begin
if Source is TCEStaticEditorMacro then
if Source is TCEStaticEditorMacro then
begin
edmac := TCEStaticEditorMacro(Source);
//
@ -135,7 +135,7 @@ begin
fMacros.Assign(edmac.fMacros);
fShortCut := edmac.fCompletor.ShortCut;
end
else if Source is TStaticMacrosOptions then
else if Source is TStaticMacrosOptions then
begin
opt := TStaticMacrosOptions(Source);
//
@ -143,8 +143,7 @@ begin
macros.Assign(opt.fMacros);
shortcut := opt.shortcut;
end
else
inherited;
else inherited;
end;
procedure TStaticMacrosOptions.AssignTo(Dest: TPersistent);
@ -152,7 +151,7 @@ var
edmac: TCEStaticEditorMacro;
opt: TStaticMacrosOptions;
begin
if Dest is TCEStaticEditorMacro then
if Dest is TCEStaticEditorMacro then
begin
edmac := TCEStaticEditorMacro(Dest);
//
@ -163,7 +162,7 @@ begin
//
edmac.fCompletor.ShortCut := fShortCut;
end
else if Dest is TStaticMacrosOptions then
else if Dest is TStaticMacrosOptions then
begin
opt := TStaticMacrosOptions(Dest);
//
@ -171,45 +170,42 @@ begin
opt.macros.Assign(fMacros);
opt.shortcut := shortcut;
end
else
inherited;
else inherited;
end;
procedure TStaticMacrosOptions.setMacros(aValue: TStringList);
begin
fMacros.Assign(aValue);
end;
{$ENDREGION}
{$REGION Standard Comp/Obj -----------------------------------------------------}
constructor TCEStaticEditorMacro.Create(aOwner: TComponent);
constructor TCEStaticEditorMacro.create(aOwner: TComponent);
var
fname: string;
begin
inherited;
fAutomatic := True;
fAutomatic := true;
fCompletor := TSynAutoComplete.Create(self);
fCompletor.ShortCut := 8224; // SHIFT + SPACE
fMacros := TStringList.Create;
fMacros.Delimiter := '=';
addDefaults;
//
fOptions := TStaticMacrosOptions.Create(self);
fOptionBackup := TStaticMacrosOptions.Create(self);
fOptions := TStaticMacrosOptions.create(self);
fOptionBackup := TStaticMacrosOptions.create(self);
fname := getCoeditDocPath + OptFname;
if fileExists(fname) then
begin
fOptions.loadFromFile(fname);
// old option file will create a streaming error.
if fOptions.hasLoaded then
fOptions.AssignTo(self)
fOptions.AssignTo(self)
else
fOptions.Assign(self);
fOptions.Assign(self);
end
else
fOptions.Assign(self);
else fOptions.Assign(self);
//
sanitize;
updateCompletor;
@ -217,7 +213,7 @@ begin
EntitiesConnector.addObserver(Self);
end;
destructor TCEStaticEditorMacro.Destroy;
destructor TCEStaticEditorMacro.destroy;
begin
fOptions.saveToFile(getCoeditDocPath + OptFname);
EntitiesConnector.removeObserver(Self);
@ -233,7 +229,6 @@ begin
sanitize;
updateCompletor;
end;
{$ENDREGION}
{$REGION ICEMultiDocObserver ---------------------------------------------------}
@ -245,8 +240,7 @@ end;
procedure TCEStaticEditorMacro.docFocused(aDoc: TCESynMemo);
begin
if fDoc = aDoc then
exit;
if fDoc = aDoc then exit;
fDoc := aDoc;
fCompletor.Editor := fDoc;
end;
@ -263,30 +257,29 @@ begin
exit;
fDoc := nil;
end;
{$ENDREGION}
{$REGION ICEEditableOptions ----------------------------------------------------}
function TCEStaticEditorMacro.optionedWantCategory(): string;
begin
exit('Static macros');
exit('Static macros');
end;
function TCEStaticEditorMacro.optionedWantEditorKind: TOptionEditorKind;
begin
exit(oekGeneric);
exit(oekGeneric);
end;
function TCEStaticEditorMacro.optionedWantContainer: TPersistent;
begin
fOptions.Assign(self);
fOptions.Assign(self);
fOptionBackup.Assign(fOptions);
exit(fOptions);
end;
procedure TCEStaticEditorMacro.optionedEvent(anEvent: TOptionEditorEvent);
begin
case anEvent of
case anEvent of
oeeAccept:
begin
fOptions.AssignTo(self);
@ -300,22 +293,21 @@ begin
oeeChange: fOptions.AssignTo(self);
end;
end;
{$ENDREGION}
{$REGION Macros things ---------------------------------------------------------}
procedure TCEStaticEditorMacro.sanitize;
var
i: Integer;
Text: string;
text: string;
macro: string;
begin
for i := fMacros.Count - 1 downto 0 do
for i := fMacros.Count-1 downto 0 do
begin
Text := fMacros.Strings[i];
if length(Text) >= 4 then
if Text[1] = '$' then
if Pos('=', Text) > 2 then
text := fMacros.Strings[i];
if length(text) >= 4 then
if text[1] = '$' then
if Pos('=', text) > 2 then
begin
macro := fMacros.Names[i];
if (macro[length(macro)] in ['a'..'z', 'A'..'Z', '0'..'9']) then
@ -340,7 +332,7 @@ var
tok, val: string;
begin
fCompletor.AutoCompleteList.Clear;
for i := 0 to fMacros.Count - 1 do
for i := 0 to fMacros.Count-1 do
begin
tok := fMacros.Names[i];
val := fMacros.ValueFromIndex[i];
@ -360,13 +352,11 @@ begin
if aEditor <> nil then
fCompletor.Execute(aToken, aEditor);
end;
{$ENDREGION}
initialization
StaticEditorMacro := TCEStaticEditorMacro.Create(nil);
StaticEditorMacro := TCEStaticEditorMacro.create(nil);
finalization
StaticEditorMacro.Free;
;
StaticEditorMacro.Free;;
end.

504
src/ce_symlist.pas
View File

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

3
src/ce_synmemo.pas
View File

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

136
src/ce_tools.pas
View File

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

29
src/ce_toolseditor.pas
View File

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

89
src/ce_widget.pas
View File

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

47
src/ce_writablecomponent.pas
View File

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