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

- no license to MIT license 

- protection for empty project compile/run
- widget close bugfix
This commit is contained in:
Basile Burg 2014-06-20 10:12:56 +02:00
parent e41d7a4e72
commit ff1e518e5a
23 changed files with 504 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
LICENSE.txt Normal file
View File

@ -0,0 +1,21 @@
The MIT License (MIT)
Copyright (c) 2014 Basile Burg.
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

51
lazproj/coedit.lpi
View File

@ -34,6 +34,7 @@
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
@ -46,7 +47,6 @@
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
@ -68,7 +68,7 @@
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\src"/>
<OtherUnitFiles Value="..\src;$(LazarusDir)\components\anchordocking"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
@ -126,7 +126,7 @@
<PackageName Value="LCL"/>
</Item5>
</RequiredPackages>
<Units Count="14">
<Units Count="12">
<Unit0>
<Filename Value="coedit.lpr"/>
<IsPartOfProject Value="True"/>
@ -175,55 +175,36 @@
<UnitName Value="ce_d2syn"/>
</Unit6>
<Unit7>
<Filename Value="..\src\ce_project.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="CEProjectWidget"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ce_project"/>
</Unit7>
<Unit8>
<Filename Value="..\src\ce_synmemo.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ce_synmemo"/>
</Unit8>
<Unit9>
</Unit7>
<Unit8>
<Filename Value="..\src\ce_dmdwrap.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ce_dmdwrap"/>
</Unit9>
<Unit10>
<Filename Value="..\src\ce_projconfframe.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="CEProjConfFrame"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="ce_projconfframe"/>
</Unit10>
<Unit11>
</Unit8>
<Unit9>
<Filename Value="..\src\ce_projconf.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="CEProjectConfigurationWidget"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ce_projconf"/>
</Unit11>
<Unit12>
<Filename Value="..\src\ce_projconfall.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="CEProjConfAll"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="ce_projconfall"/>
</Unit12>
<Unit13>
</Unit9>
<Unit10>
<Filename Value="..\src\ce_projinspect.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="CEProjectInspectWidget"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ce_projinspect"/>
</Unit13>
</Unit10>
<Unit11>
<Filename Value="..\src\ce_jsoninfos.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ce_jsoninfos"/>
</Unit11>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -234,7 +215,7 @@
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\src"/>
<OtherUnitFiles Value="..\src;$(LazarusDir)\components\anchordocking"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>

4
lazproj/coedit.lpr
View File

@ -7,8 +7,8 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_widget,
ce_dmdwrap, ce_common, ce_synmemo, ce_main, ce_messages, ce_editor, ce_projinspect,
ce_projconf;
ce_dmdwrap, ce_common, ce_synmemo, ce_main, ce_messages, ce_editor,
ce_projinspect, ce_projconf, ce_jsoninfos, jsonparser;
{$R *.res}

3
lazproj/test/coeditproj/test.coedit
View File

@ -54,11 +54,12 @@ object TCEProject
outputOptions.release = False
outputOptions.unittest = True
outputOptions.versionIdentifier = 'revision_1'
pathsOptions.outputFilename = '..\output\main.exe'
end>
Sources.Strings = (
'..\src\main.d'
'..\src\bar.d'
'..\src\foo.d'
)
ConfigurationIndex = 1
ConfigurationIndex = 0
end

1
lazproj/test/src/bar.d
View File

@ -12,6 +12,5 @@ class Bar{
debug(1) writeln("bar says: debug level < 2");
debug(2) writeln("bar says: debug level < 3");
debug(3) writeln("bar says: debug level < 4");
}
}

1
lazproj/test/src/foo.d
View File

@ -12,6 +12,5 @@ class Foo{
debug(1) writeln("foo says: debug level < 2");
debug(2) writeln("foo says: debug level < 3");
debug(3) writeln("foo says: debug level < 4");
}
}

2
lazproj/test/src/main.d
View File

@ -1,7 +1,7 @@
/*
Test:
- prj save/load
- prj compile
- prj compile/run
- multiples sources
- relative paths
- various switches

2
src/ce_common.pas
View File

@ -303,7 +303,9 @@ begin
Dec(fChangedCount);
if fChangedCount > 0 then
begin
{$IFDEF DEBUG}
writeln('project update count > 0');
{$ENDIF}
exit;
end;
fChangedCount := 0;

6
src/ce_dmdwrap.pas
View File

@ -321,7 +321,7 @@ end;
function TMsgOpts.getOpts: string;
const
DepStr : array[TDepHandling] of string = ('-d ','-dw ', '-de ');
DepStr : array[TDepHandling] of string = ('-d ',''(*-dw*), '-de ');
begin
result := DepStr[fDepHandling];
if fVerb then result += '-v ';
@ -750,8 +750,8 @@ begin
result :=
fDocOpts.getOpts + fDebugOpts.getOpts + fMsgOpts.getOpts
+ fOutputOpts.getOpts + fPathsOpts.getOpts + fOthers.getOpts;
if result[length(result)] = ' ' then
setlength(result, length(result)-1);
if length(result) > 0 then if result[length(result)] = ' ' then
setlength(result, length(result)-1);
end;
procedure TCompilerConfiguration.setName(const aValue: string);

23
src/ce_editor.lfm
View File

@ -1,33 +1,34 @@
inherited CEEditorWidget: TCEEditorWidget
Left = 1098
Left = 1163
Height = 382
Top = 91
Width = 526
BorderIcons = [biSystemMenu, biMinimize, biMaximize]
Width = 461
Caption = 'Source editor'
ClientHeight = 382
ClientWidth = 526
ClientWidth = 461
inherited Back: TPanel
Height = 382
Width = 526
Width = 461
ClientHeight = 382
ClientWidth = 526
ClientWidth = 461
inherited Content: TPanel
Height = 382
Width = 526
Width = 461
BevelOuter = bvRaised
ClientHeight = 382
ClientWidth = 526
ClientWidth = 461
object PageControl: TExtendedNotebook[0]
Left = 3
Height = 351
Top = 3
Width = 520
Width = 455
Align = alClient
BorderSpacing.Around = 2
Images = imgList
TabOrder = 0
OnChange = PageControlChange
Options = [nboShowCloseButtons]
OnCloseTabClicked = PageControlCloseTabClicked
Options = [nboShowCloseButtons, nboShowAddTabButton]
TabDragMode = dmAutomatic
TabDragAcceptMode = dmAutomatic
end
@ -35,7 +36,7 @@ inherited CEEditorWidget: TCEEditorWidget
Left = 3
Height = 23
Top = 356
Width = 520
Width = 455
BorderSpacing.Around = 2
Panels = <
item

30
src/ce_editor.pas
View File

@ -5,7 +5,7 @@ unit ce_editor;
interface
uses
Classes, SysUtils, eventlog, FileUtil, ExtendedNotebook, Forms, Controls,
Classes, SysUtils, FileUtil, ExtendedNotebook, Forms, Controls,
Graphics, SynEditKeyCmds, ComCtrls, SynEditHighlighter, ExtCtrls, Menus,
SynEditHighlighterFoldBase, SynMacroRecorder, SynPluginSyncroEdit, SynEdit,
SynHighlighterLFM, ce_widget, ce_d2syn, ce_synmemo, ce_common;
@ -18,6 +18,7 @@ type
macRecorder: TSynMacroRecorder;
editorStatus: TStatusBar;
procedure PageControlChange(Sender: TObject);
procedure PageControlCloseTabClicked(Sender: TObject);
protected
procedure autoWidgetUpdate; override;
private
@ -27,6 +28,7 @@ type
procedure memoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure memoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure memoChange(Sender: TObject);
procedure memoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function getCurrentEditor: TCESynMemo;
function getEditor(index: NativeInt): TCESynMemo;
function getEditorCount: NativeInt;
@ -34,7 +36,6 @@ type
procedure identifierToD2Syn(const aMemo: TCESynMemo);
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
procedure addEditor;
procedure removeEditor(const aIndex: NativeInt);
//
@ -47,6 +48,9 @@ type
implementation
{$R *.lfm}
uses
ce_main;
constructor TCEEditorWidget.create(aOwner: TComponent);
var
bmp: TBitmap;
@ -63,11 +67,6 @@ begin
end;
end;
destructor TCEEditorWidget.destroy;
begin
inherited;
end;
function TCEEditorWidget.getEditorCount: NativeInt;
begin
result := pageControl.PageCount;
@ -75,7 +74,9 @@ end;
function TCEEditorWidget.getEditorIndex: NativeInt;
begin
result := pageControl.PageIndex;
if pageControl.PageCount > 0 then
result := pageControl.PageIndex
else result := -1;
end;
function TCEEditorWidget.getCurrentEditor: TCESynMemo;
@ -109,6 +110,12 @@ begin
focusedEditorChanged;
end;
procedure TCEEditorWidget.PageControlCloseTabClicked(Sender: TObject);
begin
// closeBtn not implemented
mainForm.actFileClose.Execute;
end;
procedure TCEEditorWidget.addEditor;
var
sheet: TTabSheet;
@ -125,6 +132,7 @@ begin
memo.OnKeyUp := @memoKeyDown;
memo.OnMouseDown := @memoMouseDown;
memo.OnChange := @memoChange;
memo.OnMouseMove := @memoMouseMove;
//
//http://bugs.freepascal.org/view.php?id=26320
focusedEditorChanged;
@ -155,6 +163,12 @@ begin
identifierToD2Syn(TCESynMemo(Sender));
end;
procedure TCEEditorWidget.memoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if ssLeft in Shift then
fNeedAutoUpdate := true;
end;
procedure TCEEditorWidget.memoChange(Sender: TObject);
var
ed: TCESynMemo;

147
src/ce_jsoninfos.pas Normal file
View File

@ -0,0 +1,147 @@
unit ce_jsoninfos;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, jsonparser, fpjson;
type
TJSonLoader = class(TThread)
private
parser: TJSONParser;
public
Filename: string;
Data: TJsonData;
procedure Execute; override;
end;
TDSourceInfo = record
line: integer;
infs: string;
end;
TDSourceInfos = array of TDSourceInfo;
TInfKind = (ikModule, ikImport, ikFunction, ikAlias, ikClass, ikStruct,
ikMixin, ikEnum, ikTemplate);
const
InfKindStr: array[TInfKind] of string = ('module', 'import', 'function', 'alias',
'class', 'structure', 'mixin', 'enum', 'template');
InfKindNonModule = [ikImport..ikTemplate];
type
TJSonInfos = class
private
fFilenames: TStringList;
procedure FilesChanged(Sender: TObject);
procedure scan;
public
fData: array of TJsonData;
constructor create;
destructor destroy; override;
//
function getFileModule(const index: integer): TDSourceInfos;
function getMembers(const aFileIndex, aModuleIndex: integer; const aKind: TInfKind): TDSourceInfos;
property Files: TStringList read fFilenames;
end;
var
JSONInfos: TJSonInfos;
implementation
procedure TJSonLoader.Execute;
var
str: TMemoryStream;
begin
str := TMemoryStream.create;
parser := TJSONParser.Create(str);
try
str.LoadFromFile(Filename);
Data := parser.parse;
finally
str.free;
parser.free;
end;
end;
constructor TJSonInfos.create;
begin
fFilenames := TStringList.Create;
fFilenames.OnChange := @FilesChanged;
end;
destructor TJSonInfos.destroy;
begin
fFilenames.Free;
inherited;
end;
procedure TJSonInfos.FilesChanged(Sender: TObject);
begin
scan;
end;
procedure TJSonInfos.scan;
var
fname: string;
str: TmemoryStream;
begin
setLength(fData,0);
str := tMemoryStream.Create;
for fname in fFilenames do
begin
str.LoadFromFile(fname);
str.Position := 0;
setLength(fData, length(fData)+1);
fData[high(fData)] := GetJSON(str);
end;
end;
function TJSonInfos.getFileModule(const index: integer): TDSourceInfos;
var
memb: TJsonData;
i: nativeInt;
begin
setlength(result,0);
memb := fData[index].GetPath('');
for i := 0 to memb.Count-1 do
begin
if memb.Items[i].GetPath('kind').AsString <> 'module' then continue;
setlength(result, length(result) + 1);
result[high(result)].infs := memb.Items[i].GetPath('name').AsString;
result[high(result)].line := 0;
end;
end;
function TJSonInfos.getMembers(const aFileIndex, aModuleIndex: integer; const aKind: TInfKind): TDSourceInfos;
var
memb: TJsonData;
i: nativeInt;
begin
setlength(result,0);
memb := fData[aFileIndex].items[aModuleIndex].GetPath('members');
for i := 0 to memb.Count-1 do
begin
if memb.Items[i].GetPath('kind').AsString <> InfKindStr[aKind]
then continue;
setlength(result, length(result) + 1);
result[high(result)].infs := memb.Items[i].GetPath('name').AsString;
if (aKind = ikModule) then result[high(result)].line := 0
else result[high(result)].line := memb.Items[i].GetPath('line').AsInt64;
end;
end;
initialization
JSONInfos := TJSonInfos.create;
finalization
JSONInfos.Free;
end.

10
src/ce_main.lfm
View File

@ -1,8 +1,8 @@
object CEMainForm: TCEMainForm
Left = 1098
Left = 1162
Height = 53
Top = 0
Width = 805
Width = 741
AllowDropFiles = True
Caption = 'Coedit'
ChildSizing.Layout = cclLeftToRightThenTopToBottom
@ -10,6 +10,7 @@ object CEMainForm: TCEMainForm
OnDropFiles = FormDropFiles
OnShow = FormShow
Position = poMainFormCenter
ShowHint = True
LCLVersion = '1.2.4.0'
object mainMenu: TMainMenu
Images = imgList
@ -2565,8 +2566,9 @@ object CEMainForm: TCEMainForm
}
end
object ApplicationProperties1: TApplicationProperties
HintPause = 2
HintShortPause = 2
HintHidePause = 1000
HintPause = 25
HintShortPause = 8
left = 96
end
object LfmSyn: TSynLFMSyn

33
src/ce_main.pas
View File

@ -7,9 +7,9 @@ interface
uses
Classes, SysUtils, FileUtil, SynEditKeyCmds, SynHighlighterLFM, Forms,
AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg,
Controls, Graphics, Dialogs, Menus, ActnList, ExtCtrls, process, ce_common,
Controls, Graphics, Dialogs, Menus, ActnList, ExtCtrls, process, ce_jsoninfos, ce_common,
ce_dmdwrap, ce_synmemo, ce_widget, ce_messages, ce_editor, ce_projinspect,
ce_projconf;
ce_projconf, ce_staticexplorer;
type
@ -140,6 +140,7 @@ type
fEditWidg: TCEEditorWidget;
fProjWidg: TCEProjectInspectWidget;
fPrjCfWidg: TCEProjectConfigurationWidget;
fStExpWidg: TCEStaticExplorerWidget;
// widget interfaces subroutines
procedure checkWidgetActions(const aWidget: TCEWidget);
@ -204,11 +205,13 @@ begin
fEditWidg := TCEEditorWidget.create(nil);
fProjWidg := TCEProjectInspectWidget.create(nil);
fPrjCfWidg:= TCEProjectConfigurationWidget.create(nil);
//fStExpWidg:= TCEStaticExplorerWidget.create(nil);
fWidgList.addWidget(@fMesgWidg);
fWidgList.addWidget(@fEditWidg);
fWidgList.addWidget(@fProjWidg);
fWidgList.addWidget(@fPrjCfWidg);
//fWidgList.addWidget(@fStExpWidg);
for widg in fWidgList do widg.Show;
@ -247,6 +250,7 @@ begin
fEditWidg.Free;
fProjWidg.Free;
fPrjCfWidg.Free;
fStExpWidg.Free;
fProject.Free;
//
inherited;
@ -700,12 +704,19 @@ var
dmdproc: TProcess;
olddir, prjpath: string;
const
// option -v causes an hang if poWaitOnExit is included
// option -v causes a hang if poWaitOnExit is included
procopts: array[boolean] of TProcessOptions = (
[poWaitOnExit, poStdErrToOutput, poUsePipes],
[poStdErrToOutput, poUsePipes]
);
begin
if aProject.Sources.Count = 0 then
begin
fMesgWidg.addCeErr( aProject.fileName + ' has no source files' );
exit;
end;
olddir := '';
dmdproc := TProcess.Create(nil);
getDir(0, olddir);
@ -753,7 +764,7 @@ begin
procname := aProject.currentConfiguration.pathsOptions.outputFilename;
if procname <> '' then procname := aProject.getAbsoluteFilename(procname)
else
else if aProject.Sources.Count > 0 then
begin
procname := extractFilename(aProject.Sources.Strings[0]);
procname := procname[1..length(procname)-2];
@ -841,12 +852,15 @@ end;
procedure TCEMainForm.widgetShowFromAction(sender: TObject);
var
widg: TCEWidget;
win: TControl;
begin
widg := TCEWidget( TComponent(sender).tag );
if widg = nil then exit;
if widg.Visible then widg.Hide else widg.Show;
win := DockMaster.GetAnchorSite(widg);
if win = nil then exit;
win.Show;
win.BringToFront;
end;
{$ENDREGION}
{$REGION project ***************************************************************}
@ -953,8 +967,13 @@ begin
end;
procedure TCEMainForm.actProjOptsExecute(Sender: TObject);
var
win: TControl;
begin
fPrjCfWidg.Show;
win := DockMaster.GetAnchorSite(fPrjCfWidg);
if win = nil then exit;
win.Show;
win.BringToFront;
end;
procedure TCEMainForm.actProjSourceExecute(Sender: TObject);

43
src/ce_messages.lfm
View File

@ -1,37 +1,38 @@
inherited CEMessagesWidget: TCEMessagesWidget
Left = 1097
Height = 170
Top = 513
Width = 807
Left = 1163
Height = 172
Top = 511
Width = 741
Caption = 'Messages'
ClientHeight = 170
ClientWidth = 807
ClientHeight = 172
ClientWidth = 741
inherited Back: TPanel
Height = 170
Width = 807
ClientHeight = 170
ClientWidth = 807
Height = 172
Width = 741
ClientHeight = 172
ClientWidth = 741
inherited Content: TPanel
Height = 170
Width = 807
ClientHeight = 170
ClientWidth = 807
Height = 172
Width = 741
ClientHeight = 172
ClientWidth = 741
object List: TListView[0]
Left = 2
Height = 166
Height = 168
Top = 2
Width = 803
Width = 737
Align = alClient
AutoSort = False
AutoWidthLastColumn = True
BorderSpacing.Around = 2
Columns = <
item
Width = 799
Width = 733
end>
HideSelection = False
IconOptions.WrapText = False
MultiSelect = True
ReadOnly = True
RowSelect = True
ShowColumnHeaders = False
SmallImages = imgList
TabOrder = 0
@ -39,7 +40,13 @@ inherited CEMessagesWidget: TCEMessagesWidget
end
end
end
inherited contextMenu: TPopupMenu
left = 8
top = 8
end
object imgList: TImageList[2]
left = 40
top = 8
Bitmap = {
4C69050000001000000010000000CF986200D1996200D1996234D0965DBCCF94
5BFFCE945AFFCE935AFFCE935AFFCE935AFFCE935AFFCE945AFFCF945BFFD096

41
src/ce_messages.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
ExtCtrls, ComCtrls, ce_widget, ActnList, Menus;
ExtCtrls, ComCtrls, ce_widget, ActnList, Menus, clipbrd;
type
@ -17,8 +17,12 @@ type
private
fActClear: TAction;
fActSaveMsg: TAction;
fActCopyMsg: TAction;
fActSelAll: TAction;
procedure actClearExecute(Sender: TObject);
procedure actSaveMsgExecute(Sender: TObject);
procedure actCopyMsgExecute(Sender: TObject);
procedure actSelAllExecute(Sender: TObject);
public
constructor create(aOwner: TComponent); override;
//
@ -57,6 +61,12 @@ begin
fActClear := TAction.Create(self);
fActClear.OnExecute := @actClearExecute;
fActClear.caption := 'Clear messages';
fActCopyMsg := TAction.Create(self);
fActCopyMsg.OnExecute := @actCopyMsgExecute;
fActCopyMsg.Caption := 'Copy message(s)';
fActSelAll := TAction.Create(self);
fActSelAll.OnExecute := @actSelAllExecute;
fActSelAll.Caption := 'Select all';
fActSaveMsg := TAction.Create(self);
fActSaveMsg.OnExecute := @actSaveMsgExecute;
fActSaveMsg.caption := 'Save messages to...';
@ -66,6 +76,12 @@ begin
itm.Action := fActClear;
contextMenu.Items.Add(itm);
itm := TMenuItem.Create(self);
itm.Action := fActCopyMsg;
contextMenu.Items.Add(itm);
itm := TMenuItem.Create(self);
itm.Action := fActSelAll;
contextMenu.Items.Add(itm);
itm := TMenuItem.Create(self);
itm.Action := fActSaveMsg;
contextMenu.Items.Add(itm);
end;
@ -127,14 +143,17 @@ end;
function TCEMessagesWidget.contextActionCount: integer;
begin
result := 2;
result := 4;
end;
function TCEMessagesWidget.contextAction(index: integer): TAction;
begin
case index of
0: result := fActClear;
1: result := fActSaveMsg;
1: result := fActCopyMsg;
2: result := fActSelAll;
3: result := fActSaveMsg;
else result := nil;
end;
end;
@ -143,6 +162,22 @@ begin
List.Clear;
end;
procedure TCEMessagesWidget.actCopyMsgExecute(Sender: TObject);
var
i: NativeInt;
str: string;
begin
str := '';
for i := 0 to List.Items.Count-1 do if List.Items[i].Selected then
str += List.Items[i].Caption + LineEnding;
Clipboard.AsText := str;
end;
procedure TCEMessagesWidget.actSelAllExecute(Sender: TObject);
begin
List.SelectAll;
end;
procedure TCEMessagesWidget.actSaveMsgExecute(Sender: TObject);
var
lst: TStringList;

41
src/ce_projconf.lfm
View File

@ -1,24 +1,24 @@
inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
Left = 1098
Left = 1163
Height = 278
Width = 455
BorderIcons = [biSystemMenu, biMinimize, biMaximize]
Width = 471
Caption = 'Project configuration'
ClientHeight = 278
ClientWidth = 455
ClientWidth = 471
inherited Back: TPanel
Height = 278
Width = 455
Width = 471
ClientHeight = 278
ClientWidth = 455
ClientWidth = 471
inherited Content: TPanel
Height = 278
Width = 455
Width = 471
ClientHeight = 278
ClientWidth = 455
ClientWidth = 471
object Tree: TTreeView[0]
Left = 4
Height = 244
Hint = 'filter configuration elements'
Top = 30
Width = 150
Align = alLeft
@ -52,18 +52,19 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
Left = 2
Height = 24
Top = 2
Width = 451
Width = 467
Align = alTop
BorderSpacing.Around = 2
BevelOuter = bvNone
ClientHeight = 24
ClientWidth = 451
ClientWidth = 467
TabOrder = 1
object selConf: TComboBox
Left = 0
Height = 23
Hint = 'select a configuration'
Top = 1
Width = 360
Width = 376
Align = alClient
BorderSpacing.Top = 1
BorderSpacing.Right = 1
@ -73,8 +74,9 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
TabOrder = 0
end
object btnAddConf: TSpeedButton
Left = 361
Left = 377
Height = 24
Hint = 'add an empty configuration'
Top = 0
Width = 30
Align = alRight
@ -118,8 +120,9 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
ShowCaption = False
end
object btnDelConf: TSpeedButton
Left = 391
Left = 407
Height = 24
Hint = 'remove selected configuration'
Top = 0
Width = 30
Align = alRight
@ -163,8 +166,9 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
ShowCaption = False
end
object btnCloneConf: TSpeedButton
Left = 421
Left = 437
Height = 24
Hint = 'clone selected configuration'
Top = 0
Width = 30
Align = alRight
@ -218,7 +222,7 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
Left = 159
Height = 244
Top = 30
Width = 292
Width = 308
Align = alClient
BorderSpacing.Top = 4
BorderSpacing.Right = 4
@ -234,8 +238,13 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
end
end
end
inherited contextMenu: TPopupMenu
left = 8
top = 240
end
object imgList: TImageList[2]
left = 32
left = 40
top = 240
Bitmap = {
4C690200000010000000100000008D8B89008D8B89008F8D8B008F8D8B008C8A
880092908E00908E8CFF8F8D8BFF908E8CFF92908E008F8D8B008F8D8B008F8D

11
src/ce_projinspect.lfm
View File

@ -32,6 +32,7 @@ inherited CEProjectInspectWidget: TCEProjectInspectWidget
ScrollBars = ssAutoBoth
ShowRoot = False
TabOrder = 0
OnKeyDown = TreeKeyDown
Options = [tvoAutoExpand, tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoToolTips, tvoThemedDraw]
Items.Data = {
F9FFFFFF020002000000000000000000000000000000FFFFFFFF000000000000
@ -53,6 +54,7 @@ inherited CEProjectInspectWidget: TCEProjectInspectWidget
object btnAddFile: TSpeedButton
Left = 0
Height = 24
Hint = 'add a source file to the project'
Top = 0
Width = 28
Align = alLeft
@ -143,6 +145,7 @@ inherited CEProjectInspectWidget: TCEProjectInspectWidget
object btnAddFold: TSpeedButton
Left = 56
Height = 24
Hint = 'add a folder of source to the project'
Top = 0
Width = 28
Align = alLeft
@ -202,6 +205,7 @@ inherited CEProjectInspectWidget: TCEProjectInspectWidget
object btnRemFile: TSpeedButton
Left = 28
Height = 24
Hint = 'remove a source file from the project'
Top = 0
Width = 28
Align = alLeft
@ -246,8 +250,13 @@ inherited CEProjectInspectWidget: TCEProjectInspectWidget
end
end
end
inherited contextMenu: TPopupMenu
left = 8
top = 352
end
object imgList: TImageList[2]
left = 32
left = 40
top = 352
Bitmap = {
4C69040000001000000010000000B3B3B1EFB0B0ADFFAEAEACFFAEAEACFFAEAE
ACFFAFAFACFFAFAFADFFB1B1AFD5B4B4B100B5B5B300B5B5B300B5B5B300B5B5

30
src/ce_projinspect.pas
View File

@ -23,6 +23,7 @@ type
procedure btnAddFoldClick(Sender: TObject);
procedure btnRemFileClick(Sender: TObject);
procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
procedure TreeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
protected
procedure manualWidgetUpdate; override;
private
@ -70,6 +71,11 @@ begin
manualWidgetUpdate;
end;
procedure TCEProjectInspectWidget.TreeKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
begin
if Key = 13 then TreeDblClick(nil);
end;
procedure TCEProjectInspectWidget.TreeDblClick(sender: TObject);
var
fname: string;
@ -113,9 +119,17 @@ end;
procedure TCEProjectInspectWidget.btnAddFoldClick(Sender: TObject);
var
dir, ext, fname: string;
dir, fname: string;
sr: TSearchRec;
lst: TStringList;
procedure doFindFile;
var
ext: string;
begin
ext := ExtractFileExt(sr.Name);
if (ext = '.d') or (ext = '.di') then
lst.Add(dir + DirectorySeparator + sr.Name);
end;
begin
if fProject = nil then exit;
//
@ -127,17 +141,9 @@ begin
if FindFirst(dir + DirectorySeparator + '*.*', faAnyFile, sr ) = 0 then
try
lst := TStringList.Create;
ext := ExtractFileExt(sr.Name);
if (ext = '.d') or (ext = '.di') then
lst.Add(dir + DirectorySeparator + sr.Name);
while FindNext(sr) = 0 do
begin
ext := ExtractFileExt(sr.Name);
if (ext = '.d') or (ext = '.di') then
lst.Add(dir + DirectorySeparator + sr.Name);
end;
for fname in lst do
fProject.addSource(fname);
doFindFile;
while FindNext(sr) = 0 do doFindFile;
for fname in lst do fProject.addSource(fname);
finally
lst.Free;
end;

53
src/ce_staticexplorer.lfm Normal file
View File

@ -0,0 +1,53 @@
inherited CEStaticExplorerWidget: TCEStaticExplorerWidget
Left = 1569
Height = 278
Caption = 'Static explorer'
ClientHeight = 278
inherited Back: TPanel
Height = 278
ClientHeight = 278
inherited Content: TPanel
Height = 278
ClientHeight = 278
object Tree: TTreeView[0]
Left = 4
Height = 242
Top = 32
Width = 324
Align = alClient
BorderSpacing.Around = 4
DefaultItemHeight = 18
HideSelection = False
ReadOnly = True
ScrollBars = ssAutoBoth
TabOrder = 0
Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
end
object Panel1: TPanel[1]
Left = 2
Height = 26
Top = 2
Width = 328
Align = alTop
BorderSpacing.Around = 2
BevelOuter = bvNone
ClientHeight = 26
ClientWidth = 328
TabOrder = 1
object TreeFilterEdit1: TTreeFilterEdit
Left = 2
Height = 22
Top = 2
Width = 324
ButtonWidth = 23
NumGlyphs = 1
Align = alClient
BorderSpacing.Around = 2
MaxLength = 0
TabOrder = 0
FilteredTreeview = Tree
end
end
end
end
end

70
src/ce_staticexplorer.pas Normal file
View File

@ -0,0 +1,70 @@
unit ce_staticexplorer;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, TreeFilterEdit, Forms, Controls, Graphics,
Dialogs, ExtCtrls, Menus, ComCtrls, ce_widget, jsonparser, fpjson;
type
{ TCEStaticExplorerWidget }
TCEStaticExplorerWidget = class(TCEWidget)
Panel1: TPanel;
Tree: TTreeView;
TreeFilterEdit1: TTreeFilterEdit;
private
public
constructor create(aOwner: TComponent); override;
end;
implementation
{$R *.lfm}
uses
ce_jsoninfos;
constructor TCEStaticExplorerWidget.create(aOwner: TComponent);
var
rt, nd, mb: TTreeNode;
infs: TDSourceInfos;
mods: TDSourceInfos;
dt: TJsonData;
memberKind: TInfKind;
i,j,k: Integer;
membinfs: TDSourceInfos;
begin
inherited;
fID := 'ID_SEXPL';
//
for i:= 0 to high(JSonInfos.fData) do
begin
mods := JSonInfos.getFileModule(i);
for j := 0 to high(mods) do
begin
rt := Tree.Items.Add(nil, mods[j].infs);
for memberKind in InfKindNonModule do
begin
membinfs := JSonInfos.getMembers(i, j, memberKind);
nd := Tree.Items.AddChild(rt, InfKindStr[memberKind]);
for k := 0 to high(membinfs) do
begin
mb := Tree.Items.AddChild(nd, membinfs[k].infs);
mb.Data := @membinfs[k];
end;
end;
end;
end;
end;
end.

3
src/ce_widget.lfm
View File

@ -1,5 +1,5 @@
object CEWidget: TCEWidget
Left = 1570
Left = 1538
Height = 121
Top = 721
Width = 332
@ -7,6 +7,7 @@ object CEWidget: TCEWidget
Caption = 'CEWidget'
ClientHeight = 121
ClientWidth = 332
ShowHint = True
LCLVersion = '1.2.4.0'
object Back: TPanel
Left = 0

14
src/ce_widget.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls,
AnchorDocking, AnchorDockStorage, ActnList, Menus, syncobjs, ce_common;
AnchorDocking, AnchorDockStorage, ActnList, Menus, ce_common;
type
@ -29,7 +29,6 @@ type
protected
fID: string;
fNeedAutoUpdate: boolean;
fLocker: TCriticalSection;
procedure autoWidgetUpdate; virtual;
procedure manualWidgetUpdate; virtual;
published
@ -88,15 +87,12 @@ begin
fAutoUpdater := TTimer.Create(self);
fAutoUpdater.Interval := 50;
fAutoUpdater.OnTimer := @autoUpdaterEvent;
fLocker := TCriticalSection.Create;
DockMaster.MakeDockable(Self, true, true, true);
DockMaster.GetAnchorSite(Self).Header.HeaderPosition := adlhpTop;
end;
destructor TCEWidget.destroy;
begin
fLocker.Leave;
fLocker.Free;
inherited;
end;
@ -110,14 +106,14 @@ begin
Dec(fWidgUpdateCount);
if fWidgUpdateCount > 0 then
begin
{$IFDEF DEBUG}
writeln('widget update count > 0');
{$ENDIF}
exit;
end;
fManuUpdating := true;
//fLocker.Enter;
manualWidgetUpdate;
//fLocker.Leave;
fManuUpdating := false;
fWidgUpdateCount := 0;
@ -126,9 +122,7 @@ end;
procedure TCEWidget.forceManualWidgetUpdate;
begin
fManuUpdating := true;
//fLocker.Enter;
manualWidgetUpdate;
//fLocker.Leave;
fManuUpdating := false;
end;
@ -137,10 +131,8 @@ begin
if not fNeedAutoUpdate then exit;
fAutoUpdating := true;
try
//fLocker.Enter;
autoWidgetUpdate;
finally
//fLocker.Leave;
fAutoUpdating := false;
fNeedAutoUpdate := false;
end;