diff --git a/src/ce_dmdwrap.pas b/src/ce_dmdwrap.pas index 1f684585..26298a95 100644 --- a/src/ce_dmdwrap.pas +++ b/src/ce_dmdwrap.pas @@ -7,8 +7,6 @@ interface uses classes, sysutils, process; -//TODO-cfeature: scanner for -I and -J sources is the item is a folder. - (* procedure to add a new compiler option: @@ -21,7 +19,7 @@ procedure to add a new compiler option: type (***************************************************************************** - * Base class for encapsulating some compiler options. + * Base class designed to encapsulate some compiler options. * A descendant must be able to generate the related options * as a string representing the partial switches/arguments. *) @@ -362,7 +360,7 @@ begin if assigned(fOnChange) then fOnChange(self); end; -{$REGION TDocOpts **************************************************************} +{$REGION TDocOpts --------------------------------------------------------------} procedure TDocOpts.getOpts(const aList: TStrings); begin if fGenDoc then aList.Add('-D'); @@ -429,7 +427,7 @@ begin end; {$ENDREGION} -{$REGION TMsgOpts **************************************************************} +{$REGION TMsgOpts --------------------------------------------------------------} constructor TMsgOpts.create; begin fDepHandling := TDepHandling.warning; @@ -520,7 +518,7 @@ begin end; {$ENDREGION} -{$REGION TOutputOpts ***********************************************************} +{$REGION TOutputOpts -----------------------------------------------------------} constructor TOutputOpts.create; begin fVerIds := TStringList.Create; @@ -706,7 +704,7 @@ begin end; {$ENDREGION} -{$REGION TDebugOpts ************************************************************} +{$REGION TDebugOpts ------------------------------------------------------------} constructor TDebugOpts.create; begin fDbgIdents := TStringList.Create; @@ -826,7 +824,7 @@ begin end; {$ENDREGION} -{$REGION TPathsOpts ************************************************************} +{$REGION TPathsOpts ------------------------------------------------------------} constructor TPathsOpts.create; begin fSrcs := TStringList.Create; @@ -914,7 +912,7 @@ begin end; {$ENDREGION} -{$REGION TOtherOpts ************************************************************} +{$REGION TOtherOpts ------------------------------------------------------------} constructor TOtherOpts.create; begin fCustom := TStringList.Create; @@ -959,7 +957,7 @@ begin end; {$ENDREGION} -{$REGION TCustomProcOptions ****************************************************} +{$REGION TCustomProcOptions ----------------------------------------------------} constructor TCustomProcOptions.create; begin fParameters := TStringList.Create; @@ -1035,7 +1033,7 @@ begin end; {$ENDREGION} -{$REGION TCompilerConfiguration ************************************************} +{$REGION TCompilerConfiguration ------------------------------------------------} constructor TCompilerConfiguration.create(aCollection: TCollection); begin inherited create(aCollection); diff --git a/src/ce_editor.pas b/src/ce_editor.pas index 5fd88c81..a3e7e69b 100644 --- a/src/ce_editor.pas +++ b/src/ce_editor.pas @@ -12,7 +12,6 @@ uses ce_project; type - { TCEEditorWidget } TCEEditorWidget = class(TCEWidget) imgList: TImageList; PageControl: TExtendedNotebook; @@ -168,7 +167,7 @@ end; procedure TCEEditorWidget.removeEditor(const aIndex: NativeInt); begin - CEMainForm.MessageWidget.ClearMessages(msEditor); + CEMainForm.MessageWidget.ClearMessages(mcEditor); editor[aIndex].OnChange:= nil; pageControl.Pages[aIndex].Free; end; @@ -236,6 +235,7 @@ end; procedure TCEEditorWidget.UpdateByDelay; var + dt: PMessageItemData; ed: TCESynMemo; err: TLexError; md: string; @@ -248,15 +248,20 @@ begin CEMainForm.docChangeNotify(Self, editorIndex); if ed.Lines.Count = 0 then exit; // - CEMainForm.MessageWidget.ClearMessages(msEditor); + CEMainForm.MessageWidget.ClearMessages(mcEditor); lex(ed.Lines.Text, tokLst); if ed.isDSource then begin checkSyntacticErrors(tokLst, errLst); - for err in errLst do - CEMainForm.MessageWidget.addMessage(format( '%s (@line:%4.d @char:%.4d)', - [err.msg, err.position.y, err.position.x]), msEditor); + for err in errLst do begin + dt := newMessageData; + dt^.editor := ed; + dt^.position := point(err.position.x, err.position.y); + dt^.ctxt := mcEditor; + CEMainForm.MessageWidget.addMessage(format( '%s (@line:%.4d @char:%.4d)', + [err.msg, err.position.y, err.position.x]), dt); + end; end; md := ''; diff --git a/src/ce_main.pas b/src/ce_main.pas index 7f242570..d3a2943d 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -15,7 +15,7 @@ type TCEMainForm = class; - //TODO: options + //TODO-cfeature: options //TODO-cwidget: options editor (** * Encapsulates the options in a writable component. @@ -221,7 +221,7 @@ type procedure widgetShowFromAction(sender: TObject); // run & exec sub routines - procedure ProcessOutputToMsg(const aProcess: TProcess;aCtxt: TMessageContext = msUnknown); + procedure ProcessOutputToMsg(const aProcess: TProcess;aCtxt: TMessageContext = mcUnknown); procedure compileAndRunFile(const edIndex: NativeInt; const runArgs: string = ''); procedure compileProject(const aProject: TCEProject); procedure runProject(const aProject: TCEProject; const runArgs: string = ''); @@ -921,13 +921,14 @@ end; {$ENDREGION} {$REGION run -------------------------------------------------------------------} -procedure TCEMainForm.ProcessOutputToMsg(const aProcess: TProcess; aCtxt: TMessageContext = msUnknown); +procedure TCEMainForm.ProcessOutputToMsg(const aProcess: TProcess; aCtxt: TMessageContext = mcUnknown); var str: TMemoryStream; lns: TStringList; readCnt: LongInt; readSz: LongInt; ioBuffSz: LongInt; + dt: PMessageItemData; msg: string; begin If not (poUsePipes in aProcess.Options) then exit; @@ -946,7 +947,15 @@ begin end; Str.SetSize(readSz); lns.LoadFromStream(Str); - for msg in lns do fMesgWidg.addMessage(msg, aCtxt); + for msg in lns do begin + fMesgWidg.addMessage(msg, aCtxt); + dt := newMessageData; + dt^.ctxt := aCtxt; + dt^.position := getLineFromDmdMessage(msg); + dt^.editor := getFileFromDmdMessage(msg); + if dt^.editor = nil then + dt^.editor := EditWidget.currentEditor; + end; finally str.Free; lns.Free; @@ -954,7 +963,7 @@ begin end; end; -// TODO: input handling +// TODO-cfeature: input handling procedure TCEMainForm.compileAndRunFile(const edIndex: NativeInt; const runArgs: string = ''); var dmdproc: TProcess; @@ -967,7 +976,7 @@ begin getDir(0, olddir); try - fMesgWidg.addCeInf( 'compiling ' + fEditWidg.editor[edIndex].fileName, msEditor ); + fMesgWidg.addCeInf( 'compiling ' + fEditWidg.editor[edIndex].fileName, mcEditor ); temppath := GetTempDir(false); chDir(temppath); @@ -987,9 +996,8 @@ begin try dmdproc.Execute; while dmdproc.Running do if dmdproc.ExitStatus <> 0 then break; - ProcessOutputToMsg(dmdproc, msEditor); finally - DeleteFile(fname + '.d'); + ProcessOutputToMsg(dmdproc, mcEditor); end; {$IFDEF MSWINDOWS} @@ -1000,7 +1008,7 @@ begin begin fMesgWidg.addCeInf( fEditWidg.editor[edIndex].fileName - + ' successfully compiled', msEditor ); + + ' successfully compiled', mcEditor ); runproc.Options:= [poStderrToOutPut, poUsePipes]; {$IFDEF MSWINDOWS} @@ -1010,9 +1018,11 @@ begin {$ELSE} runproc.Executable := fname; {$ENDIF} - runproc.Execute; - while runproc.Running do if runproc.ExitStatus <> 0 then break; - ProcessOutputToMsg(runproc, msEditor); + try + runproc.Execute; + while runproc.Running do if runproc.ExitStatus <> 0 then break; + ProcessOutputToMsg(runproc, mcEditor); + finally {$IFDEF MSWINDOWS} DeleteFile(fname + '.exe'); DeleteFile(fname + '.obj'); @@ -1020,14 +1030,16 @@ begin DeleteFile(fname); DeleteFile(fname + '.o'); {$ENDIF} + end; end else fMesgWidg.addCeErr( fEditWidg.editor[edIndex].fileName - + ' has not been compiled', msEditor ); + + ' has not been compiled', mcEditor ); finally dmdproc.Free; runproc.Free; + DeleteFile(fname + '.d'); chDir(olddir); end; end; @@ -1040,14 +1052,14 @@ var i: NativeInt; begin - fMesgWidg.ClearMessages(msProject); + fMesgWidg.ClearMessages(mcProject); for i := 0 to fWidgList.Count-1 do fWidgList.widget[i].projCompile(aProject); if aProject.Sources.Count = 0 then begin - fMesgWidg.addCeErr( aProject.fileName + ' has no source files', msProject); + fMesgWidg.addCeErr( aProject.fileName + ' has no source files', mcProject); exit; end; @@ -1066,7 +1078,7 @@ begin ppproc.Free; end; end - else fMesgWidg.addCeWarn('the pre-compilation executable does not exist', msProject); + else fMesgWidg.addCeWarn('the pre-compilation executable does not exist', mcProject); end; olddir := ''; @@ -1075,7 +1087,7 @@ begin try - fMesgWidg.addCeInf( 'compiling ' + aProject.fileName, msProject); + fMesgWidg.addCeInf( 'compiling ' + aProject.fileName, mcProject); application.ProcessMessages; prjpath := extractFilePath(aProject.fileName); @@ -1091,7 +1103,7 @@ begin try dmdproc.Execute; while dmdproc.Running do if dmdproc.ExitStatus <> 0 then break; - ProcessOutputToMsg(dmdproc, msProject); + ProcessOutputToMsg(dmdproc, mcProject); finally {$IFDEF MSWINDOWS} // STILL_ACTIVE ambiguity if (dmdProc.ExitStatus = 0) or (dmdProc.ExitStatus = 259) then @@ -1099,10 +1111,10 @@ begin if dmdProc.ExitStatus = 0 then {$ENDIF} fMesgWidg.addCeInf( aProject.fileName - + ' successfully compiled', msProject) + + ' successfully compiled', mcProject) else fMesgWidg.addCeErr( aProject.fileName - + ' has not been compiled', msProject); + + ' has not been compiled', mcProject); end; with fProject.currentConfiguration do @@ -1120,7 +1132,7 @@ begin ppproc.Free; end; end - else fMesgWidg.addCeWarn('the post-compilation executable does not exist', msProject); + else fMesgWidg.addCeWarn('the post-compilation executable does not exist', mcProject); end; finally @@ -1160,7 +1172,7 @@ begin if not fileExists(procname) then begin - fMesgWidg.addCeErr('output executable missing: ' + procname, msProject); + fMesgWidg.addCeErr('output executable missing: ' + procname, mcProject); exit; end; @@ -1169,7 +1181,7 @@ begin runproc.CurrentDirectory := extractFilePath(runproc.Executable); runproc.Execute; while runproc.Running do if runproc.ExitStatus <> 0 then break; - ProcessOutputToMsg(runproc, msProject); + ProcessOutputToMsg(runproc, mcProject); finally runproc.Free; diff --git a/src/ce_messages.lfm b/src/ce_messages.lfm index 17de1dac..707cfc35 100644 --- a/src/ce_messages.lfm +++ b/src/ce_messages.lfm @@ -38,6 +38,7 @@ inherited CEMessagesWidget: TCEMessagesWidget ShowLines = False ShowRoot = False TabOrder = 0 + OnDblClick = ListDblClick OnKeyDown = ListKeyDown Options = [tvoAllowMultiselect, tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoToolTips, tvoThemedDraw] end diff --git a/src/ce_messages.pas b/src/ce_messages.pas index 240ca4cd..b912692c 100644 --- a/src/ce_messages.pas +++ b/src/ce_messages.pas @@ -7,22 +7,24 @@ interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, ce_project, - ce_synmemo; + ce_synmemo, ce_dlangutils; type - TMessageContext = (msUnknown, msProject, msEditor); + TMessageContext = (mcUnknown, mcProject, mcEditor, mcApplication); PMessageItemData = ^TMessageItemData; TMessageItemData = record ctxt: TMessageContext; - data: Pointer; + editor: TCESynMemo; + project: TCEProject; + position: TPoint; end; - { TCEMessagesWidget } TCEMessagesWidget = class(TCEWidget) imgList: TImageList; List: TTreeView; + procedure ListDblClick(Sender: TObject); procedure ListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private fActClearAll: TAction; @@ -30,7 +32,7 @@ type fActSaveMsg: TAction; fActCopyMsg: TAction; fActSelAll: TAction; - fProject: TCEProject; + fProj: TCEProject; fMaxMessCnt: Integer; fDoc: TCESynMemo; procedure filterMessages; @@ -43,16 +45,22 @@ type procedure setMaxMessageCount(aValue: Integer); procedure listDeletion(Sender: TObject; Node: TTreeNode); function newMessageItemData(aCtxt: TMessageContext): PMessageItemData; + // + procedure optset_MaxMessageCount(aReader: TReader); + procedure optget_MaxMessageCount(awriter: TWriter); published property maxMessageCount: Integer read fMaxMessCnt write setMaxMessageCount default 125; public constructor create(aOwner: TComponent); override; // procedure scrollToBack; - procedure addMessage(const aMsg: string; aCtxt: TMessageContext = msUnknown); - procedure addCeInf(const aMsg: string; aCtxt: TMessageContext = msUnknown); - procedure addCeErr(const aMsg: string; aCtxt: TMessageContext = msUnknown); - procedure addCeWarn(const aMsg: string; aCtxt: TMessageContext = msUnknown); + procedure addMessage(const aMsg: string; aCtxt: TMessageContext = mcUnknown); + procedure addMessage(const aMsg: string; const aData: PMessageItemData); + procedure addCeInf(const aMsg: string; aCtxt: TMessageContext = mcUnknown); + procedure addCeErr(const aMsg: string; aCtxt: TMessageContext = mcUnknown); + procedure addCeWarn(const aMsg: string; aCtxt: TMessageContext = mcUnknown); + // + procedure declareProperties(aFiler: TFiler); override; // function contextName: string; override; function contextActionCount: integer; override; @@ -60,6 +68,7 @@ type // procedure projNew(const aProject: TCEProject); override; procedure projClose(const aProject: TCEProject); override; + procedure projFocused(const aProject: TCEProject); override; // procedure docFocused(const aDoc: TCESynMemo); override; procedure docClose(const aDoc: TCESynMemo); override; @@ -68,13 +77,12 @@ type procedure ClearMessages(aCtxt: TMessageContext); end; - PTCEMessageItem = ^TCEMessageItem; - TCEMessageItem = class(TListItem) - end; - TMessageKind = (msgkUnknown, msgkInfo, msgkHint, msgkWarn, msgkError); function semanticMsgAna(const aMessg: string): TMessageKind; + function getLineFromDmdMessage(const aMessage: string): TPoint; + function getFileFromDmdMessage(const aMessage: string): TCESynMemo; + function newMessageData: PMessageItemData; implementation {$R *.lfm} @@ -82,6 +90,7 @@ implementation uses ce_main; +{$REGION Standard Comp/Obj------------------------------------------------------} constructor TCEMessagesWidget.create(aOwner: TComponent); begin fMaxMessCnt := 125; @@ -108,45 +117,12 @@ begin List.OnDeletion := @ListDeletion; end; -procedure TCEMessagesWidget.clearOutOfRangeMessg; -begin - while List.Items.Count > fMaxMessCnt do - List.Items.Delete(List.Items.GetFirstNode); -end; - -procedure TCEMessagesWidget.setMaxMessageCount(aValue: Integer); -begin - if aValue < 10 then aValue := 10; - if aValue > 1023 then aValue := 1023; - if fMaxMessCnt = aValue then exit; - fMaxMessCnt := aValue; - clearOutOfRangeMessg; -end; - -function TCEMessagesWidget.newMessageItemData(aCtxt: TMessageContext): PMessageItemData; -begin - result := new(PMessageItemData); - result^.ctxt := aCtxt; - case aCtxt of - msUnknown: result^.data := nil; - msProject: result^.data := Pointer(fProject); - msEditor: result^.data := Pointer(fDoc); - end; -end; - procedure TCEMessagesWidget.listDeletion(Sender: TObject; Node: TTreeNode); begin if node.Data <> nil then Dispose( PMessageItemData(Node.Data)); end; -procedure TCEMessagesWidget.scrollToBack; -begin - if not Visible then exit; - if List.BottomItem <> nil then - List.BottomItem.MakeVisible; -end; - procedure TCEMessagesWidget.ListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var @@ -163,88 +139,36 @@ begin else ClearAllMessages; end; end; +{$ENDREGION} -procedure TCEMessagesWidget.filterMessages; -var - itm: TTreeNode; - dat: PMessageItemData; - i: NativeInt; +{$REGION ICEWidgetPersist ------------------------------------------------------} +procedure TCEMessagesWidget.setMaxMessageCount(aValue: Integer); begin - for i := 0 to List.Items.Count-1 do - begin - itm := List.Items[i]; - dat := PMessageItemData(itm.Data); - case dat^.ctxt of - msProject: itm.Visible := Pointer(fProject) = (dat^.data); - msEditor: itm.Visible := Pointer(fDoc) = (dat^.data); - else itm.Visible := true; - end; - end; -end; - -procedure TCEMessagesWidget.ClearAllMessages; -begin - List.Items.Clear; -end; - -procedure TCEMessagesWidget.ClearMessages(aCtxt: TMessageContext); -var - i: NativeInt; -begin - for i := List.Items.Count-1 downto 0 do - begin - if PMessageItemData(List.Items[i].Data)^.ctxt = aCtxt then - List.Items.Delete(List.Items[i]); - end; -end; - -procedure TCEMessagesWidget.addCeInf(const aMsg: string; aCtxt: TMessageContext = msUnknown); -var - item: TTreeNode; -begin - item := List.Items.Add(nil, 'Coedit information: ' + aMsg); - item.Data := newMessageItemData(aCtxt); - item.ImageIndex := 1; - item.SelectedIndex := 1; - clearOutOfRangeMessg; - scrollToBack; -end; - -procedure TCEMessagesWidget.addCeWarn(const aMsg: string; aCtxt: TMessageContext = msUnknown); -var - item: TTreeNode; -begin - item := List.Items.Add(nil, 'Coedit warning: ' + aMsg); - item.Data := newMessageItemData(aCtxt); - item.ImageIndex := 3; - item.SelectedIndex := 3; - clearOutOfRangeMessg; - scrollToBack; -end; - -procedure TCEMessagesWidget.addCeErr(const aMsg: string; aCtxt: TMessageContext = msUnknown); -var - item: TTreeNode; -begin - item := List.Items.Add(nil, 'Coedit error: ' + aMsg); - item.Data := newMessageItemData(aCtxt); - item.ImageIndex := 4; - item.SelectedIndex := 4; - clearOutOfRangeMessg; - scrollToBack; -end; - -procedure TCEMessagesWidget.addMessage(const aMsg: string; aCtxt: TMessageContext = msUnknown); -var - item: TTreeNode; -begin - item := List.Items.Add(nil, aMsg); - item.Data := newMessageItemData(aCtxt); - item.ImageIndex := Integer( semanticMsgAna(aMsg) ); - item.SelectedIndex := Integer( semanticMsgAna(aMsg) ); + if aValue < 10 then aValue := 10; + if aValue > 1023 then aValue := 1023; + if fMaxMessCnt = aValue then exit; + fMaxMessCnt := aValue; clearOutOfRangeMessg; end; +procedure TCEMessagesWidget.optset_MaxMessageCount(aReader: TReader); +begin + maxMessageCount := aReader.ReadInteger; +end; + +procedure TCEMessagesWidget.optget_MaxMessageCount(aWriter: TWriter); +begin + aWriter.WriteInteger(fMaxMessCnt); +end; + +procedure TCEMessagesWidget.declareProperties(aFiler: TFiler); +begin + inherited; + aFiler.DefineProperty(Name + '_MaxMessageCount', @optset_MaxMessageCount, @optget_MaxMessageCount, true); +end; +{$ENDREGION} + +{$REGION ICEContextualActions---------------------------------------------------} function TCEMessagesWidget.contextName: string; begin result := 'Messages'; @@ -267,31 +191,6 @@ begin end; end; -procedure TCEMessagesWidget.projNew(const aProject: TCEProject); -begin - fProject := aProject; - filterMessages; -end; - -procedure TCEMessagesWidget.projClose(const aProject: TCEProject); -begin - if fProject = aProject then ClearMessages(msProject); - fProject := nil; - filterMessages; -end; - -procedure TCEMessagesWidget.docFocused(const aDoc: TCESynMemo); -begin - fDoc := aDoc; - filterMessages; -end; - -procedure TCEMessagesWidget.docClose(const aDoc: TCESynMemo); -begin - fDoc := nil; - filterMessages; -end; - procedure TCEMessagesWidget.actClearAllExecute(Sender: TObject); begin ClearAllMessages; @@ -299,7 +198,7 @@ end; procedure TCEMessagesWidget.actClearEdiExecute(Sender: TObject); begin - ClearMessages(msEditor); + ClearMessages(mcEditor); end; procedure TCEMessagesWidget.actCopyMsgExecute(Sender: TObject); @@ -343,8 +242,191 @@ begin free; end; end; +{$ENDREGION} + +{$REGION ICEProjectMonitor -----------------------------------------------------} +procedure TCEMessagesWidget.projNew(const aProject: TCEProject); +begin + fProj := aProject; + filterMessages; +end; + +procedure TCEMessagesWidget.projClose(const aProject: TCEProject); +begin + if fProj = aProject then ClearMessages(mcProject); + fProj := nil; + filterMessages; +end; + +procedure TCEMessagesWidget.projFocused(const aProject: TCEProject); +begin + fProj := aProject; + filterMessages; +end; +{$ENDREGION} + +{$REGION ICEMultiDocMonitor ----------------------------------------------------} +procedure TCEMessagesWidget.docFocused(const aDoc: TCESynMemo); +begin + fDoc := aDoc; + filterMessages; +end; + +procedure TCEMessagesWidget.docClose(const aDoc: TCESynMemo); +begin + fDoc := nil; + filterMessages; +end; +{$ENDREGION} + +{$REGION Messages --------------------------------------------------------------} +procedure TCEMessagesWidget.clearOutOfRangeMessg; +begin + while List.Items.Count > fMaxMessCnt do + List.Items.Delete(List.Items.GetFirstNode); +end; + +function newMessageData: PMessageItemData; +begin + result := new(PMessageItemData); + result^.ctxt := mcUnknown; + result^.project := nil; + result^.editor := nil; + result^.position := point(0,0); +end; + +function TCEMessagesWidget.newMessageItemData(aCtxt: TMessageContext): PMessageItemData; +begin + result := new(PMessageItemData); + result^.ctxt := aCtxt; + result^.project := fProj; + result^.editor := fDoc; + result^.position := point(0,0); +end; + +procedure TCEMessagesWidget.scrollToBack; +begin + if not Visible then exit; + if List.BottomItem <> nil then + List.BottomItem.MakeVisible; +end; + +procedure TCEMessagesWidget.ListDblClick(Sender: TObject); +var + dat: PMessageItemData; +begin + if List.Selected = nil then exit; + if List.Selected.Data = nil then exit; + // + dat := PMessageItemData(List.Selected.Data); + if dat^.editor = nil then exit; + CEMainForm.openFile(dat^.editor.fileName); + dat^.editor.CaretXY := dat^.position; + dat^.editor.SelectLine; +end; + +procedure TCEMessagesWidget.filterMessages; +var + itm: TTreeNode; + dat: PMessageItemData; + i: NativeInt; +begin + if updating then exit; + for i := 0 to List.Items.Count-1 do + begin + itm := List.Items[i]; + dat := PMessageItemData(itm.Data); + case dat^.ctxt of + mcProject: itm.Visible := fProj = dat^.project; + mcEditor: itm.Visible := fDoc = dat^.editor; + else itm.Visible := true; + end; + end; +end; + +procedure TCEMessagesWidget.ClearAllMessages; +begin + List.Items.Clear; +end; + +procedure TCEMessagesWidget.ClearMessages(aCtxt: TMessageContext); +var + i: NativeInt; + dt: TMessageItemData; +begin + for i := List.Items.Count-1 downto 0 do + begin + dt := PMessageItemData(List.Items[i].Data)^; + if dt.ctxt = aCtxt then case aCtxt of + mcEditor: if dt.editor = fDoc then List.Items.Delete(List.Items[i]); + mcProject: if dt.project = fProj then List.Items.Delete(List.Items[i]); + else List.Items.Delete(List.Items[i]); + end; + end; +end; + +procedure TCEMessagesWidget.addCeInf(const aMsg: string; aCtxt: TMessageContext = mcUnknown); +var + item: TTreeNode; +begin + item := List.Items.Add(nil, 'Coedit information: ' + aMsg); + item.Data := newMessageItemData(aCtxt); + item.ImageIndex := 1; + item.SelectedIndex := 1; + clearOutOfRangeMessg; + scrollToBack; +end; + +procedure TCEMessagesWidget.addCeWarn(const aMsg: string; aCtxt: TMessageContext = mcUnknown); +var + item: TTreeNode; +begin + item := List.Items.Add(nil, 'Coedit warning: ' + aMsg); + item.Data := newMessageItemData(aCtxt); + item.ImageIndex := 3; + item.SelectedIndex := 3; + clearOutOfRangeMessg; + scrollToBack; +end; + +procedure TCEMessagesWidget.addCeErr(const aMsg: string; aCtxt: TMessageContext = mcUnknown); +var + item: TTreeNode; +begin + item := List.Items.Add(nil, 'Coedit error: ' + aMsg); + item.Data := newMessageItemData(aCtxt); + item.ImageIndex := 4; + item.SelectedIndex := 4; + clearOutOfRangeMessg; + scrollToBack; +end; + +procedure TCEMessagesWidget.addMessage(const aMsg: string; const aData: PMessageItemData); +var + item: TTreeNode; + imgIx: Integer; +begin + item := List.Items.Add(nil, aMsg); + item.Data := aData; + imgIx := Integer(semanticMsgAna(aMsg)); + item.ImageIndex := imgIx; + item.SelectedIndex := imgIx; + clearOutOfRangeMessg; +end; + +procedure TCEMessagesWidget.addMessage(const aMsg: string; aCtxt: TMessageContext = mcUnknown); +var + item: TTreeNode; + imgIx: Integer; +begin + item := List.Items.Add(nil, aMsg); + item.Data := newMessageItemData(aCtxt); + imgIx := Integer(semanticMsgAna(aMsg)); + item.ImageIndex := imgIx; + item.SelectedIndex := imgIx; + clearOutOfRangeMessg; +end; -// TODO: link to editor line when possible. function semanticMsgAna(const aMessg: string): TMessageKind; var pos: Nativeint; @@ -395,4 +477,70 @@ begin end; end; +function getLineFromDmdMessage(const aMessage: string): TPoint; +var + i: NativeInt; + ident: string; +begin + result.x := 0; + result.y := 0; + ident := ''; + i := 0; + while (true) do + begin + inc(i); + if i > length(aMessage) then exit; + if aMessage[i] = '.' then + begin + inc(i); + if i > length(aMessage) then exit; + if aMessage[i] = 'd' then + begin + inc(i); + if i > length(aMessage) then exit; + if aMessage[i] = '(' then + begin + inc(i); + if i > length(aMessage) then exit; + while( isNumber(aMessage[i]) ) do + begin + ident += aMessage[i]; + inc(i); + if i > length(aMessage) then exit; + end; + if aMessage[i] = ')' then + begin + result.y := strToInt(ident); + exit; + end; + end; + end; + end; + inc(i); + end; +end; + +function getFileFromDmdMessage(const aMessage: string): TCESynMemo; +var + i: NativeInt; + ident: string; +begin + ident := ''; + i := 0; + result := nil; + while(true) do + begin + inc(i); + if i > length(aMessage) then exit; + if aMessage[i] = '(' then + begin + if not fileExists(ident) then exit; + CEMainForm.openFile(ident); + result := CEMainForm.EditWidget.currentEditor; + end; + ident += aMessage[i]; + end; +end; +{$ENDREGION} + end. diff --git a/src/ce_miniexplorer.pas b/src/ce_miniexplorer.pas index 786dad98..9a89958f 100644 --- a/src/ce_miniexplorer.pas +++ b/src/ce_miniexplorer.pas @@ -9,8 +9,6 @@ uses Menus, StdCtrls, ComCtrls, Buttons, ce_widget, lcltype; type - - { TCEMiniExplorerWidget } TCEMiniExplorerWidget = class(TCEWidget) Bevel1: TBevel; Bevel2: TBevel; @@ -67,8 +65,6 @@ implementation uses ce_main, ce_common; -//TODO-cbugfix: click on the expander glyph, sometime the subdirs are not scanned but the fake sub item is still displayed - {$REGION Standard Comp/Obj------------------------------------------------------} constructor TCEMiniExplorerWidget.create(aIwner: TComponent); begin @@ -252,7 +248,7 @@ begin fname := PString(lstFiles.Selected.Data)^; if not fileExists(fname) then exit; if not shellOpen(fname) then CEMainForm.MessageWidget.addCeErr - (format('the shell failed to open "%s"',[shortenPath(fname,25)])); + (format('the shell failed to open "%s"', [shortenPath(fname, 25)])); end; {$ENDREGION} @@ -333,6 +329,9 @@ end; procedure TCEMiniExplorerWidget.treeExpanding(Sender: TObject; Node: TTreeNode; var allow: boolean); begin + if Node <> nil then + treeScanSubFolders(Node); + allow := true; end; procedure TCEMiniExplorerWidget.treeCollapsed(Sender: TObject; Node: TTreeNode); diff --git a/src/ce_projconf.pas b/src/ce_projconf.pas index a3552ab3..121a84ed 100644 --- a/src/ce_projconf.pas +++ b/src/ce_projconf.pas @@ -10,8 +10,6 @@ uses ce_dmdwrap, ce_project, ce_widget, AnchorDocking; type - - { TCEProjectConfigurationWidget } TCEProjectConfigurationWidget = class(TCEWidget) imgList: TImageList; selConf: TComboBox; diff --git a/src/ce_projinspect.lfm b/src/ce_projinspect.lfm index 758bc7f8..4aa262ec 100644 --- a/src/ce_projinspect.lfm +++ b/src/ce_projinspect.lfm @@ -1,27 +1,27 @@ inherited CEProjectInspectWidget: TCEProjectInspectWidget - Left = 1640 - Height = 383 - Top = 90 + Left = 1242 + Height = 257 + Top = 360 Width = 264 AllowDropFiles = True Caption = 'Project inspector' - ClientHeight = 383 + ClientHeight = 257 ClientWidth = 264 OnDropFiles = FormDropFiles inherited Back: TPanel - Height = 383 + Height = 257 Width = 264 - ClientHeight = 383 + ClientHeight = 257 ClientWidth = 264 inherited Content: TPanel - Height = 383 + Height = 257 Width = 264 - ClientHeight = 383 + ClientHeight = 257 ClientWidth = 264 PopupMenu = nil object Tree: TTreeView[0] Left = 2 - Height = 353 + Height = 227 Top = 28 Width = 260 Align = alClient diff --git a/src/ce_projinspect.pas b/src/ce_projinspect.pas index fac9920d..b782038f 100644 --- a/src/ce_projinspect.pas +++ b/src/ce_projinspect.pas @@ -10,7 +10,6 @@ uses ce_common, ce_widget, AnchorDocking; type - { TCEProjectInspectWidget } TCEProjectInspectWidget = class(TCEWidget) imgList: TImageList; Panel1: TPanel; @@ -54,6 +53,7 @@ implementation uses ce_main; +{$REGION Standard Comp/Obj------------------------------------------------------} constructor TCEProjectInspectWidget.create(aOwner: TComponent); begin fActOpenFile := TAction.Create(self); @@ -71,7 +71,9 @@ begin // Tree.PopupMenu := contextMenu; end; +{$ENDREGION} +{$REGION ICEContextualActions---------------------------------------------------} function TCEProjectInspectWidget.contextName: string; begin exit('Inspector'); @@ -91,6 +93,13 @@ begin end; end; +procedure TCEProjectInspectWidget.actOpenFileExecute(sender: TObject); +begin + TreeDblClick(sender); +end; +{$ENDREGION} + +{$REGION ICEProjectMonitor -----------------------------------------------------} procedure TCEProjectInspectWidget.projNew(const aProject: TCEProject); begin fProject := aProject; @@ -108,6 +117,7 @@ begin fProject := nil; UpdateByEvent; end; +{$ENDREGION} procedure TCEProjectInspectWidget.TreeKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState); begin @@ -146,11 +156,6 @@ begin end; end; -procedure TCEProjectInspectWidget.actOpenFileExecute(sender: TObject); -begin - TreeDblClick(sender); -end; - procedure TCEProjectInspectWidget.actUpdate(sender: TObject); begin fActSelConf.Enabled := false; diff --git a/src/ce_search.pas b/src/ce_search.pas index 04b74955..461f964b 100644 --- a/src/ce_search.pas +++ b/src/ce_search.pas @@ -10,8 +10,6 @@ uses ce_widget, ce_synmemo, AnchorDocking; type - - { TCESearchWidget } TCESearchWidget = class(TCEWidget) btnFind: TBitBtn; btnReplace: TBitBtn; diff --git a/src/ce_staticexplorer.pas b/src/ce_staticexplorer.pas index d0b5c2b0..2a03eaa1 100644 --- a/src/ce_staticexplorer.pas +++ b/src/ce_staticexplorer.pas @@ -10,8 +10,6 @@ uses ce_synmemo, process, actnlist, ce_common, ce_project, AnchorDocking; type - - { TCEStaticExplorerWidget } TCEStaticExplorerWidget = class(TCEWidget) imgList: TImageList; Panel1: TPanel; diff --git a/src/ce_synmemo.pas b/src/ce_synmemo.pas index e5cbc1a8..dcbf6640 100644 --- a/src/ce_synmemo.pas +++ b/src/ce_synmemo.pas @@ -9,7 +9,6 @@ uses LazSynEditText, SynPluginSyncroEdit, SynEditKeyCmds, ce_project, ce_common; type - TCESynMemo = class(TSynMemo) private fFilename: string; diff --git a/src/ce_widget.pas b/src/ce_widget.pas index 91d4dcaf..c248e9e7 100644 --- a/src/ce_widget.pas +++ b/src/ce_widget.pas @@ -15,8 +15,6 @@ type * Base type for an UI module. *) PTCEWidget = ^TCEWidget; - - { TCEWidget } TCEWidget = class(TForm, ICEContextualActions, ICEProjectMonitor, ICEMultiDocMonitor, ICEWidgetPersist) Content: TPanel; Back: TPanel; @@ -334,9 +332,7 @@ begin end; {$ENDREGION} -(******************************************************************************* - * TCEWidgetList - *) +{$REGION TCEWidgetList---------------------------------------------------------------} function TCEWidgetList.getWidget(index: integer): TCEWidget; begin result := PTCEWidget(Items[index])^; @@ -364,6 +360,7 @@ begin result.fList := aWidgetList; result.fIndex := -1; end; +{$ENDREGION} end. diff --git a/src/ce_widgettypes.pas b/src/ce_widgettypes.pas index a25b78ef..6da99f5a 100644 --- a/src/ce_widgettypes.pas +++ b/src/ce_widgettypes.pas @@ -9,7 +9,7 @@ uses type - // TODO-cinterface: document content access/modification + // TODO-cfeature: document content access/modification (** * An implementer can save and load some stuffs on application start/quit @@ -25,6 +25,7 @@ type (** * An implementer declares some actions on demand. + * TODO-cfeature: improve the interface so that a widget can declare a complete main menu category. *) ICEContextualActions = interface // declares a context name for the actions @@ -36,7 +37,7 @@ type end; (** - * An implementer is informed when a new document is added, focused or closed. + * An implementer is informed about the current file(s). *) ICEMultiDocMonitor = interface // the new document aDoc has been created (empty, runnable, project source, ...). @@ -50,7 +51,7 @@ type end; (** - * An implementer is informed when a project changes. + * An implementer is informed about the current project(s). *) ICEProjectMonitor = interface // the new project aProject has been created/opened