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"/> <ComponentName Value="CEProcInputWidget"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="ce_procinput"/>
</Unit17> </Unit17>
<Unit18> <Unit18>
<Filename Value="..\src\ce_projconf.pas"/> <Filename Value="..\src\ce_projconf.pas"/>

29
lazproj/coedit.lpr
View File

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

9
src/ce_inspectors.pas
View File

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

50
src/ce_interfaces.pas
View File

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

513
src/ce_main.pas
View File

File diff suppressed because it is too large Load Diff

63
src/ce_optionseditor.pas
View File

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

33
src/ce_procinput.pas
View File

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

168
src/ce_projconf.pas
View File

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

129
src/ce_projinspect.pas
View File

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

102
src/ce_search.pas
View File

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

103
src/ce_shortcutseditor.pas
View File

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

58
src/ce_staticmacro.pas
View File

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

274
src/ce_symlist.pas
View File

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

3
src/ce_synmemo.pas
View File

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

88
src/ce_tools.pas
View File

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

25
src/ce_toolseditor.pas
View File

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

81
src/ce_widget.pas
View File

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

45
src/ce_writablecomponent.pas
View File

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