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 - - - - VCSInfo.dpk - - - 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}; + +