You can subscribe to this list here.
2001 |
Jan
|
Feb
(32) |
Mar
(98) |
Apr
(26) |
May
(33) |
Jun
(50) |
Jul
(82) |
Aug
(197) |
Sep
(187) |
Oct
(186) |
Nov
(99) |
Dec
(70) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2002 |
Jan
(31) |
Feb
(32) |
Mar
(16) |
Apr
(7) |
May
(10) |
Jun
(6) |
Jul
(11) |
Aug
(39) |
Sep
(24) |
Oct
(54) |
Nov
(13) |
Dec
(135) |
2003 |
Jan
(22) |
Feb
(9) |
Mar
(29) |
Apr
(4) |
May
(40) |
Jun
(52) |
Jul
(8) |
Aug
(33) |
Sep
(111) |
Oct
(25) |
Nov
(40) |
Dec
(47) |
2004 |
Jan
(19) |
Feb
(87) |
Mar
(105) |
Apr
(30) |
May
(40) |
Jun
(11) |
Jul
(88) |
Aug
(23) |
Sep
(16) |
Oct
(16) |
Nov
(13) |
Dec
(13) |
2005 |
Jan
(42) |
Feb
(3) |
Mar
(55) |
Apr
(46) |
May
(74) |
Jun
(23) |
Jul
(10) |
Aug
(69) |
Sep
(15) |
Oct
(49) |
Nov
(148) |
Dec
(168) |
2006 |
Jan
(64) |
Feb
(14) |
Mar
(26) |
Apr
(25) |
May
(26) |
Jun
(9) |
Jul
(21) |
Aug
(5) |
Sep
(11) |
Oct
(25) |
Nov
(8) |
Dec
|
2007 |
Jan
(5) |
Feb
(4) |
Mar
(50) |
Apr
(22) |
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
From: Thomas M. <tw...@us...> - 2006-10-22 12:42:07
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Formatter/ExperimentalProjects In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv23555/ExperimentalProjects Log Message: Directory /cvsroot/gexperts/gexperts/unstable/Src/Formatter/ExperimentalProjects added to the repository |
From: Thomas M. <tw...@us...> - 2006-10-22 11:54:03
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Formatter/ExperimentalPackages In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv5133/ExperimentalPackages Log Message: Directory /cvsroot/gexperts/gexperts/unstable/Src/Formatter/ExperimentalPackages added to the repository |
From: Thomas M. <tw...@us...> - 2006-10-22 11:53:19
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Formatter/engine In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv5075/unstable/Src/Formatter/engine Removed Files: DelForInterf.pas Log Message: we no longer have an external dll --- DelForInterf.pas DELETED --- |
From: Thomas M. <tw...@us...> - 2006-10-22 11:52:00
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Formatter In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv4339/unstable/Src/Formatter Modified Files: GX_Formatter.pas GX_eCodeFormatter.pas Log Message: switching between editor expert and regular expert is now done via cond. define Index: GX_Formatter.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Formatter/GX_Formatter.pas,v retrieving revision 1.27 retrieving revision 1.28 diff -u -d -r1.27 -r1.28 --- GX_Formatter.pas 21 Jun 2006 11:16:15 -0000 1.27 +++ GX_Formatter.pas 22 Oct 2006 11:51:56 -0000 1.28 @@ -9,6 +9,8 @@ implementation +{$IFNDEF GX_FORMATTER_IS_EDITOR_EXPERT} + uses {$IFOPT D+}GX_DbugIntf, {$ENDIF} @@ -100,5 +102,7 @@ initialization RegisterGX_Expert(TGxCodeFormatterExpert); +{$ENDIF GX_FORMATTER_IS_EDITOR_EXPERT} + end. Index: GX_eCodeFormatter.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Formatter/GX_eCodeFormatter.pas,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- GX_eCodeFormatter.pas 21 Jun 2006 11:16:15 -0000 1.3 +++ GX_eCodeFormatter.pas 22 Oct 2006 11:51:56 -0000 1.4 @@ -9,6 +9,8 @@ implementation +{$IFDEF GX_FORMATTER_IS_EDITOR_EXPERT} + uses {$IFOPT D+}GX_DbugIntf, {$ENDIF} @@ -112,5 +114,7 @@ initialization RegisterEditorExpert(TeCodeFormatterExpert); +{$ENDIF GX_FORMATTER_IS_EDITOR_EXPERT} + end. |
From: Thomas M. <tw...@us...> - 2006-10-22 10:54:57
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Formatter In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv24435 Removed Files: GX_CodeFormatterSaveList.pas Log Message: unit GX_CodeFormatterSaveList is no longer used --- GX_CodeFormatterSaveList.pas DELETED --- |
From: Thomas M. <tw...@us...> - 2006-10-22 10:53:15
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Formatter In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv23884 Modified Files: GX_CodeFormatterBookmarks.pas GX_CodeFormatterBreakpoints.pas GX_CodeFormatterExpert.pas Log Message: Bugfix: Bookmarks were deleted if no formatting took place. Index: GX_CodeFormatterExpert.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Formatter/GX_CodeFormatterExpert.pas,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- GX_CodeFormatterExpert.pas 1 Jun 2006 08:19:50 -0000 1.1 +++ GX_CodeFormatterExpert.pas 22 Oct 2006 10:53:09 -0000 1.2 @@ -41,8 +41,7 @@ GX_CodeFormatterDefaultSettings, GX_CodeFormatterConfigHandler, GX_CodeFormatterDone, - GX_CodeFormatterSettings, - GX_CodeFormatterSaveList; + GX_CodeFormatterSettings; { TCodeFormatterExpert } @@ -77,8 +76,8 @@ SourceEditor: IOTASourceEditor; FileName: string; FullText: TStringList; - Bookmarks: ICodeFormatterSaveList; - Breakpoints: ICodeFormatterSaveList; + Bookmarks: TBookmarkHandler; + Breakpoints: TBreakpointHandler; WasBinary: Boolean; i: integer; TempSettings: TCodeFormatterSettings; @@ -100,25 +99,34 @@ if FullText.Count = 0 then exit; + Breakpoints := nil; Bookmarks := TBookmarkHandler.Create; - Breakpoints := TBreakpointHandler.Create; - - FirstLine := FullText[0]; - if SameText(Copy(FirstLine, 1, 20), '{GXFormatter.config=') then begin - FirstLine := Trim(Copy(FirstLine, 21, Length(FirstLine) - 21)); - TempSettings := TCodeFormatterSettings.Create; - if TCodeFormatterConfigHandler.GetDefaultConfig(FirstLine, TempSettings) then begin - OrigSettings := FEngine.Settings.Settings; - FEngine.Settings.Settings := TempSettings.Settings; - end else - FreeAndNil(TempSettings); - end; + try + Breakpoints := TBreakpointHandler.Create; + Breakpoints.SaveItems; + Bookmarks.SaveItems; + FirstLine := FullText[0]; + if SameText(Copy(FirstLine, 1, 20), '{GXFormatter.config=') then begin + FirstLine := Trim(Copy(FirstLine, 21, Length(FirstLine) - 21)); + TempSettings := TCodeFormatterSettings.Create; + if TCodeFormatterConfigHandler.GetDefaultConfig(FirstLine, TempSettings) then begin + OrigSettings := FEngine.Settings.Settings; + FEngine.Settings.Settings := TempSettings.Settings; + end else + FreeAndNil(TempSettings); + end; - if FEngine.Execute(FullText) then begin - GxOtaReplaceEditorText(SourceEditor, FullText.Text); - for i := 0 to SourceEditor.EditViewCount - 1 do - SourceEditor.EditViews[i].Paint; - FEngine.Settings.ShowDoneDialog := ShowDoneDialog(FEngine.Settings.ShowDoneDialog); + if FEngine.Execute(FullText) then begin + GxOtaReplaceEditorText(SourceEditor, FullText.Text); + Breakpoints.RestoreItems; + Bookmarks.RestoreItems; + for i := 0 to SourceEditor.EditViewCount - 1 do + SourceEditor.EditViews[i].Paint; + FEngine.Settings.ShowDoneDialog := ShowDoneDialog(FEngine.Settings.ShowDoneDialog); + end; + finally + FreeAndNil(Breakpoints); + FreeAndNil(Bookmarks); end; finally Index: GX_CodeFormatterBreakpoints.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Formatter/GX_CodeFormatterBreakpoints.pas,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- GX_CodeFormatterBreakpoints.pas 16 Oct 2006 20:13:28 -0000 1.6 +++ GX_CodeFormatterBreakpoints.pas 22 Oct 2006 10:53:09 -0000 1.7 @@ -9,8 +9,7 @@ uses SysUtils, Classes, - ToolsApi, - GX_CodeFormatterSaveList; + ToolsApi; type TSourceBreakpoint = class @@ -68,15 +67,15 @@ end; type - TBreakpointHandler = class(TCodeFormatterSaveList, ICodeFormatterSaveList) + TBreakpointHandler = class private FBreakpoints: TBreakpoints; protected - procedure RestoreItems; override; - procedure SaveItems; override; public constructor Create; destructor Destroy; override; + procedure RestoreItems; + procedure SaveItems; end; implementation @@ -145,16 +144,14 @@ constructor TBreakpointHandler.Create; begin - // Must be first because the parent calls the SaveItems virtual - FBreakpoints := TBreakpoints.Create; inherited; + FBreakpoints := TBreakpoints.Create; end; destructor TBreakpointHandler.Destroy; begin - inherited; - // This must be last because of a call to RestoreItems in the parent FreeAndNil(FBreakpoints); + inherited; end; procedure TBreakpointHandler.RestoreItems; @@ -180,7 +177,7 @@ SrcBreakpoint.FileName, SrcBreakpoint.LineNumber, DebuggerServices.CurrentProcess); except - Break;// FIXME: Delphi 6/7 do not support recreation of source breakpoints at designtime (EListError: List index out of bounds (-1)) + Break; // FIXME: Delphi 6/7 do not support recreation of source breakpoints at designtime (EListError: List index out of bounds (-1)) end; {$IFDEF GX_VER170_up} SrcBrkPtInt.StackFramesToLog := SrcBreakpoint.StackFramesToLog; Index: GX_CodeFormatterBookmarks.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Formatter/GX_CodeFormatterBookmarks.pas,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- GX_CodeFormatterBookmarks.pas 19 Feb 2006 21:26:49 -0000 1.5 +++ GX_CodeFormatterBookmarks.pas 22 Oct 2006 10:53:09 -0000 1.6 @@ -9,8 +9,7 @@ uses SysUtils, Classes, - ToolsApi, - GX_CodeFormatterSaveList; + ToolsApi; type TBookmark = class @@ -38,16 +37,16 @@ property Count: Integer read GetCount; end; - TBookmarkHandler = class(TCodeFormatterSaveList, ICodeFormatterSaveList) + TBookmarkHandler = class private FBookmarks: TBookmarks; protected function GetEditView(var ASourceEditor: IOTASourceEditor; var AEditView: IOTAEditView): boolean; - procedure RestoreItems; override; - procedure SaveItems; override; public constructor Create; destructor Destroy; override; + procedure RestoreItems; + procedure SaveItems; end; implementation @@ -113,14 +112,14 @@ constructor TBookmarkHandler.Create; begin - FBookmarks := TBookmarks.Create; inherited Create; + FBookmarks := TBookmarks.Create; end; destructor TBookmarkHandler.Destroy; begin - inherited; FBookmarks.Free; + inherited; end; function TBookmarkHandler.GetEditView(var ASourceEditor: IOTASourceEditor; var AEditView: IOTAEditView): boolean; |
From: Erik B. <eb...@us...> - 2006-10-16 20:13:35
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Formatter In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv10438/Src/Formatter Modified Files: GX_CodeFormatterBreakpoints.pas Log Message: Ignore source breakpoint creation errors in D6/7 Other minor code tweaks Index: GX_CodeFormatterBreakpoints.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Formatter/GX_CodeFormatterBreakpoints.pas,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- GX_CodeFormatterBreakpoints.pas 19 Feb 2006 21:26:49 -0000 1.5 +++ GX_CodeFormatterBreakpoints.pas 16 Oct 2006 20:13:28 -0000 1.6 @@ -31,7 +31,6 @@ FExpression: string; FPassCount: Integer; public - constructor Create; // IOTABreakpoint (Delphi 2005) property StackFramesToLog: Integer read FStackFramesToLog write FStackFramesToLog; // IOTABreakpoint80 @@ -64,7 +63,7 @@ procedure Add(Item: TSourceBreakpoint); function Count: Integer; procedure Clear; - function Find(const AFilename: string; ALineNumber: integer; out Idx: integer): boolean; + function Find(const AFilename: string; ALineNumber: Integer; out Idx: Integer): Boolean; property Items[Idx: Integer]: TSourceBreakpoint read GetItems; default; end; @@ -82,18 +81,11 @@ implementation -{ TSourceBreakpoint } - -constructor TSourceBreakpoint.Create; -begin - inherited; -end; - { TBreakpoints } constructor TBreakpoints.Create; begin - inherited Create; + inherited; FList := TList.Create; end; @@ -103,37 +95,40 @@ begin for i := 0 to Count - 1 do TSourceBreakpoint(FList[i]).Free; - FList.Free; + FreeAndNil(FList); inherited; end; -function TBreakpoints.Find(const AFilename: string; ALineNumber: integer; - out Idx: integer): boolean; +function TBreakpoints.Find(const AFilename: string; ALineNumber: Integer; + out Idx: Integer): Boolean; var i: Integer; begin - for i := 0 to fList.Count - 1 do begin + for i := 0 to FList.Count - 1 do begin if SameText(Items[i].FileName, AFilename) and (Items[i].LineNumber = ALineNumber) then begin Idx := i; - Result := true; - exit; + Result := True; + Exit; end; end; - Result := false; + Result := False; end; function TBreakpoints.GetItems(Idx: Integer): TSourceBreakpoint; begin + Assert((Idx > -1) and (Idx < FList.Count)); Result := FList[Idx]; end; procedure TBreakpoints.Add(Item: TSourceBreakpoint); begin + Assert(Assigned(FList)); FList.Add(Item); end; function TBreakpoints.Count: Integer; begin + Assert(Assigned(FList)); Result := FList.Count; end; @@ -150,14 +145,16 @@ constructor TBreakpointHandler.Create; begin + // Must be first because the parent calls the SaveItems virtual FBreakpoints := TBreakpoints.Create; - inherited Create; + inherited; end; destructor TBreakpointHandler.Destroy; begin inherited; - FBreakpoints.Free; + // This must be last because of a call to RestoreItems in the parent + FreeAndNil(FBreakpoints); end; procedure TBreakpointHandler.RestoreItems; @@ -178,9 +175,13 @@ end; for i := 0 to FBreakpoints.Count - 1 do begin SrcBreakpoint := FBreakpoints[i]; - SrcBrkPtInt := DebuggerServices.NewSourceBreakpoint( - SrcBreakpoint.FileName, SrcBreakpoint.LineNumber, - DebuggerServices.CurrentProcess); + try + SrcBrkPtInt := DebuggerServices.NewSourceBreakpoint( + SrcBreakpoint.FileName, SrcBreakpoint.LineNumber, + DebuggerServices.CurrentProcess); + except + Break;// FIXME: Delphi 6/7 do not support recreation of source breakpoints at designtime (EListError: List index out of bounds (-1)) + end; {$IFDEF GX_VER170_up} SrcBrkPtInt.StackFramesToLog := SrcBreakpoint.StackFramesToLog; {$ENDIF} |
From: Erik B. <eb...@us...> - 2006-10-16 20:12:20
|
Update of /cvsroot/gexperts/gexperts/unstable In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv10021 Modified Files: GExpertsD7.dof Log Message: Minor option tweaks Index: GExpertsD7.dof =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/GExpertsD7.dof,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- GExpertsD7.dof 24 Oct 2005 06:19:41 -0000 1.5 +++ GExpertsD7.dof 16 Oct 2006 20:12:12 -0000 1.6 @@ -156,6 +156,10 @@ d:\borland\delphi7\Bin\dclmlwiz70.bpl=Borland Markup Language Wizards d:\borland\delphi7\Bin\dclshlctrls70.bpl=Shell Control Property and Component Editors d:\borland\delphi7\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package -D:\Borland\Raize\Bin\Rz30TrialCtls_Dsgn70.bpl=Raize Components 3.0.12 - Trial Edition -D:\Borland\Raize\Bin\Rz30TrialDBCtls_Dsgn70.bpl=Raize Components 3.0.10 (Data-Aware) - Trial Edition C:\WINDOWS\system32\ibevnt70.bpl=Borland Interbase Event Alerter Component +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +Count=1 +Item0=Src;Comps;Comps\Abbrevia \ No newline at end of file |
From: Erik B. <eb...@us...> - 2006-10-16 20:07:03
|
Update of /cvsroot/gexperts/gexperts/unstable In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv7714 Modified Files: BuildChecklist.txt Log Message: Minor buld step updates Index: BuildChecklist.txt =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/BuildChecklist.txt,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- BuildChecklist.txt 2 Dec 2004 05:22:55 -0000 1.3 +++ BuildChecklist.txt 16 Oct 2006 20:06:57 -0000 1.4 @@ -1,10 +1,8 @@ - Add the the third party defines to GX_CondDefine.inc - Rebuild Grep, Expert Manager, and Debug Window binaries for each platform, if necessary -- Update the version number in all IDEs, the Readme, and FinalBuilder -- Test the build under all supported IDEs with all conditional defines - off and on - Check the install script for new/modified files +- Update the version number in all IDEs, the Readme, and FinalBuilder +- Run the automated build - Update the web site for the new release - Send an announcement email to the mailing lists - |
From: Erik B. <eb...@us...> - 2006-10-16 18:39:49
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Formatter In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv6636/Src/Formatter Modified Files: GX_CodeFormatterConfig.dfm Log Message: Remove some BDS properties Index: GX_CodeFormatterConfig.dfm =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Formatter/GX_CodeFormatterConfig.dfm,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- GX_CodeFormatterConfig.dfm 27 May 2006 14:38:40 -0000 1.7 +++ GX_CodeFormatterConfig.dfm 16 Oct 2006 18:39:10 -0000 1.8 @@ -1,10 +1,10 @@ object fmCodeFormatterConfig: TfmCodeFormatterConfig Left = 339 Top = 175 + Width = 486 + Height = 455 HelpContext = 100 Caption = 'Delphi Code Formatter Configuration' - ClientHeight = 426 - ClientWidth = 478 Color = clBtnFace Constraints.MinHeight = 375 Constraints.MinWidth = 478 @@ -20,19 +20,16 @@ Top = 0 Width = 478 Height = 385 - ActivePage = ts_Capitalization + ActivePage = ts_Indent Align = alClient + TabIndex = 0 TabOrder = 0 object ts_Indent: TTabSheet Caption = 'Indent' - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object Label1: TLabel Left = 8 Top = 22 - Width = 88 + Width = 87 Height = 13 Caption = 'Spaces per Indent' end @@ -50,8 +47,11 @@ Width = 11 Height = 21 Associate = SpacePerIndentEdit + Min = 0 Max = 10 + Position = 0 TabOrder = 1 + Wrap = False end object IndentCommentsCheck: TCheckBox Left = 240 @@ -120,10 +120,6 @@ end object ts_Spacing: TTabSheet Caption = 'Spacing' - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 DesignSize = ( 470 357) @@ -148,28 +144,24 @@ end object ts_LineBreaks: TTabSheet Caption = 'Line Breaks' - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object Label4: TLabel Left = 240 Top = 104 - Width = 52 + Width = 51 Height = 13 Caption = 'Begin style' end object Label13: TLabel Left = 248 Top = 200 - Width = 51 + Width = 49 Height = 13 Caption = 'At position' end object Label2: TLabel Left = 240 Top = 136 - Width = 42 + Width = 39 Height = 13 Caption = 'Try style' end @@ -208,8 +200,11 @@ Width = 12 Height = 21 Associate = WrapPositionEdit + Min = 0 Max = 254 + Position = 0 TabOrder = 5 + Wrap = False end object GroupBox2: TGroupBox Left = 8 @@ -332,35 +327,31 @@ end object ts_Capitalization: TTabSheet Caption = 'Capitalization' - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object Label7: TLabel Left = 8 Top = 74 - Width = 46 + Width = 45 Height = 13 Caption = 'Capitalize' end object Label11: TLabel Left = 8 Top = 136 - Width = 126 + Width = 124 Height = 13 Caption = 'User defined capitalization' end object Label14: TLabel Left = 8 Top = 18 - Width = 78 + Width = 77 Height = 13 Caption = 'Reserved words' end object Label15: TLabel Left = 8 Top = 42 - Width = 93 + Width = 91 Height = 13 Caption = 'Standard directives' end @@ -436,21 +427,17 @@ end object ts_Align: TTabSheet Caption = 'Align' - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object Label16: TLabel Left = 12 Top = 35 - Width = 51 + Width = 49 Height = 13 Caption = 'At position' end object Label17: TLabel Left = 12 Top = 115 - Width = 51 + Width = 49 Height = 13 Caption = 'At position' end @@ -476,7 +463,10 @@ Width = 10 Height = 21 Associate = AlignCommentPosEdit + Min = 0 + Position = 0 TabOrder = 2 + Wrap = False end object AlignVarCheck: TCheckBox Left = 12 @@ -500,33 +490,32 @@ Width = 10 Height = 21 Associate = AlignVarPosEdit + Min = 0 + Position = 0 TabOrder = 5 + Wrap = False end end object ts_Misc: TTabSheet Caption = 'Misc.' - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object Label8: TLabel Left = 8 Top = 8 - Width = 204 + Width = 196 Height = 13 Caption = 'Directives in source to prevent formatting:' end object Label9: TLabel Left = 8 Top = 40 - Width = 24 + Width = 22 Height = 13 Caption = 'Start' end object Label10: TLabel Left = 8 Top = 64 - Width = 18 + Width = 19 Height = 13 Caption = 'End' end @@ -560,17 +549,13 @@ ImageIndex = 6 OnResize = ts_PreviewResize OnShow = ts_PreviewShow - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 DesignSize = ( 470 357) object l_Before: TLabel Left = 6 Top = 0 - Width = 32 + Width = 31 Height = 13 Caption = 'Before' end |
From: Erik B. <eb...@us...> - 2006-10-16 07:06:32
|
Update of /cvsroot/gexperts/gexperts/unstable In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv2282 Modified Files: GExpertsD6.dof Log Message: Add addin warning lines to ini Index: GExpertsD6.dof =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/GExpertsD6.dof,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- GExpertsD6.dof 7 Feb 2006 00:22:49 -0000 1.7 +++ GExpertsD6.dof 16 Oct 2006 07:06:27 -0000 1.8 @@ -141,3 +141,10 @@ [HistoryLists\hlUnitAliases] Count=1 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Warnings] +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 |
From: Erik B. <eb...@us...> - 2006-10-16 06:57:03
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Utils In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv30867/Src/Utils Modified Files: GX_GenericUtils.pas Log Message: Remove buggy mwipos (does not find 'init' in 'tvMainInit') Add working PosIEx/PosIEx_JOH_IA32_1_c from fastcode.org temporarily instead Index: GX_GenericUtils.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Utils/GX_GenericUtils.pas,v retrieving revision 1.150 retrieving revision 1.151 diff -u -d -r1.150 -r1.151 --- GX_GenericUtils.pas 1 Jun 2006 23:41:44 -0000 1.150 +++ GX_GenericUtils.pas 16 Oct 2006 06:56:59 -0000 1.151 @@ -61,7 +61,6 @@ // Find SubString in S; do not consider case; // this works exactly the same as the Pos function, // except for case-INsensitivity. -function CaseInsensitivePos(Pat, Text: PChar): Integer; overload; function CaseInsensitivePos(const Pat, Text: string): Integer; overload; function AnsiCaseInsensitivePos(const SubString, S: string): Integer; // Same as CaseInsensitivePos, except that searching for the substring starts @@ -596,41 +595,259 @@ end; end; -// Adapted from Martin Waldenburgs Freeware IPos (mwipos.zip) -function CaseInsensitivePos(Pat, Text: PChar): Integer; -var - RunPat, RunText, PosPtr: PChar; -begin - Result := 0; - RunPat := Pat; - RunText := Text; - while RunText^ <> #0 do - begin - if (ASCIICharTable[RunPat^] = ASCIICharTable[RunText^]) then - begin - PosPtr := RunText; - while RunPat^ <> #0 do - begin - if ASCIICharTable[RunPat^] <> ASCIICharTable[RunText^] then - Break; - Inc(RunPat); - Inc(RunText); - end; - if RunPat^ = #0 then - begin - Result := PosPtr - Text + 1; - Break; - end; - end - else - Inc(RunText); - RunPat := Pat; - end; -end; +// FastCode PosIEx PosIEx_JOH_IA32_1_c from fastcode.org +function PosIEx(const SubStr, S: string; Offset: Integer = 1): Integer; +const + LocalsSize = 32; + _ebx = 0; + _edi = 4; + _esi = 8; + _ebp = 12; + _edx = 16; + _ecx = 20; + _end = 24; + _tmp = 28; +asm + sub esp, LocalsSize {Setup Local Storage} + mov [esp._ebx], ebx + cmp eax, 1 + sbb ebx, ebx {-1 if SubStr = '' else 0} + sub edx, 1 {-1 if S = ''} + sbb ebx, 0 {Negative if S = '' or SubStr = '' else 0} + sub ecx, 1 {Offset - 1} + or ebx, ecx {Negative if S = '' or SubStr = '' or Offset < 1} + jl @@InvalidInput + mov [esp._edi], edi + mov [esp._esi], esi + mov [esp._ebp], ebp + mov [esp._edx], edx + mov edi, [eax-4] {Length(SubStr)} + mov esi, [edx-3] {Length(S)} + add ecx, edi + cmp ecx, esi + jg @@NotFound {Offset to High for a Match} + test edi, edi + jz @@NotFound {Length(SubStr = 0)} + add esi, edx {Last Character Position in S} + add eax, edi {Last Character Position in SubStr + 1} + mov [esp._end], eax {Save SubStr End Positiom} + add edx, ecx {Search Start Position in S for Last Character} + movzx eax, [eax-1] {Last Character of SubStr} + mov bl, al {Convert Character into Uppercase} + add bl, $9f + sub bl, $1a + jnb @@UC1 + sub al, $20 +@@UC1: + mov ah, al + neg edi {-Length(SubStr)} + mov ecx, eax + shl eax, 16 + or ecx, eax {All 4 Bytes = Uppercase Last Character of +SubStr} +@@MainLoop: + add edx, 4 + cmp edx, esi + ja @@Remainder {1 to 4 Positions Remaining} + mov eax, [edx-4] {Check Next 4 Bytes of S} + mov ebx, eax {Convert All 4 Characters into Uppercase} + or eax, $80808080 + mov ebp, eax + sub eax, $7B7B7B7B + xor ebp, ebx + or eax, $80808080 + sub eax, $66666666 + and eax, ebp + shr eax, 2 + xor eax, ebx + xor eax, ecx {Zero Byte at each Matching Position} + lea ebx, [eax-$01010101] + not eax + and eax, ebx + and eax, $80808080 {Set Byte to $80 at each Match Position else $00} + jz @@MainLoop {Loop Until any Match on Last Character Found} + bsf eax, eax {Find First Match Bit} + shr eax, 3 {Byte Offset of First Match (0..3)} + lea edx, [eax+edx-3] {Address of First Match on Last Character + 1} +@@Compare: + cmp edi, -4 + jle @@Large + cmp edi, -1 + je @@SetResult {Exit with Match if Lenght(SubStr) = 1} + mov eax, [esp._end] {SubStr End Position} + movzx eax, word ptr [edi+eax] {Last Char Matches - Compare First 2 +Chars} + cmp ax, [edi+edx] + je @@SetResult {Same - Skip Uppercase Conversion} + mov ebx, eax {Convert Characters into Uppercase} + or eax, $80808080 + mov ebp, eax + sub eax, $7B7B7B7B + xor ebp, ebx + or eax, $80808080 + sub eax, $66666666 + and eax, ebp + shr eax, 2 + xor eax, ebx + mov [esp._tmp], eax {Save Converted Characters} + movzx eax, word ptr [edi+edx] + mov ebx, eax {Convert Characters into Uppercase} + or eax, $80808080 + mov ebp, eax + sub eax, $7B7B7B7B + xor ebp, ebx + or eax, $80808080 + sub eax, $66666666 + and eax, ebp + shr eax, 2 + xor eax, ebx + cmp eax, [esp._tmp] + jne @@MainLoop {No Match on First 2 Characters} +@@SetResult: {Full Match} + lea eax, [edx+edi] {Calculate and Return Result} + sub eax, [esp._edx] {Subtract Start Position} + jmp @@Done +@@NotFound: + xor eax, eax {No Match Found - Return 0} +@@Done: + mov ebx, [esp._ebx] + mov edi, [esp._edi] + mov esi, [esp._esi] + mov ebp, [esp._ebp] + add esp, LocalsSize {Release Local Storage} + ret +@@Large: + mov eax, [esp._end] {SubStr End Position} + mov eax, [eax-4] {Compare Last 4 Characters of S and SubStr} + cmp eax, [edx-4] + je @@LargeCompare {Same - Skip Uppercase Conversion} + mov ebx, eax {Convert All 4 Characters into Uppercase} + or eax, $80808080 + mov ebp, eax + sub eax, $7B7B7B7B + xor ebp, ebx + or eax, $80808080 + sub eax, $66666666 + and eax, ebp + shr eax, 2 + xor eax, ebx + mov [esp._tmp], eax {Save Converted Characters} + mov eax, [edx-4] + mov ebx, eax {Convert All 4 Characters into Uppercase} + or eax, $80808080 + mov ebp, eax + sub eax, $7B7B7B7B + xor ebp, ebx + or eax, $80808080 + sub eax, $66666666 + and eax, ebp + shr eax, 2 + xor eax, ebx + cmp eax, [esp._tmp] {Compare Converted Characters} + jne @@MainLoop {No Match on Last 4 Characters} +@@LargeCompare: + mov ebx, edi {Offset} + mov [esp._ecx], ecx {Save ECX} +@@CompareLoop: {Compare Remaining Characters} + add ebx, 4 {Compare 4 Characters per Loop} + jge @@SetResult {All Characters Matched} + mov eax, [esp._end] {SubStr End Positiob} + mov eax, [ebx+eax-4] + cmp eax, [ebx+edx-4] + je @@CompareLoop {Same - Skip Uppercase Conversion} + mov ecx, eax {Convert All 4 Characters into Uppercase} + or eax, $80808080 + mov ebp, eax + sub eax, $7B7B7B7B + xor ebp, ecx + or eax, $80808080 + sub eax, $66666666 + and eax, ebp + shr eax, 2 + xor eax, ecx + mov [esp._tmp], eax + mov eax, [ebx+edx-4] + mov ecx, eax {Convert All 4 Characters into Uppercase} + or eax, $80808080 + mov ebp, eax + sub eax, $7B7B7B7B + xor ebp, ecx + or eax, $80808080 + sub eax, $66666666 + and eax, ebp + shr eax, 2 + xor eax, ecx + cmp eax, [esp._tmp] + je @@CompareLoop {Match on Next 4 Characters} + mov ecx, [esp._ecx] {Restore ECX for Next Main Loop} + jmp @@MainLoop {No Match} +@@Remainder: {Check Last 1 to 4 Characters} + mov eax, [esi-3] {Last 4 Characters of S - May include Length +Bytes} + mov ebx, eax {Convert All 4 Characters into Uppercase} + or eax, $80808080 + mov ebp, eax + sub eax, $7B7B7B7B + xor ebp, ebx + or eax, $80808080 + sub eax, $66666666 + and eax, ebp + shr eax, 2 + xor eax, ebx + xor eax, ecx {Zero Byte at each Matching Position} + lea ebx, [eax-$01010101] + not eax + and eax, ebx + and eax, $80808080 {Set Byte to $80 at each Match Position else $00} + jz @@NotFound {No Match Possible} + sub edx, 3 {Start Position for Next Loop} + movzx eax, [edx-1] + mov bl, al {Convert Character into Uppercase} + add bl, $9f + sub bl, $1a + jnb @@UC2 + sub al, $20 +@@UC2: + cmp al, cl + je @@Compare {Match} + cmp edx, esi + ja @@NotFound + add edx, 1 + movzx eax, [edx-1] + mov bl, al {Convert Character in AL into Uppercase} + add bl, $9f + sub bl, $1a + jnb @@UC3 + sub al, $20 +@@UC3: + cmp al, cl + je @@Compare {Match} + cmp edx, esi + ja @@NotFound + add edx, 1 + movzx eax, [edx-1] + mov bl, al {Convert Character in AL into Uppercase} + add bl, $9f + sub bl, $1a + jnb @@UC4 + sub al, $20 +@@UC4: + cmp al, cl + je @@Compare {Match} + cmp edx, esi + ja @@NotFound + add edx, 1 + jmp @@Compare {Match} +@@InvalidInput: + xor eax, eax {Return 0} + mov ebx, [esp._ebx] + add esp, LocalsSize {Release Local Storage} +end; {PosIEx} function CaseInsensitivePos(const Pat, Text: string): Integer; begin - Result := CaseInsensitivePos(PChar(Pat), PChar(Text)); + //Result := Pos(UpperCase(Pat), UpperCase(Text)); + Result := PosIEx(Pat, Text); end; function CaseInsensitivePosFrom(const Pat, Text: string; StartIndex: Integer): Integer; |
From: Erik B. <eb...@us...> - 2006-10-16 06:54:13
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Utils In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv29833/Src/Utils Modified Files: GX_OtaUtils.pas Log Message: Fix personality list typo Index: GX_OtaUtils.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Utils/GX_OtaUtils.pas,v retrieving revision 1.195 retrieving revision 1.196 diff -u -d -r1.195 -r1.196 --- GX_OtaUtils.pas 6 Sep 2006 07:49:52 -0000 1.195 +++ GX_OtaUtils.pas 16 Oct 2006 06:54:09 -0000 1.196 @@ -1034,7 +1034,7 @@ function GxOtaGetHexPrefix: string; begin - if StringInArray(GxOtaGetCurrentProjectPersonality, [sCSharpPersonality, sCSharpPersonality]) then + if StringInArray(GxOtaGetCurrentProjectPersonality, [sCBuilderPersonality, sCSharpPersonality]) then Result := '0x' else Result := '$'; |
From: Erik B. <eb...@us...> - 2006-10-16 06:54:07
|
Update of /cvsroot/gexperts/gexperts/unstable In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv29678 Modified Files: GExperts.iss Log Message: Add new InnoSetup compiler version note Index: GExperts.iss =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/GExperts.iss,v retrieving revision 1.18 retrieving revision 1.19 diff -u -d -r1.18 -r1.19 --- GExperts.iss 28 Jul 2006 02:56:04 -0000 1.18 +++ GExperts.iss 16 Oct 2006 06:53:10 -0000 1.19 @@ -1,5 +1,5 @@ -; This install script requires the Inno Setup Quick Start Pack version 4.1.8+ -; (with the included ISPP) from: http://www.jrsoftware.org/isdl.php +; This install script requires the Inno Setup Quick Start Pack version 5.1 +; or greater with the included ISPP, from: http://www.jrsoftware.org/isdl.php #ifdef ISPPCC_INVOKED ; Command line compiler |
From: Erik B. <eb...@us...> - 2006-09-22 02:21:01
|
Update of /cvsroot/gexperts/gexperts/unstable/Src In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv22947/Src Modified Files: GX_CompsToCode.pas Log Message: Add Delphi support for multiline strings in the DFM Index: GX_CompsToCode.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/GX_CompsToCode.pas,v retrieving revision 1.32 retrieving revision 1.33 diff -u -d -r1.32 -r1.33 --- GX_CompsToCode.pas 17 Apr 2006 06:13:41 -0000 1.32 +++ GX_CompsToCode.pas 22 Sep 2006 02:20:58 -0000 1.33 @@ -622,7 +622,33 @@ end; //while end; - procedure ProcSL(propName: string; compName: string); + procedure ProcessMultilineString(propName: string; compName: string); + var + LastLineInString: Boolean; + LineSuffix: string; + begin + if CFmtWith = '' then + Log(Impl, '%s%s%s%s := ', [CFmtIndent, compName, CFmtPropertyAccess, PropName]) + else + Log(Impl, CFmtIndent + CFmtIndent + '%s := ', [PropName]); + while not Eof do + begin + Readln; + LastLineInString := not StrEndsWith('+', ccLn); + if LastLineInString then + LineSuffix := ';' + else + LineSuffix := ''; + if CFmtWith = '' then + Log(Impl, CFmtIndent + CFmtIndent + '%s%s', [ccLn, LineSuffix]) + else + Log(Impl, CFmtIndent + CFmtIndent + CFmtIndent + '%s%s', [ccLn, LineSuffix]); + if LastLineInString then + Exit; + end; + end; + + procedure ProcessStringList(propName: string; compName: string); var p: Integer; last: Boolean; @@ -669,7 +695,7 @@ end; end; - procedure ProcItems(const propName: string; compName: string); + procedure ProcessCollectionItems(const propName: string; compName: string); var pVal: string; pName: string; @@ -816,9 +842,11 @@ if propVal = '{' then // glyphs etc - skip ProcGlyph(propName, compName) else if propVal = '(' then // string lists - ProcSL(propName, compName) + ProcessStringList(propName, compName) else if propVal = '<' then // ListView columns etc - ProcItems(propName, compName) + ProcessCollectionItems(propName, compName) + else if propVal = '' then // Multi-line strings where the value starts on the next line (TADOConnection.ConnectionString, a long TLabel.Caption, etc.) + ProcessMultilineString(propName, compName) else if (propName = 'Top') or (propName = 'Left') then begin if propType(propName) <> '' then @@ -841,7 +869,7 @@ if CFmtPropertyAccess = '.' then Log(impl, CFmtIndent + compName + CFmtPropertyAccess + TrimLeft(CFmtAssign), [propName, propVal]) else - Log(impl, CFmtIndent + compName + CFmtPropertyAccess + TrimLeft(CFmtAssign), [StringReplace(propName,'.',CFmtPropertyAccess,[rfReplaceAll]), PropC(propVal,propName)]) + Log(impl, CFmtIndent + compName + CFmtPropertyAccess + TrimLeft(CFmtAssign), [StringReplace(propName, '.', CFmtPropertyAccess, [rfReplaceAll]), PropC(propVal, propName)]); end; //if p > 0 end; //else if not skip end; //while not EOF @@ -903,7 +931,7 @@ while not EOF do begin Readln; - if Copy(ccULn, 1, Length('object')) = 'OBJECT' then + if StrBeginsWith('object', ccULn, False) then ParseComponent(Comp, decl, crea, impl, sub); end; finally @@ -921,7 +949,7 @@ 'The code to create the selected components has been copied to the clipboard.' + sLineBreak + sLineBreak + 'You can now paste the generated code into the IDE ' + - 'editor at the appropriate position.'; + 'editor at the appropriate position.'; begin Result := SCopyToClipboardComplete; end; |
From: Erik B. <eb...@us...> - 2006-09-22 02:09:36
|
Update of /cvsroot/gexperts/gexperts/unstable/Src In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv18760/Src Modified Files: GX_ProcedureList.pas Log Message: Don't filter on the class name when a class filter is explicit in the combo/dropdown Index: GX_ProcedureList.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/GX_ProcedureList.pas,v retrieving revision 1.70 retrieving revision 1.71 diff -u -d -r1.70 -r1.71 --- GX_ProcedureList.pas 5 Jul 2006 13:54:30 -0000 1.70 +++ GX_ProcedureList.pas 22 Sep 2006 02:09:32 -0000 1.71 @@ -278,7 +278,7 @@ AddListItem(ProcInfo) else if FOptions.SearchAll and StrContains(edtMethods.Text, ProcInfo.ProcName, False) then AddListItem(ProcInfo) - else if FOptions.SearchAll and FOptions.SearchClassName and StrContains(edtMethods.Text, ProcInfo.ProcClass, False) then + else if FOptions.SearchAll and FOptions.SearchClassName and SameText(cbxObjects.Text, SAllString) and StrContains(edtMethods.Text, ProcInfo.ProcClass, False) then AddListItem(ProcInfo); end; if lvProcs.Items.Count = 0 then |
From: Erik B. <eb...@us...> - 2006-09-22 00:08:33
|
Update of /cvsroot/gexperts/gexperts/unstable/Comps In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv6055/Comps Modified Files: GX_EnhancedEditor.pas Log Message: Add compilation comment only Index: GX_EnhancedEditor.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Comps/GX_EnhancedEditor.pas,v retrieving revision 1.29 retrieving revision 1.30 diff -u -d -r1.29 -r1.30 --- GX_EnhancedEditor.pas 23 Jun 2005 21:38:16 -0000 1.29 +++ GX_EnhancedEditor.pas 22 Sep 2006 00:08:11 -0000 1.30 @@ -8,7 +8,7 @@ uses Windows, Classes, Graphics, Controls, - {$IFDEF SYNEDIT} + {$IFDEF SYNEDIT} // Edit GX_CondDefine.inc to compile without requiring SynEdit support SynEdit, SynMemo, SynEditTypes, SynEditTextBuffer, {$ENDIF SYNEDIT} |
From: Erik B. <eb...@us...> - 2006-09-22 00:07:52
|
Update of /cvsroot/gexperts/gexperts/unstable/Icons In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv5701/Icons Added Files: SelectComponents.bmp Log Message: Add Select components tool from Rossen Assenov (not part of the project yet) Several changes by me --- NEW FILE: SelectComponents.bmp --- (This appears to be a binary file; contents omitted.) |
From: Erik B. <eb...@us...> - 2006-09-22 00:06:38
|
Update of /cvsroot/gexperts/gexperts/unstable/Src In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv5317/Src Modified Files: GX_SharedImages.pas Added Files: GX_SelectComponents.dfm GX_SelectComponents.pas Log Message: Add Select components tool from Rossen Assenov (not part of the project yet) Several changes by me --- NEW FILE: GX_SelectComponents.dfm --- object SelectComponentsForm: TSelectComponentsForm Left = 376 Top = 207 Width = 404 Height = 388 ActiveControl = StayOnTopCheckBox BorderIcons = [biSystemMenu] BorderStyle = bsSizeToolWin Caption = 'Select Components' Color = clBtnFace Constraints.MinHeight = 175 Constraints.MinWidth = 190 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] KeyPreview = True OldCreateOrder = True Scaled = False OnActivate = FormActivate OnKeyPress = FormKeyPress PixelsPerInch = 96 TextHeight = 13 object FindPanel: TPanel Left = 0 Top = 0 Width = 396 Height = 32 Align = alTop BevelOuter = bvNone TabOrder = 0 DesignSize = ( 396 32) object FilterLabel: TLabel Left = 9 Top = 9 Width = 22 Height = 13 Caption = 'Filter' end object SearchEdit: TEdit Left = 43 Top = 5 Width = 250 Height = 21 Hint = 'Find a component by name and/or type: [<name>][:][<type>]' Anchors = [akLeft, akTop, akRight] ParentShowHint = False ShowHint = True TabOrder = 0 OnChange = SearchEditChange OnKeyPress = SearchEditKeyPress OnKeyUp = SearchEditKeyUp end object SelectAllButton: TBitBtn Left = 294 Top = 4 Width = 69 Height = 24 Action = SelectAllAction Anchors = [akTop, akRight] Caption = 'Select' ModalResult = 8 TabOrder = 1 end object ResizeButton: TBitBtn Left = 363 Top = 4 Width = 28 Height = 24 Action = ChangeModeAction Anchors = [akTop, akRight] TabOrder = 2 Glyph.Data = { 36040000424D3604000000000000360000002800000010000000100000000100 2000000000000004000000000000000000000000000000000000FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00CEA58C00AD734200AD734200AD734200AD734200AD73 4200734A2900FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00CEA58C00AD734200AD734200AD734200734A 2900FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00CEA58C00AD734200734A2900FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00AD734200FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000808 0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF0008080000FF00FF00FF00FF00FF00FF000808 0000080800000808000008080000080800000808000008080000080800000808 000008080000080800000808000008080000FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000808 0000080800000808000008080000080800000808000008080000080800000808 000008080000080800000808000008080000FF00FF00FF00FF00FF00FF000808 0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF0008080000FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00AD734200FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00CEA58C00B57B4A00734A2900FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00CEA58C00AD734200AD734200AD734200734A 2900FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00CEA58C00AD734200AD734200AD734200AD734200AD73 4200734A2900FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00 FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00} end end object TreePanel: TPanel Left = 0 Top = 32 Width = 396 Height = 327 Align = alClient BevelOuter = bvNone Caption = 'TreePanel' TabOrder = 1 DesignSize = ( 396 327) object TreeView: TTreeView Left = 4 Top = -1 Width = 388 Height = 305 Anchors = [akLeft, akTop, akRight, akBottom] DragMode = dmAutomatic HideSelection = False Indent = 19 ReadOnly = True TabOrder = 0 OnClick = TreeViewClick OnKeyUp = TreeViewKeyUp end object BottomPanel: TPanel Left = 0 Top = 309 Width = 396 Height = 18 Align = alBottom BevelOuter = bvNone TabOrder = 1 object StayOnTopCheckBox: TCheckBox Left = 4 Top = 0 Width = 100 Height = 13 Caption = 'Stay on &top' TabOrder = 0 OnClick = StayOnTopCheckBoxClick end object ExactNameCheckBox: TCheckBox Left = 99 Top = 0 Width = 100 Height = 13 Caption = 'Exact &name' TabOrder = 1 OnClick = ExactCheckBoxClick end object ExactTypeCheckBox: TCheckBox Left = 204 Top = 0 Width = 100 Height = 13 Caption = 'Exact &type' TabOrder = 2 OnClick = ExactCheckBoxClick end end end object ActionList: TActionList Images = dmSharedImages.Images OnUpdate = ActionListUpdate Left = 96 Top = 72 object SelectAllAction: TAction Caption = 'Select' ShortCut = 16449 OnExecute = SelectAllActionExecute end object ChangeModeAction: TAction ImageIndex = 13 OnExecute = ChangeModeActionExecute OnHint = ChangeModeActionHint end end end Index: GX_SharedImages.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/GX_SharedImages.pas,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- GX_SharedImages.pas 5 Apr 2005 10:15:22 -0000 1.7 +++ GX_SharedImages.pas 22 Sep 2006 00:06:22 -0000 1.8 @@ -15,12 +15,15 @@ const ImageIndexNew = 10; + ImageIndexExpand = 12; + ImageIndexContract = 13; ImageIndexTrash = 30; ImageIndexFunction = 29; ImageIndexGear = 28; ImageIndexClosedFolder = 21; ImageIndexOpenFolder = 22; ImageIndexDocument = 23; + ImageIndexArrow = 43; ImageIndexCheck = 46; ImageIndexBlank = 47; ImageIndexVisibility = 53; --- NEW FILE: GX_SelectComponents.pas --- unit GX_SelectComponents; {$I GX_CondDefine.inc} // TODO: Prevent selecting a VCL form + components, since it isn't actually possible interface uses Classes, Forms, Controls, ExtCtrls, ToolsAPI, ComCtrls, StdCtrls, Dialogs, ActnList, ImgList, Graphics, Buttons, DesignWindows; type TComponentInfo = record rName: WideString; rType: WideString; end; TSelectComponentsForm = class(TForm) TreeView: TTreeView; ActionList: TActionList; FindPanel: TPanel; SearchEdit: TEdit; StayOnTopCheckBox: TCheckBox; SelectAllButton: TBitBtn; SelectAllAction: TAction; BottomPanel: TPanel; ExactNameCheckBox: TCheckBox; ExactTypeCheckBox: TCheckBox; TreePanel: TPanel; ResizeButton: TBitBtn; ChangeModeAction: TAction; FilterLabel: TLabel; procedure TreeViewClick(aSender: TObject); procedure TreeViewKeyUp(aSender: TObject; var aKey: Word; aShift: TShiftState); procedure SearchEditChange(aSender: TObject); procedure FormActivate(Sender: TObject); procedure StayOnTopCheckBoxClick(Sender: TObject); procedure SelectAllActionExecute(Sender: TObject); procedure SearchEditKeyUp(Sender: TObject; var aKey: Word; Shift: TShiftState); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure SearchEditKeyPress(Sender: TObject; var aKey: Char); procedure ExactCheckBoxClick(Sender: TObject); procedure ChangeModeActionExecute(Sender: TObject); procedure ActionListUpdate(Action: TBasicAction; var Handled: Boolean); procedure ChangeModeActionHint(var HintStr: String; var CanShow: Boolean); private FNodesList: TList; FCurrentNode: TTreeNode; FFormEditor: IOTAFormEditor; FMiniMode: Boolean; FStayOnTop: Boolean; FLastHeight: Integer; procedure Init; procedure FocusSearchEdit; procedure ChangeMode(const aMiniMode: Boolean); procedure ChildComponentCallback(aParam: Pointer; aComponent: IOTAComponent; var aResult: Boolean); procedure SelectCurrentComponent; procedure FillTreeView(const aFromComponent: IOTAComponent); procedure SelectComponentOnForm(const aName: WideString; const aAddToSelection: Boolean = False); procedure SetCurrentNode(const aNode: TTreeNode); procedure FindNextNode; procedure FindPrevNode; procedure FilterNodes(const aFilter: TComponentInfo); procedure SetStayOnTop(const aStayOnTop: Boolean); protected property CurrentNode: TTreeNode read FCurrentNode write SetCurrentNode; public procedure AfterConstruction; override; procedure BeforeDestruction; override; property MiniMode: Boolean read FMiniMode write ChangeMode; property StayOnTop: Boolean read FStayOnTop write SetStayOnTop; property LastHeight: Integer read FLastHeight; end; implementation {$R *.dfm} uses SysUtils, Windows, Messages, TypInfo, GX_Experts, GX_GxUtils, GX_GenericUtils, GX_OtaUtils, GX_SharedImages, GX_ConfigurationInfo; type TComponentSelectExpert = class(TGX_Expert) protected procedure UpdateAction(aAction: TCustomAction); override; public class function GetName: string; override; function GetActionCaption: string; override; procedure Click(aSender: TObject); override; function HasConfigOptions: Boolean; override; end; var TheForm: TSelectComponentsForm; Filter: TComponentInfo; LastComponentName: WideString; procedure GetInfo(const aTreeNode: TTreeNode; const aGetType: Boolean; var aInfo: TComponentInfo); overload; var aPos: Integer; begin with aInfo do begin rName := UpperCase(aTreeNode.Text); aPos := Pos(' : ', rName); if aPos > 0 then begin if aGetType then rType := Copy(rName, aPos + 3, Length(rName)); rName := Copy(rName, 1, aPos - 1); end; end; end; function GetInfo(const aText: WideString): TComponentInfo; overload; var aPos: Integer; begin with Result do begin rName := UpperCase(aText); aPos := Pos(':', rName); if aPos > 0 then begin rType := Trim(Copy(rName, aPos + 1, Length(rName))); rName := Trim(Copy(rName, 1, aPos - 1)); end; end; end; function FilterToText(const aFilter: TComponentInfo) : WideString; begin with aFilter do begin Result := rName; if rType <> '' then Result := Result + ':' + rType; end; end; procedure TSelectComponentsForm.SelectComponentOnForm(const aName: WideString; const aAddToSelection: Boolean); var aComponent: IOTAComponent; begin aComponent := FFormEditor.FindComponent(aName); TreeView.MultiSelect := aAddToSelection; if Assigned(aComponent) then begin LastComponentName := aName; aComponent.Select(aAddToSelection); end; end; procedure TSelectComponentsForm.SelectCurrentComponent; var aInfo: TComponentInfo; begin if Assigned(FFormEditor) and Assigned(TreeView.Selected) then begin GetInfo(TreeView.Selected, False, aInfo); SelectComponentOnForm(aInfo.rName); end; end; procedure TSelectComponentsForm.SelectAllActionExecute(Sender: TObject); var aIndex: Integer; aNode: TTreeNode; aInfo: TComponentInfo; begin for aIndex := 0 to Pred(FNodesList.Count) do begin aNode := FNodesList [aIndex]; GetInfo(aNode, False, aInfo); SelectComponentOnForm(aInfo.rName, aIndex > 0); end; TreeView.Select(FNodesList); end; procedure TSelectComponentsForm.SetCurrentNode(const aNode: TTreeNode); begin if FNodesList.Count > 0 then begin FCurrentNode := aNode; if not Assigned(FCurrentNode) or (FNodesList.IndexOf(FCurrentNode) < 0) then FCurrentNode := FNodesList.First; TreeView.Select(FCurrentNode); SelectCurrentComponent; end else FCurrentNode := nil; if Assigned(FCurrentNode) then SearchEdit.Font.Color := clBlack else SearchEdit.Font.Color := clRed; end; procedure TSelectComponentsForm.AfterConstruction; begin inherited; FNodesList := TList.Create; end; procedure TSelectComponentsForm.BeforeDestruction; begin FreeAndNil(FNodesList); inherited; end; procedure TSelectComponentsForm.ChangeMode(const aMiniMode: Boolean); var BestFitHeight: Integer; begin if aMiniMode = FMiniMode then Exit; FMiniMode := aMiniMode; if FMiniMode then FLastHeight := Height; TreePanel.Visible := not FMiniMode; if FMiniMode then begin ChangeModeAction.ImageIndex := ImageIndexExpand; // The above fails to change the image in D6 at least ResizeButton.Glyph.Assign(nil); GetSharedImageList.GetBitmap(ImageIndexExpand, ResizeButton.Glyph); BestFitHeight := Height - ClientHeight + FindPanel.Height; Constraints.MinHeight := BestFitHeight; Constraints.MaxHeight := BestFitHeight; ClientHeight := FindPanel.Height; end else begin Constraints.MinHeight := 175; Constraints.MaxHeight := 0; Height := FLastHeight; ChangeModeAction.ImageIndex := ImageIndexContract; ResizeButton.Glyph.Assign(nil); GetSharedImageList.GetBitmap(ImageIndexContract, ResizeButton.Glyph); end; FocusSearchEdit; end; procedure TSelectComponentsForm.ChangeModeActionExecute(Sender: TObject); begin MiniMode := not MiniMode; end; procedure TSelectComponentsForm.ChildComponentCallback(aParam: Pointer; aComponent: IOTAComponent; var aResult: Boolean); var aTreeNode: TTreeNode; aName: WideString; begin aName := GxOtaGetComponentName(aComponent); aTreeNode := TreeView.Items.AddChildObject(TTreeNode(aParam), aName + ' : ' + aComponent.GetComponentType, nil); aComponent.GetChildren(aTreeNode, ChildComponentCallback); aResult := True; end; procedure TSelectComponentsForm.ExactCheckBoxClick(Sender: TObject); begin FocusSearchEdit; FilterNodes(Filter); end; procedure TSelectComponentsForm.FillTreeView(const aFromComponent: IOTAComponent); begin if TreeView.Items.GetFirstNode <> nil then aFromComponent.GetChildren(TreeView.Items.GetFirstNode, ChildComponentCallback); end; procedure TSelectComponentsForm.FilterNodes(const aFilter: TComponentInfo); var aByName: Boolean; aByType: Boolean; aExactName: Boolean; aExactType: Boolean; aNameMatch: Boolean; aTypeMatch: Boolean; aNodeIndex: Integer; aTreeNode: TTreeNode; aInfo: TComponentInfo; aFound: Boolean; begin FNodesList.Clear; TreeView.Items.BeginUpdate; try aByName := aFilter.rName <> ''; aByType := aFilter.rType <> ''; aExactName := ExactNameCheckBox.Checked; aExactType := ExactTypeCheckBox.Checked; for aNodeIndex := 0 to Pred(TreeView.Items.Count) do begin aTreeNode := TreeView.Items [aNodeIndex]; GetInfo(aTreeNode, aByType, aInfo); aNameMatch := aByName and (not aExactName and (Pos(aFilter.rName, aInfo.rName) > 0) or (aExactName and SameText(aFilter.rName, aInfo.rName))); aTypeMatch := aByType and (not aExactType and (Pos(aFilter.rType, aInfo.rType) > 0) or (aExactType and SameText(aFilter.rType, aInfo.rType))); aFound := (aByName and not aByType and aNameMatch) or (not aByName and aByType and aTypeMatch) or (aByName and aByType and aNameMatch and aTypeMatch); if aFound then FNodesList.Add(aTreeNode); if aFound then // Images disabled for now since D6 fails to show the right images, set StateIndex as well aTreeNode.ImageIndex := ImageIndexArrow else aTreeNode.ImageIndex := -1; end; finally TreeView.Items.EndUpdate; end; CurrentNode := CurrentNode; end; procedure TSelectComponentsForm.SearchEditChange(aSender: TObject); begin Filter := GetInfo(SearchEdit.Text); FilterNodes(Filter); end; procedure TSelectComponentsForm.SearchEditKeyPress(Sender: TObject; var aKey: Char); var aReset : Boolean; begin aReset := True; case Ord(aKey) of VK_RETURN: SelectAllAction.Execute; VK_ESCAPE: ; VK_SPACE: SearchEdit.Clear; else aReset := False; end; if aReset then aKey := Chr(0); end; procedure TSelectComponentsForm.SearchEditKeyUp(Sender: TObject; var aKey: Word; Shift: TShiftState); var aReset: Boolean; begin aReset := True; case aKey of VK_UP: FindPrevNode; VK_DOWN: FindNextNode; else aReset := False; end; if aReset then aKey := 0; end; procedure TSelectComponentsForm.FindNextNode; var aNodeIndex : Integer; begin if FNodesList.Count <= 0 then begin CurrentNode := nil; Exit; end; aNodeIndex := FNodesList.IndexOf(CurrentNode); if (aNodeIndex > -1) and (aNodeIndex < Pred(FNodesList.Count)) then begin Inc(aNodeIndex); CurrentNode := FNodesList[aNodeIndex]; end else CurrentNode := FNodesList.First; end; procedure TSelectComponentsForm.FindPrevNode; var aNodeIndex: Integer; begin if FNodesList.Count <= 0 then begin CurrentNode := nil; Exit; end; aNodeIndex := FNodesList.IndexOf(CurrentNode); if (aNodeIndex > 0) and (aNodeIndex < FNodesList.Count) then begin Dec(aNodeIndex); CurrentNode := FNodesList[aNodeIndex]; end else CurrentNode := FNodesList.Last; end; procedure TSelectComponentsForm.FormKeyPress(Sender: TObject; var Key: Char); begin if Key = Chr(VK_ESCAPE) then begin Key := #0; Close; end; end; procedure TSelectComponentsForm.FocusSearchEdit; begin if SearchEdit.CanFocus then SearchEdit.SetFocus; end; procedure TSelectComponentsForm.FormActivate(Sender: TObject); var aName: WideString; aInfo: TComponentInfo; aNodeIndex: Integer; aTreeNode: TTreeNode; begin with Filter do try Init; aName := LastComponentName; FocusSearchEdit; SearchEdit.Text := FilterToText(Filter); SearchEdit.SelectAll; SearchEditChange(SearchEdit); for aNodeIndex := 0 to Pred(TreeView.Items.Count) do begin aTreeNode := TreeView.Items[aNodeIndex]; GetInfo(aTreeNode, False, aInfo); if aName = aInfo.rName then begin CurrentNode := aTreeNode; Exit; end; end; except end; end; procedure TComponentSelectExpert.UpdateAction(aAction: TCustomAction); begin aAction.Enabled := GxOtaCurrentlyEditingForm; end; procedure TComponentSelectExpert.Click(aSender: TObject); begin if not Assigned(TheForm) then TheForm := TSelectComponentsForm.Create(nil); TheForm.Show; end; function TComponentSelectExpert.GetActionCaption: string; resourcestring SMenuCaption = 'Select Components...'; begin Result := SMenuCaption; end; class function TComponentSelectExpert.GetName: string; begin Result := 'SelectComponents'; end; function TComponentSelectExpert.HasConfigOptions: Boolean; begin Result := False; end; function GxOtaGetCurrentModule: IOTAModule; var ModuleServices: IOTAModuleServices; begin ModuleServices := BorlandIDEServices as IOTAModuleServices; Assert(Assigned(ModuleServices)); Result := ModuleServices.CurrentModule; end; procedure TSelectComponentsForm.Init; var aParentName: WideString; aParentType: WideString; aComponent: IOTAComponent; begin TreeView.Items.BeginUpdate; try FNodesList.Clear; SearchEdit.Enabled := False; TreeView.Items.Clear; if not GxOtaCurrentlyEditingForm then Abort; FFormEditor := GxOtaGetFormEditorFromModule(GxOtaGetCurrentModule); if not Assigned(FFormEditor) then Abort; aComponent := FFormEditor.GetRootComponent; if not Assigned(aComponent) then Abort; aParentType := aComponent.GetComponentType; aParentName := GxOtaGetComponentName(aComponent); TreeView.Items.Add(nil, aParentName + ' : ' + aParentType); FillTreeView(aComponent); TreeView.FullExpand; TreeView.Selected := TreeView.Items.GetFirstNode; TreeView.Selected.MakeVisible; SearchEdit.Enabled := True; finally TreeView.Items.EndUpdate; end; end; procedure TSelectComponentsForm.SetStayOnTop(const aStayOnTop : Boolean); begin if aStayOnTop = FStayOnTop then Exit; FStayOnTop := aStayOnTop; if FStayOnTop then FormStyle := fsStayOnTop else FormStyle := fsNormal; StayOnTopCheckBox.Checked := FStayOnTop; FocusSearchEdit; end; procedure TSelectComponentsForm.StayOnTopCheckBoxClick(Sender: TObject); begin StayOnTop := StayOnTopCheckBox.Checked; end; procedure TSelectComponentsForm.TreeViewClick(aSender: TObject); begin SelectCurrentComponent; end; procedure TSelectComponentsForm.TreeViewKeyUp(aSender: TObject; var aKey: Word; aShift: TShiftState); begin SelectCurrentComponent; end; procedure TSelectComponentsForm.ActionListUpdate(Action: TBasicAction; var Handled: Boolean); begin SelectAllAction.Enabled := FNodesList.Count > 0; if SelectAllAction.Enabled then SelectAllAction.Caption := '&Select ' + IntToStr(FNodesList.Count) else SelectAllAction.Caption := 'Select'; end; procedure TSelectComponentsForm.ChangeModeActionHint(var HintStr: String; var CanShow: Boolean); begin if FMiniMode then HintStr := 'Expand' else HintStr := 'Contract'; end; initialization RegisterGX_Expert(TComponentSelectExpert); finalization FreeAndNil(TheForm); end. |
From: Erik B. <eb...@us...> - 2006-09-18 16:09:25
|
Update of /cvsroot/gexperts/gexperts/unstable/Comps In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv29901/Comps Modified Files: GpStructuredStorage.pas Log Message: Version 1.10c minor root path parsing update from Primoz Index: GpStructuredStorage.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Comps/GpStructuredStorage.pas,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- GpStructuredStorage.pas 20 Jul 2006 10:09:45 -0000 1.7 +++ GpStructuredStorage.pas 18 Sep 2006 16:09:19 -0000 1.8 @@ -32,11 +32,14 @@ Author : Primoz Gabrijelcic Creation date : 2003-11-10 - Last modification : 2006-07-20 - Version : 1.10b + Last modification : 2006-09-17 + Version : 1.10c </pre>*)(* History: - 1.10b: + 1.10c: 2006-09-17 + - FileInfo['/'] was not working. Fixed. (FileInfo['/'] is equivalent to FileInfo[''].) + - Backslashes were not converted to slashes in FileInfo. Fixed. + 1.10b: 2006-07-20 - Memory leak fixed: Internal objects representing folders were never freed. 1.10a: 2006-01-30 - Fixed TGpStructuredStorage.Delete to not unnecessary auto-create parent folders. @@ -106,6 +109,10 @@ Classes, GpLists; +const + //:Structured storage path delimiter. + CFolderDelim = '/'; + type {:Structured storage exception class. @since 2004-01-08 @@ -211,7 +218,6 @@ CBlockSize = 1024 {bytes}; CFATEntriesPerBlock = CBlockSize div 4; - CFolderDelim = '/'; CSignature = 'GpStructuredStorage file'#13#10#26#0; //Numerical attribute representation. When changing, modify methods NumToAttributes and AttributesToNum. @@ -251,7 +257,7 @@ [0:2] FILE_INFO: - [file length:2] + [file name length:2] [file name:1..65535] [file attributes:ATTRIBUTES:4] [file length:4] // 4 GB per file @@ -1956,7 +1962,7 @@ @since 2004-02-14 } procedure TGpStructuredFAT.Resolve(firstBlock: cardinal; offset: integer; - var block, blockOffset: cardinal); + var block, blockOffset: cardinal); begin block := firstBlock; blockOffset := offset; @@ -2524,26 +2530,32 @@ {:Returns file information interface @since 2004-02-18 -} +} function TGpStructuredStorage.GetFileInfo(const fileName: string): IGpStructuredFileInfo; var folder : string; name : string; + normName : string; stgFolder: TGpStructuredFolder; begin if fileName = '' then Result := CreateFileInfo(self, gssRootFolder, '') else begin - Result := nil; - if FolderExists(fileName) then - SplitFileName(StripTrailingDelimiter(fileName), folder, name) - else - SplitFileName(fileName, folder, name); - stgFolder := DescendTree(folder); - try - if stgFolder.ObjectExists(name) then - Result := CreateFileInfo(self, stgFolder, name); - finally ReleaseFolder(stgFolder); end; + normName := NormalizeFileName(fileName); + if normName = CFolderDelim then + Result := CreateFileInfo(self, gssRootFolder, '') + else begin + Result := nil; + if FolderExists(normName) then + SplitFileName(StripTrailingDelimiter(normName), folder, name) + else + SplitFileName(normName, folder, name); + stgFolder := DescendTree(folder); + try + if stgFolder.ObjectExists(name) then + Result := CreateFileInfo(self, stgFolder, name); + finally ReleaseFolder(stgFolder); end; + end; end; end; { TGpStructuredStorage.GetFileInfo } |
From: Erik B. <eb...@us...> - 2006-09-06 07:53:36
|
Update of /cvsroot/gexperts/gexperts/unstable/Src In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv504/Src Modified Files: GX_IdeShortCuts.pas Log Message: Reinit the shortcuts on process debug state and active project change notifications This seems to fix most missed IDE shortcut changes except for manual desktop changes Index: GX_IdeShortCuts.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/GX_IdeShortCuts.pas,v retrieving revision 1.41 retrieving revision 1.42 diff -u -d -r1.41 -r1.42 --- GX_IdeShortCuts.pas 10 Jul 2006 21:20:37 -0000 1.41 +++ GX_IdeShortCuts.pas 6 Sep 2006 07:53:34 -0000 1.42 @@ -47,13 +47,18 @@ private FOldShortCuts: TStringList; FPackageNotifier: TBaseIdeNotifier; + FUpdateTimer: TTimer; + FUpdateCount: Integer; + FProcessNotifier: TBaseDebuggerNotifier; + procedure OnUpdateTimer(Sender: TObject); procedure ReadFromRegistryIDE; procedure ResetShortCuts; procedure InitializeShortCutExpert; procedure FinalizeShortCutExpert; protected procedure SetActive(New: Boolean); override; + procedure QueueReinitializeShortcuts; public destructor Destroy; override; function GetActionCaption: string; override; @@ -75,9 +80,6 @@ TPackageLoadingNotifier = class(TBaseIdeNotifier) private FShortCutExpert: TShortCutExpert; - FUpdateTimer: TTimer; - FUpdateCount: Integer; - procedure OnUpdateTimer(Sender: TObject); public procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean); override; @@ -85,6 +87,16 @@ destructor Destroy; override; end; + TProcessNotifier = class(TBaseDebuggerNotifier) + private + FShortCutExpert: TShortCutExpert; + public + constructor Create(const AClient: TShortCutExpert); + procedure ProcessCreated({$IFDEF GX_VER170_up} const {$ENDIF} Process: IOTAProcess); override; + procedure ProcessDestroyed({$IFDEF GX_VER170_up} const {$ENDIF} Process: IOTAProcess); override; + destructor Destroy; override; + end; + function FindMenuByName(AMenuItem: TMenuItem; const Name: string): TMenuItem; var j: Integer; @@ -421,15 +433,22 @@ begin FinalizeShortCutExpert; - inherited Destroy; + inherited; end; procedure TShortCutExpert.FinalizeShortCutExpert; begin + if Assigned(FUpdateTimer) then + FUpdateTimer.Enabled := False; + FreeAndNil(FUpdateTimer); if Assigned(FPackageNotifier) then FPackageNotifier.RemoveNotifierFromIDE; + if Assigned(FProcessNotifier) then + FProcessNotifier.RemoveNotifierFromIDE; + // The IDE destroys the notifier for us (tested in D5/D7) FPackageNotifier := nil; + FProcessNotifier := nil; // Restore old shortcut settings ResetShortCuts; @@ -465,6 +484,23 @@ FPackageNotifier := TPackageLoadingNotifier.Create(Self); FPackageNotifier.AddNotifierToIDE; + + FProcessNotifier := TProcessNotifier.Create(Self); + FProcessNotifier.AddNotifierToIDE; + + FUpdateTimer := TTimer.Create(nil); + FUpdateTimer.Enabled := False; + FUpdateTimer.Interval := 5000; + FUpdateTimer.OnTimer := OnUpdateTimer; +end; + +procedure TShortCutExpert.QueueReinitializeShortcuts; +begin + // Restart the timer delay before updating the shortcuts. + // This prevents us from updating constantly during startup, etc. + FUpdateTimer.Enabled := False; + FUpdateCount := 0; + FUpdateTimer.Enabled := True; end; // Read shortcut settings from the registry and apply to the menu @@ -574,6 +610,18 @@ end; end; +procedure TShortCutExpert.OnUpdateTimer(Sender: TObject); +begin + Inc(FUpdateCount); + {$IFOPT D+} SendDebug('IDE shortcut update timer expired, calling ReadFromRegistryIDE. Update Count: ' + IntToStr(FUpdateCount)); {$ENDIF} + if FUpdateCount >= 3 then + FUpdateTimer.Enabled := False; + if Application.Terminated then + Exit; + ReadFromRegistryIDE; + {$IFOPT D+} SendDebug('Done processing IDE shortcut updates'); {$ENDIF} +end; + { TPackageLoadingNotifier } constructor TPackageLoadingNotifier.Create(const AClient: TShortCutExpert); @@ -582,47 +630,22 @@ Assert(Assigned(AClient)); FShortCutExpert := AClient; - FUpdateTimer := TTimer.Create(nil); - FUpdateTimer.Enabled := False; - FUpdateTimer.Interval := 5000; - FUpdateTimer.OnTimer := OnUpdateTimer; end; destructor TPackageLoadingNotifier.Destroy; begin - if Assigned(FUpdateTimer) then - FUpdateTimer.Enabled := False; - FreeAndNil(FUpdateTimer); FShortCutExpert.FPackageNotifier := nil; - inherited Destroy; + inherited; end; procedure TPackageLoadingNotifier.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean); begin // Re-assign shortcuts if a package (which may contain - // experts with hotkeys) has been loaded. - // No need to detect unload - we are not interested in what's vanishing - if NotifyCode = ofnPackageInstalled then - begin - // Restart the timer delay before updating the shortcuts. - // This prevents us from updating constantly during startup, etc. - FUpdateTimer.Enabled := False; - FUpdateCount := 0; - FUpdateTimer.Enabled := True; - end; -end; - -procedure TPackageLoadingNotifier.OnUpdateTimer(Sender: TObject); -begin - Inc(FUpdateCount); - {$IFOPT D+} SendDebug('IDE shortcut update timer expired, calling ReadFromRegistryIDE. Update Count: ' + IntToStr(FUpdateCount)); {$ENDIF} - if FUpdateCount >= 3 then - FUpdateTimer.Enabled := False; - if Application.Terminated then - Exit; - FShortCutExpert.ReadFromRegistryIDE; - {$IFOPT D+} SendDebug('Done processing IDE shortcut updates'); {$ENDIF} + // experts with hotkeys) or project has been loaded. BDS 2006 resets shortcuts + // in lots of situations, but this detects most of them. + if NotifyCode in [ofnPackageInstalled, ofnActiveProjectChanged] then + FShortCutExpert.QueueReinitializeShortcuts; end; procedure TfmIdeShortCuts.FormCreate(Sender: TObject); @@ -639,6 +662,33 @@ lblShortCut.FocusControl := hkShortCut; end; +{ TProcessNotifier } + +constructor TProcessNotifier.Create(const AClient: TShortCutExpert); +begin + inherited Create; + Assert(Assigned(AClient)); + FShortCutExpert := AClient; +end; + +destructor TProcessNotifier.Destroy; +begin + FShortCutExpert.FProcessNotifier := nil; + inherited; +end; + +procedure TProcessNotifier.ProcessCreated({$IFDEF GX_VER170_up} const {$ENDIF} Process: IOTAProcess); +begin + inherited; + FShortCutExpert.QueueReinitializeShortcuts; +end; + +procedure TProcessNotifier.ProcessDestroyed({$IFDEF GX_VER170_up} const {$ENDIF} Process: IOTAProcess); +begin + inherited; + FShortCutExpert.QueueReinitializeShortcuts; +end; + initialization RegisterGX_Expert(TShortCutExpert); |
From: Erik B. <eb...@us...> - 2006-09-06 07:51:32
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Utils In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv31344/Src/Utils Modified Files: GX_OtaUtils.pas Log Message: Add TBaseDebuggerNotifier class and related debugger services routines Index: GX_OtaUtils.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Utils/GX_OtaUtils.pas,v retrieving revision 1.194 retrieving revision 1.195 diff -u -d -r1.194 -r1.195 --- GX_OtaUtils.pas 1 Sep 2006 20:58:56 -0000 1.194 +++ GX_OtaUtils.pas 6 Sep 2006 07:49:52 -0000 1.195 @@ -239,8 +239,9 @@ // Ses if the IDE is curently debugging an application function GxOtaCurrentlyDebugging: Boolean; -// Get the IDE services interface. Succeeds or raises an exception. +// Get an IDE services interface. Succeeds or raises an exception. function GxOtaGetIDEServices: IOTAServices; +function GxOtaGetDebuggerServices: IOTADebuggerServices; // Determine if we are currently editing a VCL/CLX/NFM function GxOtaGetActiveDesignerType: string; @@ -564,6 +565,20 @@ destructor Destroy; override; end; + TBaseDebuggerNotifier = class(TNotifierObject, IOTADebuggerNotifier) + private + FNotifierIndex: Integer; + public + function AddNotifierToIDE: Boolean; + function RemoveNotifierFromIDE: Boolean; + destructor Destroy; override; + // IOTADebuggerNotifier + procedure BreakpointAdded({$IFDEF GX_VER170_up} const {$ENDIF} Breakpoint: IOTABreakpoint); virtual; + procedure BreakpointDeleted({$IFDEF GX_VER170_up} const {$ENDIF} Breakpoint: IOTABreakpoint); virtual; + procedure ProcessCreated({$IFDEF GX_VER170_up} const {$ENDIF} Process: IOTAProcess); virtual; + procedure ProcessDestroyed({$IFDEF GX_VER170_up} const {$ENDIF} Process: IOTAProcess); virtual; + end; + EStandAloneUsage = class(Exception); const @@ -858,6 +873,13 @@ raise Exception.Create('IOTAServices not implemented'); end; +function GxOtaGetDebuggerServices: IOTADebuggerServices; +begin + Result := BorlandIDEServices as IOTADebuggerServices; + if not Assigned(Result) then + raise Exception.Create('IOTADebuggerServices not implemented'); +end; + function GxOtaGetActiveDesignerType: string; begin if RunningLinux then @@ -4050,6 +4072,53 @@ inherited Destroy; end; +{ TBaseDebuggerNotifier } + +function TBaseDebuggerNotifier.AddNotifierToIDE: Boolean; +begin + FNotifierIndex := GxOtaGetDebuggerServices.AddNotifier(Self); + Result := (FNotifierIndex <> InvalidNotifierIndex); +end; + +function TBaseDebuggerNotifier.RemoveNotifierFromIDE: Boolean; +var + SavedIndex: Integer; +begin + Result := False; + if FNotifierIndex = InvalidNotifierIndex then + Exit; + SavedIndex := FNotifierIndex; + FNotifierIndex := InvalidNotifierIndex; + GxOtaGetDebuggerServices.RemoveNotifier(SavedIndex); + Result := True; +end; + +destructor TBaseDebuggerNotifier.Destroy; +begin + RemoveNotifierFromIDE; + inherited; +end; + +procedure TBaseDebuggerNotifier.BreakpointAdded({$IFDEF GX_VER170_up} const {$ENDIF} Breakpoint: IOTABreakpoint); +begin + // Nothing +end; + +procedure TBaseDebuggerNotifier.BreakpointDeleted({$IFDEF GX_VER170_up} const {$ENDIF} Breakpoint: IOTABreakpoint); +begin + // Nothing +end; + +procedure TBaseDebuggerNotifier.ProcessCreated({$IFDEF GX_VER170_up} const {$ENDIF} Process: IOTAProcess); +begin + // Nothing +end; + +procedure TBaseDebuggerNotifier.ProcessDestroyed({$IFDEF GX_VER170_up} const {$ENDIF} Process: IOTAProcess); +begin + // Nothing +end; + initialization finalization |
From: Erik B. <eb...@us...> - 2006-09-01 21:04:28
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Grep In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv31256/Src/Grep Modified Files: GX_GrepBackend.pas Log Message: Scan the DPR as the project file under BDS 200x Index: GX_GrepBackend.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Grep/GX_GrepBackend.pas,v retrieving revision 1.38 retrieving revision 1.39 diff -u -d -r1.38 -r1.39 --- GX_GrepBackend.pas 25 Jan 2006 06:23:22 -0000 1.38 +++ GX_GrepBackend.pas 1 Sep 2006 21:02:23 -0000 1.39 @@ -301,7 +301,8 @@ Exit; FSearchRoot := ExtractFilePath(Project.FileName); - GrepFile(Project.FileName); + GrepFile(GxOtaGetProjectFileName(Project, True)); + for i := 0 to Project.GetModuleCount - 1 do begin GrepFile(Project.GetModule(i).GetFileName); |
From: Erik B. <eb...@us...> - 2006-09-01 21:02:31
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/ToDo In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv31256/Src/ToDo Modified Files: GX_ToDo.pas Log Message: Scan the DPR as the project file under BDS 200x Index: GX_ToDo.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/ToDo/GX_ToDo.pas,v retrieving revision 1.54 retrieving revision 1.55 diff -u -d -r1.54 -r1.55 --- GX_ToDo.pas 5 Jul 2006 13:54:33 -0000 1.54 +++ GX_ToDo.pas 1 Sep 2006 21:02:23 -0000 1.55 @@ -366,7 +366,7 @@ else FProjectFileName := GxOtaGetCurrentProjectFileName; - ScanFile(Project.FileName); + ScanFile(GxOtaGetProjectFileName(Project, True)); for i := 0 to Project.GetModuleCount-1 do begin ModuleInfo := Project.GetModule(i); |
From: Erik B. <eb...@us...> - 2006-09-01 20:59:01
|
Update of /cvsroot/gexperts/gexperts/unstable/Src/Utils In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv29512/Src/Utils Modified Files: GX_OtaUtils.pas Log Message: function GxOtaGetProjectPersonality(Project: IOTAProject): string; function GxOtaProjectIsDotNet(Project: IOTAProject): Boolean; function GxOtaProjectIsDelphiDotNet(Project: IOTAProject): Boolean; function GxOtaProjectIsNativeCpp(Project: IOTAProject): Boolean; function GxOtaProjectIsNativeDelphi(Project: IOTAProject): Boolean; function GxOtaProjectIsEitherDelphi(Project: IOTAProject): Boolean; function GxOtaProjectIsCSharp(Project: IOTAProject): Boolean; function GxOtaGetProjectFileName(Project: IOTAProject; NormalizeBdsProj: Boolean = False): string; Index: GX_OtaUtils.pas =================================================================== RCS file: /cvsroot/gexperts/gexperts/unstable/Src/Utils/GX_OtaUtils.pas,v retrieving revision 1.193 retrieving revision 1.194 diff -u -d -r1.193 -r1.194 --- GX_OtaUtils.pas 28 Jul 2006 02:52:56 -0000 1.193 +++ GX_OtaUtils.pas 1 Sep 2006 20:58:56 -0000 1.194 @@ -248,15 +248,23 @@ function GxOtaActiveDesignerIsCLX: Boolean; function GxOtaActiveDesignerIsNFM: Boolean; -// Get the personality identifier string for the current project, or blank for none +// Get the personality identifier string for the project, or blank for none +function GxOtaGetProjectPersonality(Project: IOTAProject): string; function GxOtaGetCurrentProjectPersonality: string; -// See if the current project is a .NET project -function GxOtaCurrentProjectIsDotNet: Boolean; +// See if a project is of a specific personality +function GxOtaProjectIsDotNet(Project: IOTAProject): Boolean; +function GxOtaProjectIsDelphiDotNet(Project: IOTAProject): Boolean; +function GxOtaProjectIsNativeCpp(Project: IOTAProject): Boolean; +function GxOtaProjectIsNativeDelphi(Project: IOTAProject): Boolean; +function GxOtaProjectIsEitherDelphi(Project: IOTAProject): Boolean; +function GxOtaProjectIsCSharp(Project: IOTAProject): Boolean; // See if the current project is of a specific personality +function GxOtaCurrentProjectIsDotNet: Boolean; function GxOtaCurrentProjectIsDelphiDotNet: Boolean; function GxOtaCurrentProjectIsNativeCpp: Boolean; function GxOtaCurrentProjectIsNativeDelphi: Boolean; +function GxOtaCurrentProjectIsEitherDelphi: Boolean; function GxOtaCurrentProjectIsCSharp: Boolean; // Check if the IDE supports a certain personality @@ -281,9 +289,11 @@ // See if there is an active project function GxOtaHaveCurrentProject: Boolean; -// Returns file name of currently active project; returns +// Returns file name of the project; returns // an empty string if there is no (active) project. -function GxOtaGetCurrentProjectFileName: string; +// Use NormalizeBdsProj to get the dpr instead of the bdsproj for Delphi projects +function GxOtaGetProjectFileName(Project: IOTAProject; NormalizeBdsProj: Boolean = False): string; +function GxOtaGetCurrentProjectFileName(NormalizeBdsProj: Boolean = False): string; // Returns the name of the currently active project; returns // an empty string if there is no (active) project. @@ -871,15 +881,12 @@ Result := (GxOtaGetActiveDesignerType = dNFM); end; -function GxOtaGetCurrentProjectPersonality: string; -var - Project: IOTAProject; +function GxOtaGetProjectPersonality(Project: IOTAProject): string; begin Result := ''; - Project := GxOtaGetCurrentProject; if Assigned(Project) then begin - {$IFDEF GX_VER160_up} //Delphi 8+ + {$IFDEF GX_VER160_up} //Delphi 8+ Result := Project.Personality; {$ELSE} // Delphi 7 or earlier if RunningCPPBuilder then @@ -890,29 +897,69 @@ end; end; +function GxOtaGetCurrentProjectPersonality: string; +begin + Result := GxOtaGetProjectPersonality(GxOtaGetCurrentProject); +end; + +function GxOtaProjectIsDotNet(Project: IOTAProject): Boolean; +begin + Result := StringInArray(GxOtaGetProjectPersonality(Project), [sDelphiDotNetPersonality, sCSharpPersonality, sVBPersonality]); +end; + +function GxOtaProjectIsDelphiDotNet(Project: IOTAProject): Boolean; +begin + Result := SameText(GxOtaGetProjectPersonality(Project), sDelphiDotNetPersonality); +end; + +function GxOtaProjectIsNativeCpp(Project: IOTAProject): Boolean; +begin + Result := SameText(GxOtaGetProjectPersonality(Project), sCBuilderPersonality); +end; + +function GxOtaProjectIsNativeDelphi(Project: IOTAProject): Boolean; +begin + Result := SameText(GxOtaGetProjectPersonality(Project), sDelphiPersonality); +end; + +function GxOtaProjectIsEitherDelphi(Project: IOTAProject): Boolean; +begin + Result := StringInArray(GxOtaGetProjectPersonality(Project), [sDelphiPersonality, sDelphiDotNetPersonality]); +end; + +function GxOtaProjectIsCSharp(Project: IOTAProject): Boolean; +begin + Result := SameText(GxOtaGetProjectPersonality(Project), sCSharpPersonality); +end; + function GxOtaCurrentProjectIsDotNet: Boolean; begin - Result := StringInArray(GxOtaGetCurrentProjectPersonality, [sDelphiDotNetPersonality, sCSharpPersonality, sVBPersonality]); + Result := GxOtaProjectIsDotNet(GxOtaGetCurrentProject); end; function GxOtaCurrentProjectIsDelphiDotNet: Boolean; begin - Result := SameText(GxOtaGetCurrentProjectPersonality, sDelphiDotNetPersonality); + Result := GxOtaProjectIsDelphiDotNet(GxOtaGetCurrentProject); end; function GxOtaCurrentProjectIsNativeCpp: Boolean; begin - Result := SameText(GxOtaGetCurrentProjectPersonality, sCBuilderPersonality); + Result := GxOtaProjectIsNativeCpp(GxOtaGetCurrentProject); end; function GxOtaCurrentProjectIsNativeDelphi: Boolean; begin - Result := SameText(GxOtaGetCurrentProjectPersonality, sDelphiPersonality); + Result := GxOtaProjectIsNativeDelphi(GxOtaGetCurrentProject); +end; + +function GxOtaCurrentProjectIsEitherDelphi: Boolean; +begin + Result := GxOtaProjectIsEitherDelphi(GxOtaGetCurrentProject); end; function GxOtaCurrentProjectIsCSharp: Boolean; begin - Result := SameText(GxOtaGetCurrentProjectPersonality, sCSharpPersonality); + Result := GxOtaProjectIsCSharp(GxOtaGetCurrentProject); end; {$IFDEF GX_VER160_up} @@ -986,15 +1033,21 @@ Result := IsIdeEditorForm(Screen.ActiveCustomForm) or IsEditControl(Screen.ActiveControl); end; -function GxOtaGetCurrentProjectFileName: string; -var - CurrentProject: IOTAProject; +function GxOtaGetProjectFileName(Project: IOTAProject; NormalizeBdsProj: Boolean = False): string; begin - CurrentProject := GxOtaGetCurrentProject; - if Assigned(CurrentProject) then - Result := CurrentProject.FileName - else - Result := ''; + Result := ''; + if Assigned(Project) then begin + Result := Project.FileName; + if NormalizeBdsProj and IsBdsproj(Result) then begin + if GxOtaProjectIsEitherDelphi(Project) then + Result := ChangeFileExt(Result, '.dpr'); + end; + end; +end; + +function GxOtaGetCurrentProjectFileName(NormalizeBdsProj: Boolean): string; +begin + Result := GxOtaGetProjectFileName(GxOtaGetCurrentProject, NormalizeBdsProj); end; function GxOtaGetProjectGroup: IOTAProjectGroup; |