ADDED .fossil-settings/binary-glob
Index: .fossil-settings/binary-glob
==================================================================
--- /dev/null
+++ .fossil-settings/binary-glob
@@ -0,0 +1,7 @@
+*.bmp
+*.gif
+*.jpeg
+*.jpg
+*.ico
+*.pdf
+*.png
ADDED .fossil-settings/binary-glob.no-warn
Index: .fossil-settings/binary-glob.no-warn
==================================================================
--- /dev/null
+++ .fossil-settings/binary-glob.no-warn
ADDED .fossil-settings/ignore-glob
Index: .fossil-settings/ignore-glob
==================================================================
--- /dev/null
+++ .fossil-settings/ignore-glob
@@ -0,0 +1,12 @@
+__history/
+__recovery/
+out/
+*.~*
+*.identcache
+*.local
+*.dsk
+*.stat
+*.tvsconfig
+*.dres
+*Resource.rc
+*.res
ADDED .fossil-settings/ignore-glob.no-warn
Index: .fossil-settings/ignore-glob.no-warn
==================================================================
--- /dev/null
+++ .fossil-settings/ignore-glob.no-warn
ADDED img/logo.png
Index: img/logo.png
==================================================================
--- /dev/null
+++ img/logo.png
cannot compute difference between binary files
DELETED src/Delphi10/VCSInfo.dpk
Index: src/Delphi10/VCSInfo.dpk
==================================================================
--- src/Delphi10/VCSInfo.dpk
+++ /dev/null
@@ -1,38 +0,0 @@
-package VCSInfo;
-
-{$R *.res}
-{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
-{$ALIGN 8}
-{$ASSERTIONS ON}
-{$BOOLEVAL OFF}
-{$DEBUGINFO OFF}
-{$EXTENDEDSYNTAX ON}
-{$IMPORTEDDATA ON}
-{$IOCHECKS ON}
-{$LOCALSYMBOLS ON}
-{$LONGSTRINGS ON}
-{$OPENSTRINGS ON}
-{$OPTIMIZATION OFF}
-{$OVERFLOWCHECKS OFF}
-{$RANGECHECKS OFF}
-{$REFERENCEINFO ON}
-{$SAFEDIVIDE OFF}
-{$STACKFRAMES ON}
-{$TYPEDADDRESS OFF}
-{$VARSTRINGCHECKS ON}
-{$WRITEABLECONST OFF}
-{$MINENUMSIZE 1}
-{$IMAGEBASE $400000}
-{$DEFINE DEBUG}
-{$ENDIF IMPLICITBUILDING}
-{$IMPLICITBUILD ON}
-
-requires
- rtl,
- designide;
-
-contains
- VCSInfoMenuWzrd in '..\VCSInfoMenuWzrd.pas',
- u_FinalPathName in '..\u_FinalPathName.pas';
-
-end.
DELETED src/Delphi10/VCSInfo.dproj
Index: src/Delphi10/VCSInfo.dproj
==================================================================
--- src/Delphi10/VCSInfo.dproj
+++ /dev/null
@@ -1,553 +0,0 @@
-
-
- {E394A6F2-CCD7-4A8A-9E66-88F4D866E2FB}
- VCSInfo.dpk
- 18.0
- None
- True
- Debug
- Win32
- 1
- Package
-
-
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Base
- true
-
-
- true
- Cfg_1
- true
- true
-
-
- true
- Base
- true
-
-
-
- false
- false
- All
- true
- true
- VCSInfo
- .\$(Platform)\$(Config)
- .\$(Platform)\$(Config)
- false
- false
- false
- false
- false
- 1033
- ..\Version.optset
-
-
- android-support-v4.dex.jar;apk-expansion.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar
- rtl;$(DCC_UsePackage)
- None
-
-
- true
- Debug
- CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes=
- $(MSBuildProjectName)
- rtl;$(DCC_UsePackage);$(DCC_UsePackage)
- true
- true
- Base
- iPhoneAndiPad
- None
-
-
- true
- Debug
- CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes=
- $(MSBuildProjectName)
- rtl;$(DCC_UsePackage);$(DCC_UsePackage)
- true
- true
- Base
- iPhoneAndiPad
- None
-
-
- rtl;$(DCC_UsePackage)
- None
-
-
- rtl;$(DCC_UsePackage)
-
-
- rtl;$(DCC_UsePackage)
- Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
-
-
- rtl;$(DCC_UsePackage)
-
-
- DEBUG;$(DCC_Define)
- true
- false
- true
- true
- true
-
-
- 0
- true
- true
- 1
- false
-
-
- false
- RELEASE;$(DCC_Define)
- 0
- 0
-
-
-
- MainSource
-
-
-
-
-
-
-
- Cfg_2
- Base
-
-
- Base
- ..\Version.optset
-
-
- Cfg_1
- Base
-
-
-
- Delphi.Personality.12
- Package
-
-
-
-
- Microsoft Office 2000 Sample Automation Server Wrapper Components
- Microsoft Office XP Sample Automation Server Wrapper Components
-
-
-
-
-
- true
-
-
-
-
- true
-
-
-
-
- true
-
-
-
-
- VCSInfo.bpl
- true
-
-
-
-
-
- Contents\Resources
- 1
-
-
-
-
- classes
- 1
-
-
-
-
- res\drawable-xxhdpi
- 1
-
-
-
-
- Contents\MacOS
- 0
-
-
- 1
-
-
-
-
- library\lib\mips
- 1
-
-
-
-
- 1
-
-
- 1
-
-
- 1
-
-
-
-
- 0
-
-
- 1
-
-
- 1
-
-
- 1
-
-
- library\lib\armeabi-v7a
- 1
-
-
- 1
-
-
-
-
- 0
-
-
- 1
- .framework
-
-
-
-
- 1
-
-
- 1
-
-
- 1
-
-
-
-
- library\lib\x86
- 1
-
-
-
-
- ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
- 1
-
-
- ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
- 1
-
-
-
-
- 1
-
-
- 1
-
-
- 1
-
-
-
-
- 1
-
-
- 1
-
-
- 1
-
-
-
-
-
- library\lib\armeabi
- 1
-
-
-
-
- 0
-
-
- 1
-
-
- 1
-
-
-
-
- 1
-
-
- 1
-
-
- 1
-
-
-
-
- res\drawable-normal
- 1
-
-
-
-
- res\drawable-xhdpi
- 1
-
-
-
-
- res\drawable-large
- 1
-
-
-
-
- 1
-
-
- 1
-
-
- 1
-
-
-
-
-
- library\lib\armeabi-v7a
- 1
-
-
-
-
- res\drawable-hdpi
- 1
-
-
-
-
-
-
- 1
-
-
- 1
-
-
- 1
-
-
-
-
- res\values
- 1
-
-
-
-
- res\drawable-small
- 1
-
-
-
-
- res\drawable
- 1
-
-
-
-
- 1
-
-
- 1
-
-
- 1
-
-
-
-
- 1
-
-
-
-
- res\drawable
- 1
-
-
-
-
- 0
-
-
- 0
-
-
- 0
-
-
- 0
-
-
- 0
-
-
- 0
-
-
-
-
- library\lib\armeabi-v7a
- 1
-
-
-
-
- 0
- .bpl
-
-
- 1
- .dylib
-
-
- 1
- .dylib
-
-
- 1
- .dylib
-
-
- 1
- .dylib
-
-
-
-
- res\drawable-mdpi
- 1
-
-
-
-
- res\drawable-xlarge
- 1
-
-
-
-
- res\drawable-ldpi
- 1
-
-
-
-
- 0
- .dll;.bpl
-
-
- 1
- .dylib
-
-
-
-
-
-
-
-
-
-
-
- False
- False
- False
- False
- False
- True
- False
-
-
- 12
-
-
-
-
-
ADDED src/Delphi10/VCSInfo_BPL.dpk
Index: src/Delphi10/VCSInfo_BPL.dpk
==================================================================
--- /dev/null
+++ src/Delphi10/VCSInfo_BPL.dpk
@@ -0,0 +1,38 @@
+package VCSInfo_BPL;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$IMPLICITBUILD ON}
+
+requires
+ rtl,
+ designide;
+
+contains
+ VCSInfoMenuWzrd in '..\VCSInfoMenuWzrd.pas',
+ u_FinalPathName in '..\u_FinalPathName.pas';
+
+end.
ADDED src/Delphi10/VCSInfo_BPL.dproj
Index: src/Delphi10/VCSInfo_BPL.dproj
==================================================================
--- /dev/null
+++ src/Delphi10/VCSInfo_BPL.dproj
@@ -0,0 +1,555 @@
+
+
+ {E394A6F2-CCD7-4A8A-9E66-88F4D866E2FB}
+ VCSInfo_BPL.dpk
+ 18.1
+ None
+ True
+ Debug
+ Win32
+ 1
+ Package
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+
+ false
+ false
+ All
+ true
+ true
+ VCSInfo_BPL
+ ..\..\out\DCU\$(Platform)\$(Config)
+ .\$(Platform)\$(Config)
+ false
+ false
+ false
+ false
+ false
+ 1033
+ ..\Version.optset
+
+
+ android-support-v4.dex.jar;apk-expansion.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar
+ rtl;$(DCC_UsePackage)
+ None
+
+
+ true
+ Debug
+ CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes=
+ $(MSBuildProjectName)
+ rtl;$(DCC_UsePackage);$(DCC_UsePackage)
+ true
+ true
+ Base
+ iPhoneAndiPad
+ None
+
+
+ true
+ Debug
+ CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes=
+ $(MSBuildProjectName)
+ rtl;$(DCC_UsePackage);$(DCC_UsePackage)
+ true
+ true
+ Base
+ iPhoneAndiPad
+ None
+
+
+ rtl;$(DCC_UsePackage)
+ None
+
+
+ rtl;$(DCC_UsePackage)
+
+
+ rtl;$(DCC_UsePackage)
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+
+
+ rtl;$(DCC_UsePackage)
+
+
+ DEBUG;$(DCC_Define)
+ true
+ false
+ true
+ true
+ true
+
+
+ true
+ CompanyName=Martijn Coppoolse;FileDescription=VCS Info;FileVersion=0.1.0.0;InternalName=VCSInfo;LegalCopyright=;LegalTrademarks=;OriginalFilename=VCSInfo.bpl;ProductName=VCS Info;ProductVersion=1.0;Comments=http://fossil.2of4.net/vcsInfo
+ 0
+ true
+ true
+ 1
+ false
+
+
+ false
+ RELEASE;$(DCC_Define)
+ 0
+ 0
+
+
+
+ MainSource
+
+
+
+
+
+
+
+ Cfg_2
+ Base
+
+
+ Base
+ ..\Version.optset
+
+
+ Cfg_1
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ VCSInfo_BPL.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+
+
+ true
+
+
+
+
+ true
+
+
+
+
+ true
+
+
+
+
+ VCSInfo_BPL.bpl
+ true
+
+
+
+
+
+ Contents\Resources
+ 1
+
+
+
+
+ classes
+ 1
+
+
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+
+
+ Contents\MacOS
+ 0
+
+
+ 1
+
+
+
+
+ library\lib\mips
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 0
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+ 1
+
+
+
+
+ 0
+
+
+ 1
+ .framework
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ library\lib\x86
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+
+ library\lib\armeabi
+ 1
+
+
+
+
+ 0
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ res\drawable-normal
+ 1
+
+
+
+
+ res\drawable-xhdpi
+ 1
+
+
+
+
+ res\drawable-large
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ res\drawable-hdpi
+ 1
+
+
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+
+
+ res\drawable-small
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ 0
+ .bpl
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+
+
+ res\drawable-mdpi
+ 1
+
+
+
+
+ res\drawable-xlarge
+ 1
+
+
+
+
+ res\drawable-ldpi
+ 1
+
+
+
+
+ 0
+ .dll;.bpl
+
+
+ 1
+ .dylib
+
+
+
+
+
+
+
+
+
+
+
+ False
+ False
+ False
+ False
+ False
+ True
+ False
+
+
+ 12
+
+
+
+
+
ADDED src/Delphi10/VCSInfo_XSeattle.dpr
Index: src/Delphi10/VCSInfo_XSeattle.dpr
==================================================================
--- /dev/null
+++ src/Delphi10/VCSInfo_XSeattle.dpr
@@ -0,0 +1,25 @@
+library VCSInfo_XSeattle;
+
+{ Important note about DLL memory management: ShareMem must be the
+ first unit in your library's USES clause AND your project's (select
+ Project-View Source) USES clause if your DLL exports any procedures or
+ functions that pass strings as parameters or function results. This
+ applies to all strings passed to and from your DLL--even those that
+ are nested in records and classes. ShareMem is the interface unit to
+ the BORLNDMM.DLL shared memory manager, which must be deployed along
+ with your DLL. To avoid using BORLNDMM.DLL, pass string information
+ using PChar or ShortString parameters. }
+
+{$R *.dres}
+
+uses
+ System.SysUtils,
+ System.Classes,
+ vcsinfo.InfoWzrd in '..\vcsinfo.InfoWzrd.pas',
+ vcsinfo.VCSClient in '..\vcsinfo.VCSClient.pas',
+ vcsinfo.Fossil in '..\vcsinfo.Fossil.pas';
+
+{$R *.res}
+
+begin
+end.
ADDED src/Delphi10/VCSInfo_XSeattle.dproj
Index: src/Delphi10/VCSInfo_XSeattle.dproj
==================================================================
--- /dev/null
+++ src/Delphi10/VCSInfo_XSeattle.dproj
@@ -0,0 +1,559 @@
+
+
+ {8615D8A1-1FF0-4BB0-A048-52AE5019C5DF}
+ 18.1
+ None
+ VCSInfo_XSeattle.dpr
+ True
+ Debug
+ Win32
+ 1
+ Library
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)
+ true
+ VCSInfo_XSeattle
+ ..;$(DCC_UnitSearchPath)
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
+ 1043
+ ..\..\out\DCU\$(Platform)\$(Config)
+ ..\..\out\$(Platform)\$(Config)
+ false
+ false
+ false
+ false
+ false
+
+
+ DBXSqliteDriver;bindcompdbx;IndyIPCommon;RESTComponents;DBXInterBaseDriver;IndyIPServer;IndySystem;tethering;fmxFireDAC;FireDAC;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;fmxobj;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;dbxcds;soapserver;FireDACODBCDriver;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;IndyProtocols;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ 1033
+ true
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
+ DBXSqliteDriver;bindcompdbx;IndyIPCommon;RESTComponents;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;frxe23;vclFireDAC;IndySystem;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;Intraweb;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;OmniThreadLibraryRuntimeXE8;AbbreviaVCLD;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;Tee;fmxobj;vclwinx;rtl;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;AggPasRun;FireDACCommon;IndyIPClient;bindcompvcl;frxDB23;RESTBackendComponents;TeeUI;VCLRESTComponents;vclribbon;dbxcds;VclSmp;soapserver;adortl;FireDACODBCDriver;frxTee23;VCSInfo;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;IndyProtocols;frx23;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage)
+
+
+ DBXSqliteDriver;bindcompdbx;IndyIPCommon;RESTComponents;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;Intraweb;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;AbbreviaVCLD;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;Tee;fmxobj;vclwinx;rtl;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;vclribbon;dbxcds;VclSmp;soapserver;adortl;FireDACODBCDriver;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;inetdbxpress;IndyProtocols;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage)
+
+
+ DEBUG;$(DCC_Define)
+ true
+ false
+ true
+ true
+ true
+
+
+ D:\ProgFiles\Embarcadero\RAD Studio\17.0\bin\bds.exe
+ true
+ rtl;vcl;designide
+ -pDelphi
+ None
+ 1033
+ true
+ false
+
+
+ false
+ RELEASE;$(DCC_Define)
+ 0
+ 0
+
+
+
+ MainSource
+
+
+
+
+
+ BITMAP
+ BMP_LOGO
+
+
+
+ Cfg_2
+ Base
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+ Delphi.Personality.12
+ Application
+
+
+
+ VCSInfo_XSeattle.dpr
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+
+
+ true
+
+
+
+
+ true
+
+
+
+
+ true
+
+
+
+
+ VCSInfo_XSeattle.dll
+ true
+
+
+
+
+ 0
+ .dll;.bpl
+
+
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+
+
+ Contents\Resources
+ 1
+
+
+
+
+ classes
+ 1
+
+
+
+
+ Contents\MacOS
+ 0
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+
+
+ library\lib\mips
+ 1
+
+
+
+
+ 0
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 1
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+ 1
+
+
+
+
+ 0
+
+
+ Contents\MacOS
+ 1
+ .framework
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+
+
+ library\lib\x86
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ library\lib\armeabi
+ 1
+
+
+
+
+ 0
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ res\drawable-normal
+ 1
+
+
+
+
+ res\drawable-xhdpi
+ 1
+
+
+
+
+ res\drawable-large
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ../
+ 1
+
+
+ ../
+ 1
+
+
+
+
+ res\drawable-hdpi
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ Contents
+ 1
+
+
+
+
+ ../
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+
+
+ res\drawable-small
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+
+
+ 0
+
+
+ 0
+
+
+ Contents\Resources\StartUp\
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ 0
+ .bpl
+
+
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+
+
+ res\drawable-mdpi
+ 1
+
+
+
+
+ res\drawable-xlarge
+ 1
+
+
+
+
+ res\drawable-ldpi
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+
+
+
+
+
+
+
+
+
+ False
+ True
+ False
+
+
+ 12
+
+
+
+
+
ADDED src/Delphi10/VCSInfo_dev.groupproj
Index: src/Delphi10/VCSInfo_dev.groupproj
==================================================================
--- /dev/null
+++ src/Delphi10/VCSInfo_dev.groupproj
@@ -0,0 +1,48 @@
+
+
+ {520AFAE8-DD39-4069-8DB8-F803A041CC1B}
+
+
+
+
+
+
+
+
+
+
+ Default.Personality.12
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
ADDED src/Res/logo.bmp
Index: src/Res/logo.bmp
==================================================================
--- /dev/null
+++ src/Res/logo.bmp
cannot compute difference between binary files
Index: src/VCSInfoMenuWzrd.pas
==================================================================
--- src/VCSInfoMenuWzrd.pas
+++ src/VCSInfoMenuWzrd.pas
@@ -18,11 +18,11 @@
LastUpdated: TDateTime;
function IsRepo: Boolean;
end;
// TODO: implement IOTAEditorNotifier and/or IOTAIDENotifier so we know which file is active
- TVCSInfoWizard = class(TNotifierObject, IOTAWizard, IOTAMenuWizard)
+ TVCSInfoMenuWizard = class(TNotifierObject, IOTAWizard, IOTAMenuWizard)
private
FRepos: TDictionary;
FToolbar: TToolBar;
FPluginAbout: Integer;
@@ -96,11 +96,11 @@
cLimit = 9;
{ ------------------------------------------------------------------------------------------------ }
procedure Register;
begin
- RegisterPackageWizard(TVCSInfoWizard.Create);
+ RegisterPackageWizard(TVCSInfoMenuWizard.Create);
(* TODO: create multiple separate menu wizards:
- pull (incoming) / push (outgoing)
*)
end;
@@ -417,11 +417,11 @@
{ ================================================================================================ }
{ TVCSInfoWizard }
{ ------------------------------------------------------------------------------------------------ }
-constructor TVCSInfoWizard.Create;
+constructor TVCSInfoMenuWizard.Create;
var
Services: INTAServices;
AboutBox: IOTAAboutBoxServices;
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
function AddButtonImage(const Color: TColor; const TransparentColor: TColor = clFuchsia): Integer;
@@ -622,11 +622,11 @@
sLineBreak +
'© Martijn Coppoolse - http://fossil.2of4.net/vcsInfo',
0);
end {TVCSInfoWizard.Create};
{ ------------------------------------------------------------------------------------------------ }
-destructor TVCSInfoWizard.Destroy;
+destructor TVCSInfoMenuWizard.Destroy;
var
Services: INTAServices;
Button: TToolButton;
i: Integer;
AboutBox: IOTAAboutBoxServices;
@@ -647,11 +647,11 @@
finally
inherited;
end;
end {TVCSInfoWizard.Destroy};
-procedure TVCSInfoWizard.actBranchUpdate(Sender: TObject);
+procedure TVCSInfoMenuWizard.actBranchUpdate(Sender: TObject);
var
actBranch: TAction;
Repo: TRepoInfo;
NewHint, NewCaption: string;
NewEnabled: boolean;
@@ -690,16 +690,16 @@
LogMessage('actBranchUpdate raised ' + E.ClassName + sLineBreak + E.ToString);
end;
end;
end;
-procedure TVCSInfoWizard.actInfoExecute(Sender: TObject);
+procedure TVCSInfoMenuWizard.actInfoExecute(Sender: TObject);
begin
// nothing; just drop down the menu
end;
-procedure TVCSInfoWizard.actInfoMenuPopup(Sender: TObject);
+procedure TVCSInfoMenuWizard.actInfoMenuPopup(Sender: TObject);
var
Menu: TPopupMenu;
Item: TMenuItem;
Button: TToolButton;
Output: string;
@@ -735,11 +735,11 @@
LogMessage('actInfoMenuPopUp raised ' + E.ClassName + sLineBreak + E.ToString);
end;
end;
end {TVCSInfoWizard.actInfoMenuPopup};
-procedure TVCSInfoWizard.actInfoUpdate(Sender: TObject);
+procedure TVCSInfoMenuWizard.actInfoUpdate(Sender: TObject);
var
actInfo: TAction;
Repo: TRepoInfo;
NewImageIndex: integer;
NewCaption: string;
@@ -772,11 +772,11 @@
LogMessage('actInfoUpdate raised ' + E.ClassName + sLineBreak + E.ToString);
end;
end;
end;
-procedure TVCSInfoWizard.actInfoMenuVCSClick(Sender: TObject);
+procedure TVCSInfoMenuWizard.actInfoMenuVCSClick(Sender: TObject);
var
Dir: string;
begin
Dir := ExtractFileDir(GetActiveFileName);
case (((Sender as TMenuItem).Owner as TComponent).Owner as TToolButton).Action.Tag of
@@ -787,28 +787,28 @@
CreateProcess('cmd.exe /k fossil', Dir, True);
end;
end;
end;
-procedure TVCSInfoWizard.actBranchExecute(Sender: TObject);
+procedure TVCSInfoMenuWizard.actBranchExecute(Sender: TObject);
var
P: TPoint;
begin
with FButtonBranch.BoundsRect do
P := FButtonBranch.Parent.ClientToScreen(Point(Left, Bottom));
FMenuBranches.Popup(P.X, P.Y);
end;
-procedure TVCSInfoWizard.actBranchMenuClick(Sender: TObject);
+procedure TVCSInfoMenuWizard.actBranchMenuClick(Sender: TObject);
var
BranchName: string;
begin
BranchName := (Sender as TMenuItem).Caption;
SwitchToRevision(BranchName);
end {TVCSInfoWizard.actBranchMenuClick};
-procedure TVCSInfoWizard.actBranchMenuPopup(Sender: TObject);
+procedure TVCSInfoMenuWizard.actBranchMenuPopup(Sender: TObject);
var
Menu: TPopupMenu;
Repo: TRepoInfo;
Branches: TStringList;
Branch: string;
@@ -859,11 +859,11 @@
Branches.Free;
end;
end;
end {TVCSInfoWizard.actBranchMenuPopup};
-procedure TVCSInfoWizard.actStatusExecute(Sender: TObject);
+procedure TVCSInfoMenuWizard.actStatusExecute(Sender: TObject);
var
Repo: TRepoInfo;
begin
Repo := GetActiveFileRepo;
case IndexStr(Repo.RepoType, ['hg', 'fossil']) of
@@ -886,11 +886,11 @@
end;
end;
end;
end;
-procedure TVCSInfoWizard.actStatusUpdate(Sender: TObject);
+procedure TVCSInfoMenuWizard.actStatusUpdate(Sender: TObject);
var
actStatus: TAction;
Repo: TRepoInfo;
NewImageIndex: Integer;
NewHint: string;
@@ -938,11 +938,11 @@
LogMessage('actStatusUpdate raised ' + E.ClassName + sLineBreak + E.ToString);
end;
end;
end;
-procedure TVCSInfoWizard.actSyncExecute(Sender: TObject);
+procedure TVCSInfoMenuWizard.actSyncExecute(Sender: TObject);
var
Repo: TRepoInfo;
iRes: Cardinal;
Output: string;
MsgType: TMsgDlgType;
@@ -966,11 +966,11 @@
TaskMessageDlg(Repo.Root, Output, MsgType, [mbOK], 0);
end;
end;
end;
-procedure TVCSInfoWizard.actSyncUpdate(Sender: TObject);
+procedure TVCSInfoMenuWizard.actSyncUpdate(Sender: TObject);
var
actSync: TAction;
begin
try
actSync := Sender as TAction;
@@ -980,11 +980,11 @@
LogMessage('actSyncUpdate raised ' + E.ClassName + sLineBreak + E.ToString);
end;
end;
end {TVCSInfoWizard.actSyncUpdate};
-procedure TVCSInfoWizard.RefreshSyncStatus(const actSync: TAction);
+procedure TVCSInfoMenuWizard.RefreshSyncStatus(const actSync: TAction);
var
NewImageIndex: Integer;
Repo: TRepoInfo;
NewEnabled: Boolean;
NewCaption: string;
@@ -1060,11 +1060,11 @@
LogMessage('actSyncUpdate: IsRepo=%d, In=%d, Out=%d; Caption="%s", Img=%d',
[Ord(Repo.IsRepo), Repo.Incoming, Repo.Outgoing, NewCaption, NewImageIndex]);
end;
end;
-procedure TVCSInfoWizard.SwitchToRevision(const Revision: string);
+procedure TVCSInfoMenuWizard.SwitchToRevision(const Revision: string);
var
i: Integer;
iRes: Cardinal;
Repo: TRepoInfo;
Output: string;
@@ -1110,11 +1110,11 @@
end;
end {TVCSInfoWizard.SwitchToBranch};
{ ------------------------------------------------------------------------------------------------ }
-function TVCSInfoWizard.GetMenuText: string;
+function TVCSInfoMenuWizard.GetMenuText: string;
var
Project: IOTAProject;
Repo: TRepoInfo;
begin
Project := ToolsAPI.GetActiveProject;
@@ -1147,11 +1147,11 @@
Result := Application.Title;
end;
end {TVCSInfoWizard.GetMenuText};
{ ------------------------------------------------------------------------------------------------ }
-function TVCSInfoWizard.GetState: TWizardState;
+function TVCSInfoMenuWizard.GetState: TWizardState;
var
Repo: TRepoInfo;
begin
Result := [];
Repo := GetActiveFileRepo;
@@ -1163,16 +1163,16 @@
Include(Result, wsChecked);
end;
end;
end {TVCSInfoWizard.GetState};
-procedure TVCSInfoWizard.LogMessage(const Text: string; const Args: array of const);
+procedure TVCSInfoMenuWizard.LogMessage(const Text: string; const Args: array of const);
begin
LogMessage(Format(Text, Args));
end;
-procedure TVCSInfoWizard.LogMessage(const Text: string);
+procedure TVCSInfoMenuWizard.LogMessage(const Text: string);
const
RFC3339: TFormatSettings = (DateSeparator: '-'; TimeSeparator: ':';
ShortDateFormat: 'yyyy-MM-dd'; LongDateFormat: 'yyyy-MM-dd';
ShortTimeFormat: 'hh:nn:ss'; LongTimeFormat: 'hh:nn:ss.zzz');
var
@@ -1194,11 +1194,11 @@
TimeStamp := StringOfChar(#9, 2);
end;
end {TVCSInfoWizard.LogMessage};
{ ------------------------------------------------------------------------------------------------ }
-procedure TVCSInfoWizard.Execute;
+procedure TVCSInfoMenuWizard.Execute;
var
Project: IOTAProject;
CodeFile: string;
Info: TRepoInfo;
Msg: string;
@@ -1235,22 +1235,22 @@
TaskMessageDlg('No project loaded', '', mtError, [mbOK], 0);
end;
end {TVCSInfoWizard.Execute};
{ ------------------------------------------------------------------------------------------------ }
-function TVCSInfoWizard.GetIDString: string;
+function TVCSInfoMenuWizard.GetIDString: string;
begin
Result := scMenuIDString;
end;
{ ------------------------------------------------------------------------------------------------ }
-function TVCSInfoWizard.GetName: string;
+function TVCSInfoMenuWizard.GetName: string;
begin
Result := scMenuIDString;
end;
-function TVCSInfoWizard.GetActiveFileName: string;
+function TVCSInfoMenuWizard.GetActiveFileName: string;
var
Modules: IOTAModuleServices;
Module: IOTAModule;
Editor: IOTAEditor;
Project: IOTAProject;
@@ -1270,28 +1270,28 @@
if Assigned(Project) then
Result := Project.FileName;
end;
end {GetActiveFileName};
-function TVCSInfoWizard.GetActiveFileRepo(const AForceUpdate: Boolean): TRepoInfo;
+function TVCSInfoMenuWizard.GetActiveFileRepo(const AForceUpdate: Boolean): TRepoInfo;
var
FileName: string;
begin
Result := GetActiveFileRepo(AForceUpdate, FileName);
end;
-function TVCSInfoWizard.GetActiveFileRepo(const AForceUpdate: Boolean; out AFileName: string): TRepoInfo;
+function TVCSInfoMenuWizard.GetActiveFileRepo(const AForceUpdate: Boolean; out AFileName: string): TRepoInfo;
begin
AFileName := GetActiveFileName;
if FileExists(AFileName) then begin
Result := GetRepoInfo(AFileName, AForceUpdate);
end else begin
Result := Default(TRepoInfo);
end;
end {TVCSInfoWizard.GetActiveFileRepo};
-function TVCSInfoWizard.GetRepoInfo(const AFileName: string; const AForceUpdate: Boolean): TRepoInfo;
+function TVCSInfoMenuWizard.GetRepoInfo(const AFileName: string; const AForceUpdate: Boolean): TRepoInfo;
const
cRefreshSeconds = 10;
var
FilePath, FinalFilePath, RootPath, FinalRootPath: string;
Lines: TStringList;
ADDED src/vcsinfo.Fossil.pas
Index: src/vcsinfo.Fossil.pas
==================================================================
--- /dev/null
+++ src/vcsinfo.Fossil.pas
@@ -0,0 +1,264 @@
+unit vcsinfo.Fossil;
+
+interface
+uses
+ vcsinfo.VCSClient;
+
+type
+ TVCSFossil = class(TVCSClient)
+ public
+ class function IsRepo(const APath: string; out ARootPath: string): boolean; override;
+ strict protected
+ function GetExecutable: string; override;
+ function GetUIExecutable: string; override;
+ function GetTitle: string; override;
+ public
+ constructor Create(const APath: string);
+ destructor Destroy; override;
+
+ function GetBranches: TArray; override;
+
+ function GetIncoming: integer; override;
+ function GetOutgoing: integer; override;
+
+ function CountPendingFiles: integer; override;
+ function CountUntrackedFiles: Integer; override;
+ function GetStatus: TArray; override;
+
+ procedure ShowRepositoryUI; override;
+ procedure ShowRemoteStatusUI; override;
+ procedure ShowLocalStatusUI; override;
+ function SwitchToBranchUI(const BranchName: string): boolean; override;
+
+ procedure ProcessRename(const OldName, NewName: string); override;
+ end;
+
+implementation
+uses
+ System.Classes, System.SysUtils,
+ Vcl.Forms, Vcl.Controls, Vcl.Dialogs;
+
+{ TVCSFossil }
+
+constructor TVCSFossil.Create(const APath: string);
+begin
+ inherited;
+
+end;
+
+destructor TVCSFossil.Destroy;
+begin
+
+ inherited;
+end;
+
+function TVCSFossil.GetBranches: TArray;
+var
+ Lines: TStringList;
+ RetVal: Cardinal;
+ i: Integer;
+begin
+ Lines := TStringList.Create;
+ try
+ RetVal := ExecuteCmd('fossil branch list', Lines.Append);
+ if RetVal <> 0 then
+ raise EVCSException.Create(Lines.Text.Trim);
+ for i := 0 to Lines.Count - 1 do begin
+ // put the current one first
+ if (i > 0) and Lines[i].StartsWith('*') then begin
+ Lines.Insert(0, Lines[i].Substring(2));
+ Lines.Delete(i);
+ end else begin
+ Lines[i] := Lines[i].Substring(2);
+ end;
+ end;
+ Result := Lines.ToStringArray;
+ finally
+ Lines.Free;
+ end;
+end;
+
+function TVCSFossil.GetExecutable: string;
+begin
+ Result := 'fossil.exe';
+end;
+
+function TVCSFossil.GetIncoming: integer;
+var
+ Line: string;
+ iRes: Cardinal;
+begin
+ // if remote-url is off, then 0; otherwise -1
+ Result := -1;
+
+ Line := '';
+ iRes := ExecuteCmd('fossil remote-url', Line);
+ if (iRes = 0) and (Line <> 'off') then begin
+ Result := 0;
+ end;
+end {TVCSFossil.GetIncoming};
+
+function TVCSFossil.GetOutgoing: integer;
+var
+ Line: string;
+ iRes: Cardinal;
+begin
+ // if remote-url is off and autosync is on, then 0; otherwise -1
+ Result := -1;
+
+ Line := '';
+ iRes := ExecuteCmd('fossil settings autosync', Line);
+ if (iRes = 0) and (Line <> '') and TryStrToInt(Line.Substring(28).Trim, Integer(iRes)) then begin
+ if (iRes > 0) then begin
+ // autosync is enabled; check for a remote-url
+ Line := '';
+ iRes := ExecuteCmd('fossil remote-url', Line);
+ if (iRes = 0) and (Line <> 'off') then begin
+ Result := 0;
+ end;
+ end;
+ end;
+end {TVCSFossil.GetOutgoing};
+
+function TVCSFossil.CountPendingFiles: integer;
+var
+ Lines: TStringList;
+begin
+ Result := 0;
+ Lines := TStringList.Create;
+ try
+ if 0 = ExecuteCmd('fossil changes', Lines.Append) then
+ Result := Lines.Count
+ else
+ raise EVCSException.Create(Lines.Text.Trim);
+ finally
+ Lines.Free;
+ end;
+end;
+
+function TVCSFossil.GetStatus: TArray;
+var
+ Lines: TStringList;
+begin
+ Lines := TStringList.Create;
+ try
+ if 0 = ExecuteCmd('fossil status', Lines.Append) then
+ Result := Lines.ToStringArray
+ else
+ raise EVCSException.Create(Lines.Text.Trim);
+ finally
+ Lines.Free;
+ end;
+end;
+
+function TVCSFossil.GetTitle: string;
+begin
+ if 0 <> ExecuteCmd('fossil sqlite3 "SELECT value FROM config WHERE name=''project-name''"', Result) then
+ raise EVCSException.Create(Result);
+end;
+
+function TVCSFossil.GetUIExecutable: string;
+begin
+ Result := '';
+end;
+
+function TVCSFossil.CountUntrackedFiles: Integer;
+var
+ Lines: TStringList;
+begin
+ Result := 0;
+ Lines := TStringList.Create;
+ try
+ if 0 = ExecuteCmd('fossil extras', Lines.Append) then
+ Result := Lines.Count
+ else
+ raise EVCSException.Create(Lines.Text);
+ finally
+ Lines.Free;
+ end;
+end;
+
+procedure TVCSFossil.ShowRemoteStatusUI;
+var
+ Output: string;
+ RetVal: Cardinal;
+ MsgType: TMsgDlgType;
+begin
+ Screen.Cursor := crHourGlass;
+ try
+ RetVal := ExecuteCmd('fossil sync -autourl', Output);
+ if RetVal = 0 then
+ MsgType := mtInformation
+ else
+ MsgType := mtError;
+ finally
+ Screen.Cursor := crDefault;
+ end;
+ TaskMessageDlg(FRoot, Output, MsgType, [mbOK], 0);
+end;
+
+procedure TVCSFossil.ShowRepositoryUI;
+begin
+ if not CreateProcess('fossil ui', FRoot) then
+ RaiseLastOSError;
+end;
+
+procedure TVCSFossil.ProcessRename(const OldName, NewName: string);
+var
+ Text: string;
+begin
+ if 0 <> ExecuteCmd(Format('fossil rename --soft "%s" "%s"', [OldName, NewName]), Text) then
+ raise EVCSException.Create(Text);
+end;
+
+procedure TVCSFossil.ShowLocalStatusUI;
+begin
+ if CountPendingFiles > 0 then begin
+ if not CreateProcess('fossil gdiff') then
+ RaiseLastOSError;
+ end else begin
+ if not CreateProcess('fossil ui') then
+ RaiseLastOSError;
+ end;
+end;
+
+function TVCSFossil.SwitchToBranchUI(const BranchName: string): boolean;
+var
+ Output: string;
+ iRes: Cardinal;
+ MsgType: TMsgDlgType;
+begin
+ Result := False;
+ iRes := ExecuteCmd(Format('fossil checkout "%s"', [BranchName]), Output);
+ if iRes <> 0 then begin
+ if TaskMessageDlg(FRoot, Output, mtWarning, [mbRetry, mbCancel], 0) = mrCancel then
+ Exit;
+ iRes := ExecuteCmd(Format('fossil update "%s"', [BranchName]), Output);
+ end;
+ Result := iRes = 0;
+ if Result then
+ MsgType := mtInformation
+ else
+ MsgType := mtError;
+ TaskMessageDlg(FRoot, Output, MsgType, [mbOK], 0);
+end;
+
+class function TVCSFossil.IsRepo(const APath: string; out ARootPath: string): boolean;
+var
+ Lines: TStrings;
+ iRes: Cardinal;
+begin
+ Lines := TStringList.Create;
+ try
+ Lines.NameValueSeparator := ':';
+ iRes := ExecuteCmd('fossil info', Lines.Append, False, nil, APath);
+ Result := iRes = 0;
+ if Result then begin
+ ARootPath := Lines.Values['local-root'].Trim.Replace('/', PathDelim, [rfReplaceAll]);
+ end;
+ finally
+ Lines.Free;
+ end;
+end {TVCSFossil.IsRepo};
+
+end.
ADDED src/vcsinfo.InfoWzrd.pas
Index: src/vcsinfo.InfoWzrd.pas
==================================================================
--- /dev/null
+++ src/vcsinfo.InfoWzrd.pas
@@ -0,0 +1,101 @@
+unit vcsinfo.InfoWzrd;
+
+interface
+uses
+ Vcl.Graphics,
+ ToolsAPI,
+ vcsinfo.View;
+
+type
+ TVCSInfoStatusWizard = class(TNotifierObject, IOTAWizard)
+ private
+ FLogo: TBitmap;
+ FView: TNotifiers;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ { IOTAWizard }
+ function GetIDString: string;
+ function GetName: string;
+ function GetState: TWizardState;
+ procedure Execute;
+ end;
+
+implementation
+uses
+ System.SysUtils;
+
+const
+ scWizardID = 'net.2of4.VCSInfoStatusWizard';
+resourcestring
+ rsWizardName = 'VCS Info Wizard';
+
+{ ------------------------------------------------------------------------------------------------ }
+{ TVCSInfoStatusWizard }
+
+constructor TVCSInfoStatusWizard.Create;
+begin
+ FLogo := TBitmap.Create;
+ FLogo.LoadFromResourceName(HInstance, 'BMP_LOGO');
+ SplashScreenServices.AddPluginBitmap(rsWizardName, FLogo.Handle,
+ False, 'Freeware');
+ (BorlandIDEServices as IOTAAboutBoxServices).AddPluginInfo(rsWizardName, rsWizardName, FLogo.Handle,
+ False, 'Freeware');
+ // TODO: set up cache (Model)
+ // TODO: set up UI, including timer and notifiers (View)
+ FView := TNotifiers.Create;
+ (BorlandIDEServices as IOTAServices).AddNotifier(FView);
+ // TODO: set up thread queue (Controller)
+end;
+
+destructor TVCSInfoStatusWizard.Destroy;
+begin
+ // TODO: destroy all the objects we own
+ FLogo.Free;
+ FView.Free;
+ inherited;
+end;
+
+procedure TVCSInfoStatusWizard.Execute;
+begin
+ // TODO: when will this be called?
+ FView.LogMessage('Execute');
+end;
+
+function TVCSInfoStatusWizard.GetIDString: string;
+begin
+ Result := scWizardID;
+end;
+
+function TVCSInfoStatusWizard.GetName: string;
+begin
+ Result := rsWizardName;
+end;
+
+function TVCSInfoStatusWizard.GetState: TWizardState;
+begin
+ Result := [wsEnabled];
+end;
+
+
+
+
+function InitializeWizard(const BorlandIDEServices: IBorlandIDEServices): IOTAWizard;
+begin
+ Result := TVCSInfoStatusWizard.Create;
+end;
+
+function InitWizard(const BorlandIDEServices: IBorlandIDEServices;
+ RegisterProc: TWizardRegisterProc;
+ var Terminate: TWizardTerminateProc): boolean; stdcall;
+begin
+ RegisterProc(InitializeWizard(BorlandIDEServices));
+ Result := True;
+end;
+
+
+exports
+ InitWizard name WizardEntryPoint;
+
+end.
ADDED src/vcsinfo.RepoCache.pas
Index: src/vcsinfo.RepoCache.pas
==================================================================
--- /dev/null
+++ src/vcsinfo.RepoCache.pas
@@ -0,0 +1,45 @@
+unit RepoCache;
+
+interface
+uses
+ System.Generics.Collections,
+ vcsinfo.VCSClient;
+
+type
+ TRepoInfo = class
+ private
+ FVCSClient: TVCSClient;
+ FRoot: string;
+ FLastCheckRepo: TDateTime;
+
+ FBranch: string;
+ FPending: Integer;
+ FUntracked: Integer;
+ FLastCheckWorkDir: TDateTime;
+
+ FIncoming: Integer;
+ FOutgoing: Integer;
+ FLastCheckRemote: TDateTime;
+
+ function GetIsRepo: Boolean;
+ function GetBranch: string;
+ public
+ property IsRepo: Boolean read GetIsRepo;
+ property Client: TVCSClient read FVCSClient;
+ property Root: string read FRoot;
+ property Branch: string read GetBranch;
+ property Pending: Integer read GetPending;
+ property Untracked: Integer read GetUntracked;
+ property Incoming: Integer read GetIncoming;
+ property Outgoing: Integer read GetOutgoing;
+ end;
+
+
+ TRepoCache = class
+ public
+
+ end;
+
+implementation
+
+end.
ADDED src/vcsinfo.VCSClient.pas
Index: src/vcsinfo.VCSClient.pas
==================================================================
--- /dev/null
+++ src/vcsinfo.VCSClient.pas
@@ -0,0 +1,414 @@
+unit vcsinfo.VCSClient;
+
+interface
+uses
+ System.SysUtils, System.Generics.Collections;
+
+type
+ EVCSException = class(Exception);
+
+type
+ // e.g. TStrings.Append
+ TTextHandler = procedure(const Text: string) of object;
+
+type
+ TVCSClient = class;
+ TVCSClientClass = class of TVCSClient;
+
+ TVCSClient = class
+ public
+ class function CreateForPath(const APath: string): TVCSClient;
+ class function IsRepo(const APath: string; out ARootPath: string): boolean; virtual; abstract;
+ class procedure RegisterVCSClass(const VCSClass: TVCSClientClass);
+ strict private
+ class var FRegisteredVCSes: TList;
+ strict private
+ class function InternalExecute(CommandLine: string; var Output: string;
+ OutputLineCallback: TTextHandler; RawOutput: Boolean; AbortPtr: PBoolean;
+ const CurrentDir: string): Cardinal;
+ class function MuteCRTerminatedLines(const RawOutput: string): string;
+ strict protected
+ FRoot: string;
+
+ class function ExecuteCmd(const CommandLine: string;
+ OutputLineCallback: TTextHandler;
+ RawOutput: Boolean = False;
+ AbortPtr: PBoolean = nil;
+ const CurrentDir: string = ''): Cardinal; overload;
+ class function ExecuteCmd(const CommandLine: string;
+ var Output: string;
+ RawOutput: Boolean = False;
+ AbortPtr: PBoolean = nil;
+ const CurrentDir: string = ''): Cardinal; overload;
+
+ function CreateProcess(const ACommand: string; ACurrentDir: string = ''; const AShow: boolean = False): boolean;
+
+
+ function GetExecutable: string; virtual; abstract;
+ function GetUIExecutable: string; virtual; abstract;
+ function GetTitle: string; virtual;
+ function GetCurrentBranch: string; virtual;
+ public
+ constructor Create(const APath: string);
+ destructor Destroy; override;
+
+ function GetBranches: TArray; virtual; abstract;
+
+ function GetIncoming: integer; virtual; abstract;
+ function GetOutgoing: integer; virtual; abstract;
+
+ function CountPendingFiles: integer; virtual; abstract;
+ function CountUntrackedFiles: Integer; virtual; abstract;
+ function GetStatus: TArray; virtual; abstract;
+
+ procedure ShowRepositoryUI; virtual; abstract;
+ procedure ShowRemoteStatusUI; virtual; abstract;
+ procedure ShowLocalStatusUI; virtual; abstract;
+ function SwitchToBranchUI(const BranchName: string): boolean; virtual; abstract;
+
+ procedure ProcessRename(const OldName, NewName: string); virtual; abstract;
+
+ property Executable: string read GetExecutable;
+ property UIExecutable: string read GetUIExecutable;
+ property Root: string read FRoot;
+ property Title: string read GetTitle;
+
+ property CurrentBranch: string read GetCurrentBranch;
+ end;
+
+
+implementation
+
+uses
+ Winapi.Windows;
+
+{ TVCSClient }
+
+constructor TVCSClient.Create(const APath: string);
+begin
+
+end;
+
+destructor TVCSClient.Destroy;
+begin
+
+ inherited;
+end;
+
+
+function TVCSClient.GetCurrentBranch: string;
+var
+ Branches: TArray;
+begin
+ // ASSUMPTION: the first branch is the current one
+ Branches := GetBranches;
+ if Length(Branches) > 0 then
+ Result := Branches[0]
+ else
+ Result := '';
+end;
+
+function TVCSClient.GetTitle: string;
+begin
+ Result := ExtractFileName(ExcludeTrailingPathDelimiter(FRoot));
+end;
+
+{$REGION 'Functions to execute command-line and capture output'}
+//--- JclBase and JclSysUtils --------------------------------------------------
+const
+ // line delimiters for a version of Delphi/C++Builder
+ NativeLineFeed = Char(#10);
+ NativeCarriageReturn = Char(#13);
+
+function CharIsReturn(const C: Char): Boolean;
+begin
+ Result := (C = NativeLineFeed) or (C = NativeCarriageReturn);
+end;
+
+// memory initialization
+procedure ResetMemory(out P; Size: Longint);
+begin
+ if Size > 0 then
+ begin
+ Byte(P) := 0;
+ FillChar(P, Size, 0);
+ end;
+end;
+
+const
+ ABORT_EXIT_CODE = {$IFDEF MSWINDOWS} ERROR_CANCELLED {$ELSE} 1223 {$ENDIF};
+
+
+class function TVCSClient.MuteCRTerminatedLines(const RawOutput: string): string;
+const
+ Delta = 1024;
+var
+ BufPos, OutPos, LfPos, EndPos: Integer;
+ C: Char;
+begin
+ SetLength(Result, Length(RawOutput));
+ OutPos := 1;
+ LfPos := OutPos;
+ EndPos := OutPos;
+ for BufPos := 1 to Length(RawOutput) do
+ begin
+ if OutPos >= Length(Result)-2 then
+ SetLength(Result, Length(Result) + Delta);
+ C := RawOutput[BufPos];
+ case C of
+ NativeCarriageReturn:
+ OutPos := LfPos;
+ NativeLineFeed:
+ begin
+ OutPos := EndPos;
+ Result[OutPos] := NativeCarriageReturn;
+ Inc(OutPos);
+ Result[OutPos] := C;
+ Inc(OutPos);
+ EndPos := OutPos;
+ LfPos := OutPos;
+ end;
+ else
+ Result[OutPos] := C;
+ Inc(OutPos);
+ EndPos := OutPos;
+ end;
+ end;
+ SetLength(Result, OutPos - 1);
+end;
+
+class function TVCSClient.InternalExecute(CommandLine: string; var Output: string; OutputLineCallback: TTextHandler;
+ RawOutput: Boolean; AbortPtr: PBoolean; const CurrentDir: string): Cardinal;
+
+const
+ BufferSize = 255;
+type
+ TBuffer = array [0..BufferSize] of AnsiChar;
+
+ procedure ProcessLine(const Line: string; LineEnd: Integer);
+ begin
+ if RawOutput or (Line[LineEnd] <> NativeCarriageReturn) then
+ begin
+ while (LineEnd > 0) and CharIsReturn(Line[LineEnd]) do
+ Dec(LineEnd);
+ OutputLineCallback(Copy(Line, 1, LineEnd));
+ end;
+ end;
+
+ procedure ProcessBuffer(var Buffer: TBuffer; var Line: string; PipeBytesRead: Cardinal);
+ var
+ CR, LF: Integer;
+ begin
+ Buffer[PipeBytesRead] := #0;
+ Line := Line + string(Buffer);
+ if Assigned(OutputLineCallback) then
+ repeat
+ CR := Pos(NativeCarriageReturn, Line);
+ if CR = Length(Line) then
+ CR := 0; // line feed at CR + 1 might be missing
+ LF := Pos(NativeLineFeed, Line);
+ if (CR > 0) and ((LF > CR + 1) or (LF = 0)) then
+ LF := CR; // accept CR as line end
+ if LF > 0 then
+ begin
+ ProcessLine(Line, LF);
+ Delete(Line, 1, LF);
+ end;
+ until LF = 0;
+ end;
+
+var
+ Buffer: TBuffer;
+ Line: string;
+ PipeBytesRead: Cardinal;
+{$IFDEF MSWINDOWS}
+var
+ StartupInfo: TStartupInfo;
+ ProcessInfo: TProcessInformation;
+ SecurityAttr: TSecurityAttributes;
+ PipeRead, PipeWrite: THandle;
+ PCurrentDir: PChar;
+begin
+ Result := $FFFFFFFF;
+ SecurityAttr.nLength := SizeOf(SecurityAttr);
+ SecurityAttr.lpSecurityDescriptor := nil;
+ SecurityAttr.bInheritHandle := True;
+ PipeWrite := 0;
+ PipeRead := 0;
+ Line := '';
+ ResetMemory(Buffer, SizeOf(Buffer));
+ if not CreatePipe(PipeRead, PipeWrite, @SecurityAttr, 0) then
+ begin
+ Result := GetLastError;
+ Exit;
+ end;
+ ResetMemory(StartupInfo, SizeOf(TStartupInfo));
+ StartupInfo.cb := SizeOf(TStartupInfo);
+ StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
+ StartupInfo.wShowWindow := SW_HIDE;
+ StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
+ StartupInfo.hStdOutput := PipeWrite;
+ StartupInfo.hStdError := PipeWrite;
+ UniqueString(CommandLine); // CommandLine must be in a writable memory block
+ ProcessInfo.dwProcessId := 0;
+ try
+ if CurrentDir <> '' then
+ PCurrentDir := PChar(CurrentDir)
+ else
+ PCurrentDir := nil;
+ if Winapi.Windows.CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS,
+ nil, PCurrentDir, StartupInfo, ProcessInfo) then
+ begin
+ CloseHandle(PipeWrite);
+ PipeWrite := 0;
+ if AbortPtr <> nil then
+ {$IFDEF FPC}
+ AbortPtr^ := 0;
+ {$ELSE ~FPC}
+ AbortPtr^ := False;
+ {$ENDIF ~FPC}
+ PipeBytesRead := 0;
+ while ((AbortPtr = nil) or not LongBool(AbortPtr^)) and
+ ReadFile(PipeRead, Buffer, BufferSize, PipeBytesRead, nil) and (PipeBytesRead > 0) do
+ ProcessBuffer(Buffer, Line, PipeBytesRead);
+ if (AbortPtr <> nil) and LongBool(AbortPtr^) then
+ TerminateProcess(ProcessInfo.hProcess, Cardinal(ABORT_EXIT_CODE));
+ if (WaitForSingleObject(ProcessInfo.hProcess, INFINITE) = WAIT_OBJECT_0) and
+ not GetExitCodeProcess(ProcessInfo.hProcess, Result) then
+ Result := $FFFFFFFF;
+ CloseHandle(ProcessInfo.hThread);
+ ProcessInfo.hThread := 0;
+ CloseHandle(ProcessInfo.hProcess);
+ ProcessInfo.hProcess := 0;
+ end
+ else
+ begin
+ CloseHandle(PipeWrite);
+ PipeWrite := 0;
+ end;
+ CloseHandle(PipeRead);
+ PipeRead := 0;
+ finally
+ if PipeRead <> 0 then
+ CloseHandle(PipeRead);
+ if PipeWrite <> 0 then
+ CloseHandle(PipeWrite);
+ if ProcessInfo.hThread <> 0 then
+ CloseHandle(ProcessInfo.hThread);
+ if ProcessInfo.hProcess <> 0 then
+ begin
+ TerminateProcess(ProcessInfo.hProcess, Cardinal(ABORT_EXIT_CODE));
+ WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
+ GetExitCodeProcess(ProcessInfo.hProcess, Result);
+ CloseHandle(ProcessInfo.hProcess);
+ end;
+ end;
+{$ENDIF MSWINDOWS}
+{$IFDEF UNIX}
+var
+ Pipe: PIOFile;
+ Cmd: string;
+begin
+ Cmd := Format('%s 2>&1', [CommandLine]);
+ Pipe := nil;
+ try
+ Pipe := Libc.popen(PChar(Cmd), 'r');
+ { TODO : handle Abort }
+ repeat
+ PipeBytesRead := fread_unlocked(@Buffer, 1, BufferSize, Pipe);
+ if PipeBytesRead > 0 then
+ ProcessBuffer(Buffer, Line, PipeBytesRead);
+ until PipeBytesRead = 0;
+ Result := pclose(Pipe);
+ Pipe := nil;
+ wait(nil);
+ finally
+ if Pipe <> nil then
+ pclose(Pipe);
+ wait(nil);
+ end;
+{$ENDIF UNIX}
+ if Line <> '' then
+ if Assigned(OutputLineCallback) then
+ // output wasn't terminated by a line feed...
+ // (shouldn't happen, but you never know)
+ ProcessLine(Line, Length(Line))
+ else
+ if RawOutput then
+ Output := Output + Line
+ else
+ Output := Output + MuteCRTerminatedLines(Line);
+end;
+
+class function TVCSClient.ExecuteCmd(const CommandLine: string;
+ var Output: string;
+ RawOutput: Boolean = False;
+ AbortPtr: PBoolean = nil;
+ const CurrentDir: string = ''): Cardinal;
+begin
+ Result := InternalExecute(CommandLine, Output, nil, RawOutput, AbortPtr, CurrentDir);
+end;
+
+class function TVCSClient.ExecuteCmd(const CommandLine: string;
+ OutputLineCallback: TTextHandler;
+ RawOutput: Boolean = False;
+ AbortPtr: PBoolean = nil;
+ const CurrentDir: string = ''): Cardinal;
+var
+ Dummy: string;
+begin
+ Dummy := '';
+ Result := InternalExecute(CommandLine, Dummy, OutputLineCallback, RawOutput, AbortPtr, CurrentDir);
+end;
+
+{$ENDREGION}
+
+function TVCSClient.CreateProcess(const ACommand: string; ACurrentDir: string = ''; const AShow: boolean = False): boolean;
+var
+ SUI: TStartupInfo;
+ Command: string;
+ ProcInfo: TProcessInformation;
+begin
+ try
+ SUI := Default(TStartupInfo);
+ SUI.cb := SizeOf(SUI);
+ if ACurrentDir = '' then
+ ACurrentDir := FRoot;
+ if not AShow then begin
+ SUI.dwFlags := STARTF_USESHOWWINDOW;
+ SUI.wShowWindow := SW_MINIMIZE;
+ end;
+ Command := ACommand;
+ UniqueString(Command);
+ Result := Winapi.Windows.CreateProcess(nil, PChar(Command), nil, nil, False,
+ CREATE_UNICODE_ENVIRONMENT,
+ nil,
+ PChar(ACurrentDir),
+ SUI, ProcInfo);
+ except
+ Result := False;
+ end;
+end {CreateProcess};
+
+
+
+class function TVCSClient.CreateForPath(const APath: string): TVCSClient;
+var
+ VCSClass: TVCSClientClass;
+ RootPath: string;
+begin
+ for VCSClass in FRegisteredVCSes do begin
+ if VCSClass.IsRepo(APath, RootPath) then begin
+ Result := VCSClass.Create(APath);
+ Exit;
+ end;
+ end;
+ Result := nil;
+end;
+
+class procedure TVCSClient.RegisterVCSClass(const VCSClass: TVCSClientClass);
+begin
+ FRegisteredVCSes.Add(VCSClass);
+end;
+
+end.
ADDED src/vcsinfo.View.pas
Index: src/vcsinfo.View.pas
==================================================================
--- /dev/null
+++ src/vcsinfo.View.pas
@@ -0,0 +1,235 @@
+unit vcsinfo.View;
+
+interface
+uses
+ ToolsAPI, System.Classes, System.Generics.Collections;
+
+type
+ TNotifiers = class(TNotifierObject,
+ IOTAIDENotifier, IOTAIDENotifier50, IOTAIDENotifier80,
+ IOTAModuleNotifier, IOTAModuleNotifier80, IOTAModuleNotifier90)
+ private
+ FModules: TDictionary;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ procedure LogMessage(const Text: string; const Args: array of const); overload;
+ procedure LogMessage(const Text: string); overload;
+ public
+ { IOTAIDENotifier }
+
+ { This procedure is called for many various file operations within the
+ IDE }
+ procedure FileNotification(NotifyCode: TOTAFileNotification;
+ const FileName: string; var Cancel: Boolean);
+ { This function is called immediately before the compiler is invoked.
+ Set Cancel to True to cancel the compile }
+ procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
+ { This procedure is called immediately following a compile. Succeeded
+ will be true if the compile was successful }
+ procedure AfterCompile(Succeeded: Boolean); overload;
+
+ { IOTAIDENotifier50 }
+
+ { Same as BeforeCompile on IOTAIDENotifier except indicates if the compiler
+ was invoked due to a CodeInsight compile }
+ procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean;
+ var Cancel: Boolean); overload;
+ { Same as AfterCompile on IOTAIDENotifier except indicates if the compiler
+ was invoked due to a CodeInsight compile }
+ procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload;
+
+ { IOTAIDENotifier80 }
+
+ { Same as AfterCompile on IOTAIDENotifier except adds a project, like it
+ should have done all along. }
+ procedure AfterCompile(const Project: IOTAProject; Succeeded:
+ Boolean; IsCodeInsight: Boolean); overload;
+ public
+ { IOTAModuleNotifier }
+
+ { CheckOverwrite is called during a SaveAs operation to determine if any
+ files associated with this module will overwrite any other files.
+ Return True to allow the overwrite or no overwrite will occur }
+ function CheckOverwrite: Boolean;
+ { User has renamed the module }
+ procedure ModuleRenamed(const NewName: string);
+
+ {IOTAModuleNotifier80 }
+
+ { AllowSave is called immediately prior to doing any type of save operation
+ in order to allow any add-ins to enable/disable the saving of any specific
+ module. This is useful when one module is to be kept in sync with another
+ module such as keeping the name of a module the same base name as the
+ project. }
+ function AllowSave: Boolean;
+ { GetOverwriteFileNameCount returns the number of filenames to check for an
+ overwrite during a save as operation. This is simply a list of files that
+ the IDE will check if they exist. If any of these files exist, then the
+ IDE will prompt for an overwrite and display the filename in the overwrite
+ prompt dialog. }
+ function GetOverwriteFileNameCount: Integer;
+ { GetOverwriteFileName returns the index'd filename for the IDE to check for
+ existence during a save as operation. }
+ function GetOverwriteFileName(Index: Integer): string;
+ { SetSaveFileName will be called with the fully qualified filename that the
+ user entered in the Save As dialog. This name can then be used to
+ determine all the resulting names }
+ procedure SetSaveFileName(const FileName: string);
+
+ property OverwriteFileNameCount: Integer read GetOverwriteFileNameCount;
+ property OverwriteFileNames[Index: Integer]: string read GetOverwriteFileName;
+
+ { IOTAModuleNotifier90 }
+
+ { BeforeRename is call just before the new file is save/renamed on disk.}
+ procedure BeforeRename(const OldFileName, NewFileName: string);
+ { AfterRename is call just after the new file is save/renamed on disk.}
+ procedure AfterRename(const OldFileName, NewFileName: string);
+ end;
+
+
+implementation
+uses
+ System.SysUtils;
+
+{ TVCSInfoView }
+
+constructor TNotifiers.Create;
+begin
+ inherited;
+ FModules := TDictionary.Create;
+end;
+
+destructor TNotifiers.Destroy;
+var
+ Module: IOTAModule;
+begin
+ for Module in FModules.Keys do begin
+ Module.RemoveNotifier(FModules.Items[Module]);
+ end;
+ FModules.Free;
+ inherited;
+end;
+
+procedure TNotifiers.LogMessage(const Text: string; const Args: array of const);
+begin
+ LogMessage(Format(Text, Args));
+end;
+
+procedure TNotifiers.LogMessage(const Text: string);
+const
+ RFC3339: TFormatSettings = (DateSeparator: '-'; TimeSeparator: ':';
+ ShortDateFormat: 'yyyy-MM-dd'; LongDateFormat: 'yyyy-MM-dd';
+ ShortTimeFormat: 'hh:nn:ss'; LongTimeFormat: 'hh:nn:ss.zzz');
+var
+ Messages: IOTAMessageServices;
+ Group: IOTAMessageGroup;
+ TimeStamp, Line: string;
+begin
+ Messages := ToolsAPI.BorlandIDEServices as IOTAMessageServices;
+ Group := Messages.GetGroup(Self.ClassName);
+ if Group = nil then begin
+ Group := Messages.AddMessageGroup(Self.ClassName);
+ Group.CanClose := True;
+ Group.AutoScroll := True;
+ end;
+ TimeStamp := DateTimeToStr(Now, RFC3339);
+ for Line in Text.Replace(#13#10, #10).Split([#10, #13]) do begin
+ Messages.AddTitleMessage(TimeStamp + #9 + Line, Group);
+ if TimeStamp[1] <> #9 then
+ TimeStamp := StringOfChar(#9, 2);
+ end;
+end {TVCSInfoView.LogMessage};
+
+procedure TNotifiers.AfterCompile(Succeeded, IsCodeInsight: Boolean);
+begin
+end;
+
+procedure TNotifiers.AfterCompile(const Project: IOTAProject; Succeeded, IsCodeInsight: Boolean);
+begin
+ if not IsCodeInsight then begin
+ {$MESSAGE WARN 'TODO: update project’s workdir status'}
+ end;
+end;
+
+procedure TNotifiers.AfterCompile(Succeeded: Boolean);
+begin
+end;
+
+procedure TNotifiers.AfterRename(const OldFileName, NewFileName: string);
+begin
+ {$MESSAGE HINT 'TODO: rename in VCS as well'}
+ LogMessage('Renamed "%s" to "%s"', [OldFilename, NewFileName]);
+end;
+
+function TNotifiers.AllowSave: Boolean;
+begin
+ Result := True;
+ {$MESSAGE WARN 'TODO: (re)schedule to refresh the working dir in two seconds'}
+ LogMessage('AllowSave: %d', [Ord(Result)]);
+ (BorlandIDEServices as IOTAModuleServices).CurrentModule.FileName;
+end;
+
+procedure TNotifiers.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
+begin
+end;
+
+procedure TNotifiers.BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean;
+ var Cancel: Boolean);
+begin
+end;
+
+procedure TNotifiers.BeforeRename(const OldFileName, NewFileName: string);
+begin
+end;
+
+function TNotifiers.CheckOverwrite: Boolean;
+begin
+ Result := True;
+end;
+
+procedure TNotifiers.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string;
+ var Cancel: Boolean);
+var
+ NewModule: IOTAModule;
+ Index: Integer;
+begin
+ case NotifyCode of
+ ofnFileOpened: begin
+ {$MESSAGE WARN 'TODO: (re)schedule to refresh the working dir in a second'}
+ LogMessage('File opened: "%s"', [FileName]);
+ NewModule := (BorlandIDEServices as IOTAModuleServices).FindModule(FileName);
+ if Assigned(NewModule) then begin
+ Index := NewModule.AddNotifier(Self);
+ FModules.Add(NewModule, Index);
+ end;
+ end;
+ ofnActiveProjectChanged: begin
+ {$MESSAGE WARN 'TODO: (re)schedule to refresh the working dir in a second'}
+ LogMessage('Active project changed: "%s"', [FileName]);
+ end;
+ end;
+end;
+
+function TNotifiers.GetOverwriteFileName(Index: Integer): string;
+begin
+ Result := '';
+end;
+
+function TNotifiers.GetOverwriteFileNameCount: Integer;
+begin
+ Result := 0;
+end;
+
+procedure TNotifiers.ModuleRenamed(const NewName: string);
+begin
+end;
+
+procedure TNotifiers.SetSaveFileName(const FileName: string);
+begin
+end;
+
+
+end.
Index: todo.md
==================================================================
--- todo.md
+++ todo.md
@@ -108,16 +108,19 @@
- `fossil info` or `fossil status`
* Repo title _(nice to have)_
- `hg -yq root`
- `fossil sqlite3 "SELECT value FROM config WHERE name='project-name'"`
(or `fossil info`, then extract the line starting with `project-name:`)
+* Process rename
+ - `hg -yq rename --after SOURCE DEST`
+ - `fossil rename --soft OLDNAME NEWNAME`
____________________________________________________________________________________________________
TRepoInfo = class
private
- FRepoClient: TRepoClient;
+ FVCSClient: TVCSClient;
FRoot: string;
FLastCheckRepo: TDateTime;
FBranch: string;
FPending: Integer;
@@ -127,13 +130,74 @@
FIncoming: Integer;
FOutgoing: Integer;
FLastCheckRemote: TDateTime;
public
property IsRepo: Boolean read GetIsRepo;
- property Client: TRepoClient read FRepoClient;
+ property Client: TVCSClient read FVCSClient;
property Root: string read FRoot;
property Branch: string; read GetBranch;
property Pending: Integer read GetPending;
property Untracked: Integer read GetUntracked;
property Incoming: Integer read GetIncoming;
property Outgoing: Integer read GetOutgoing;
end;
+
+
+____________________________________________________________________________________________________
+
+TWizard.Create // initialize UI part (add icons, create toolbar)
+ // create repo cache
+ // set up thread queue, timer and/or event handlers
+OnTimer // for current repo, check if any timeout has elapsed; if so, add a task to check it.
+ // if current repo is already being checked, only add it if the new task has more or other
+ // things to do.
+OnFileSaved // for file's repo, reset the workdir status, so it'll have to be refreshed at the next
+ // trigger. Update the UI to reflect current status.
+OnSwitchedModule // if we selected a file in a new repo, update the UI to reflect that. Also
+ // set up thread to refresh anything out of date for that repo.
+ButtonRefresh // refresh all info for the current module or project's repo.
+
+____________________________________________________________________________________________________
+
+
+GetFileRepo(AFile)
+ AFile > FinalFile
+ Map Final to FinalRepoPath in cache,
+ else (via client) RepoPath > FinalRepoPath
+ Get the repo-info for that FinalRepoPath
+ Use the RepoPath when accessing the client
+
+var
+ FFileRepoPaths: TDictionary;
+ FRepoCache: TDictionary;
+
+function FindFileRepo(const AFilename: string): TRepoInfo;
+var
+ FinalFile, RepoRoot, FinalRepoRoot: string;
+ VCSClient, Client: TVCSClient;
+begin
+ Result := Default(TRepoInfo);
+ try
+ FinalFile := FinalPathName(AFilename);
+ except
+ FinalFile := AFilename;
+ end;
+ VCSClient := nil;
+ if not FFileRepoPaths.TryGetValue(FinalFile, {out}FinalRepoRoot) then begin
+ for Client in VCSClients do begin
+ if Client.IsInRepo(AFilename, {out} RepoRoot) then begin
+ FinalRepoRoot := FinalPathName(RepoRoot);
+ VCSClient := Client;
+ Break;
+ end;
+ end;
+ if VCSClient = nil then
+ Exit;
+ end;
+ if not FRepoCache.TryGetValue(FinalRepoRoot, {out}Result) and Assigned(VCSClient) then begin
+ Result := TRepoInfo.Create(RepoRoot, VCSClient);
+ FRepoCache.Add(FinalRepoRoot, Result);
+ FFileRepoPaths.AddOrSetValue(FinalFile, FinalRepoRoot);
+ end;
+end {FindFileRepo};
+
+