From cb3d20f96967b6ddcbd66df172595ccfef09ee4d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 28 Oct 2024 14:57:50 +0000 Subject: [PATCH 001/222] Fix XMLDoc format error in UUserDBMove.pas --- Src/UUserDBMove.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Src/UUserDBMove.pas b/Src/UUserDBMove.pas index 447594147..2af3f4056 100644 --- a/Src/UUserDBMove.pas +++ b/Src/UUserDBMove.pas @@ -47,8 +47,8 @@ TUserDBMove = class(TObject) /// Instance of class used to perform directory move. fDirCopier: TDirectoryCopier; /// Validates source and destination directories. - /// Raises EInOutError exception if either directory is not - /// valid. + /// Raises EInOutError exception if either directory is not + /// valid. procedure ValidateDirectories; /// Handles TDirectoryCopier.OnAfterCopyDir event to update user /// database location. From b09981100ac3c8b42e83be46d5167ab9976511df Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 28 Oct 2024 19:03:19 +0000 Subject: [PATCH 002/222] Add database design documents database-structure.md to describe the database structure database-io to describe how the database's data sources are read/written --- Docs/Design/database-io.md | 150 ++++++++++++++++++++++++++++++ Docs/Design/database-structure.md | 29 ++++++ 2 files changed, 179 insertions(+) create mode 100644 Docs/Design/database-io.md create mode 100644 Docs/Design/database-structure.md diff --git a/Docs/Design/database-io.md b/Docs/Design/database-io.md new file mode 100644 index 000000000..200271862 --- /dev/null +++ b/Docs/Design/database-io.md @@ -0,0 +1,150 @@ +# Database IO Design + +Both user defined and "main" snippets are stored in the same data structure. + +## Loading + +When the database is loaded the following happens: + +### Top level + +`TDatabaseIOFactory` is called twice, in a predefined, significant order: + +1. `TDatabaseIOFactory.CreateMainDBLoader` is called to create a `IDatabaseLoader` object for the main database. That object's `Load` method is called. +2. `TDatabaseIOFactory.CreateUserDBLoader` is called to create another `IDatabaseLoader` object, this time for the user databse. That object's `Load` method is then called. + +> ⭐ When adding further data sources, instead of hard wiring the `TDatabaseIOFactory.CreateXXX` methods, we will need to create `IDatabaseLoader` instances for each registered data source. It may be a good idea initially to hard wire the "main" and "user" databases at the start of the data source registry and ensure they are all called in the right order. + +The order the loading is done is to ensure any references to snippets in the main database are valid when the user database is loaded. This is because the user database can reference snippets in the main database, but not vice versa. + +> ⭐ When implementing additional data sources we may need to prevent references across data sources. + +### Level 2: `IDatabaseLoader` + +`IDatabaseLoader` is defined as: + +```pascal + IDatabaseLoader = interface(IInterface) + ['{C6AF94FC-F56F-44AE-9E79-3B0CD0BB21D4}'] + procedure Load(const SnipList: TSnippetList; + const Categories: TCategoryList; + const DBDataItemFactory: IDBDataItemFactory); + end; +``` + +Implementations of the single `Load` method create and store loaded snippets and categories in `SnipList` & `Categories` respectively. They use `IDBDataItemFactory` methods to create snippet and category objects. + +There are the following `IDatabaseLoader` implementations: + +1. `TMainDatabaseLoader` for loading the main database from the main database directory. +2. `TUserDatabaseLoader` for loading the user database from its directory. + +Both the above classes use the template design pattern and descend from an abstract parent class named `TDatabaseLoader`. One of the overridden template methods requires an object to be returned that can read data from the correct database format and expose methods that are called from `TDatabaseLoader`. These reader object are of type `IDataReader`. + +> ⭐ When implementing additional data formats we will need further `IDatabaseLoader` implementations that can read each supported format. If we choose to sub class `TDatabaseLoader` then we will need to provide a suitable `IDataReader` implementation. + +In either case, if no database of either type is found a null object of type `TNulDataReader` (sic) is created that implements `IDataReader` to do nothing. + +### Level 3: `IDataReader` + +`IDataReader` is defined as: + +```pascal + IDataReader = interface(IInterface) + ['{72A8EAD4-05CE-41BF-AE0F-33495757BBFC}'] + function DatabaseExists: Boolean; + function GetAllCatIDs: IStringList; + procedure GetCatProps(const CatID: string; var Props: TCategoryData); + function GetCatSnippets(const CatID: string): IStringList; + procedure GetSnippetProps(const Snippet: string; var Props: TSnippetData); + function GetSnippetXRefs(const Snippet: string): IStringList; + function GetSnippetDepends(const Snippet: string): IStringList; + function GetSnippetUnits(const Snippet: string): IStringList; + end; +``` + +Where: + +* `DatabaseExists` -- Checks if the database exists. This method is always called first. No other methods of `IDataReader` are called if this method returns false. +* `GetAllCatIDs` -- Gets the names of all categories defined in the database. +* `GetCatProps` -- Gets the properties of the category identified by `CatID` and returns them in the `Props` record. +* `GetCatSnippets` -- Returns a list of the names of all snippets in category with ID `CatID`. +* `GetSnippetProps` -- Gets the properties if the snippet with unique `Snippet` and returns them in the `Props` record. +* `GetSnippetXRefs` -- Returns a list of the names of all snippets XRefd by snippet with name `Snippet`. +* `GetSnippetDepends` -- Returns a list of the names of all snippets on which the snippet with name `Snippet` depends. +* `GetSnippetUnits` -- Returns a list of the names of all the units referenced by the snippet with name `Snippet`. + +There are the following `IDataReader` implementations: + +1. `TIniDataReader` that reads the main database's .ini based data format. Instances of this class are created by `TMainDatabaseLoader`. +2. `TXMLDataReader` that read the user database's XML based data format. Instances of this class are created by `TUserDatabaseLoader`. + +> ⭐ Note that, although there is a one-one correspondence between `TMainDatabaseLoader` & `TIniDataReader` and `TUserDatabaseLoader` and `TXMLDataReader`, this does not generalise to other data sources and data format readers. More than one data source could use the same data format. + +> ⭐ When implementing additional data sources we will need `IDataReader` implementations that can read each supported data format. + +## Saving + +Only the user database gets saved, because only this database is editable. When the user database is saved, the following happens: + +`TDatabaseIOFactory` is called to create a `IDatabaseWriter` database writer object. That object's `Write` method is then called. + +> ⭐ When adding further data sources we will need to extend the factory class to create a suitable `IDatabaseWriter` object for the data format being written. + +### Level 2: `IDatabaseWriter` + +`IDatabaseWriter` is defined as: + +```pascal + IDatabaseWriter = interface(IInterface) + ['{F46EE2E3-68A7-4877-9E04-192D15D29BB1}'] + procedure Write(const SnipList: TSnippetList; + const Categories: TCategoryList; const Provider: IDBDataProvider); + end; +``` + +The sole `Write` method writes user data from database object, where `SnipList` and `Categories` contain the snippets and categories to be saved, respectively, and the `Provider` object is used to get snippet and category properties to be written. + +There is just the one `IDatabaseWriter` implementation: `TDatabaseWriter` that saves the user database. It creates and uses a `IDataWriter` instance to perform the actual output. + +> ⭐ When adding further data formats we will need different `IDataWriter` implementations that can write data in the correct format. + +### Level 3: `IDataWriter` + +`IDataWriter` is defined as follows: + +```pascal + IDataWriter = interface(IInterface) + ['{71E892C4-6E0F-480A-9DF4-70835F83A0CA}'] + procedure Initialise; + procedure WriteCatProps(const CatID: string; const Props: TCategoryData); + procedure WriteCatSnippets(const CatID: string; + const SnipList: IStringList); + procedure WriteSnippetProps(const SnippetName: string; + const Props: TSnippetData); + procedure WriteSnippetUnits(const SnippetName: string; + const Units: IStringList); + procedure WriteSnippetDepends(const SnippetName: string; + const Depends: IStringList); + procedure WriteSnippetXRefs(const SnippetName: string; + const XRefs: IStringList); + procedure Finalise; + end; +``` + +Where: + +* `Initialise` -- Initialise the output. Always called before any other methods. +* `WriteCatProps` -- Writes the properties per `Props` of the category with ID `CatID`. +* `WriteCatSnippets` -- Writes the list of snippets whose names are in `SnipList` belonging to category `CatID`. Always called after `WriteCatProps` for a given category. +* `WriteSnippetProps` -- Writes the properties from `Props` for snippet named `SnippetName`. Always called after all categories are written and before `WriteSnippetUnits`, so can be used to perform any per-snippet intialisation. +* `WriteSnippetUnits` -- Writes the list of units per `Units` referenced by the snippet named `SnippetName`. +* `WriteSnippetDepends` -- Writes the list of snippets names in `Depends` that are depended upon by the snippet named `SnippetName`. +* `WriteSnippetXRef` -- Writes the list of snippets names in `XRefs` that are cross referenced by the snippet named `SnippetName`. +* `Finalise` -- Finalises the writing. Always called after all other methods. + +There is only the one `IDataWriter` implementation. That is `TXMLDataWriter` that writes the user database data in the required XML format. + +> ⭐ When adding further data formats we will need further data writer implementations + +> ⭐ There is not necessarily a one-one correspondence between data sources and formats, so the same `IDataWriter` implementation could be used for more than one data source. diff --git a/Docs/Design/database-structure.md b/Docs/Design/database-structure.md new file mode 100644 index 000000000..1a363d539 --- /dev/null +++ b/Docs/Design/database-structure.md @@ -0,0 +1,29 @@ +# Database Structure Design + +## Overview + +CodeSnip maintains a database comprising snippets from two data sources: + +1. The _"main"_ data source -- Read only snippets read from data downloaded from the [DelphiDabbler Code Snippets Collection](https://github.com/delphidabbler/code-snippets). + +2. The _"user"_ data source -- Snippets created by the user that can be created, edited and deleted from within CodeSnip. These snippets are stored on the user's computer in a special directory. It is possible to import snippets exported from another user's snippets collection or from the [SWAG Archive](https://github.com/delphidabbler/swag). Such imported snippets become part of the user's own "user" data source and retain no knowledge of where they originally came from. + +The database also contains various category records. Categories read from the main data source can't be edited. Categories created by the user are stored in the user data source. Snippets from the user data source can reference categories from the main data source, but the reverse never happens. + +Throughout much of CodeSnip's documentation, the "main" and "user" data sources will be referred to as the "main" and "user" databases. However, there is only one database that has two data sources: "main" and "user". + +## Tables + +Internally, CodeSnip maintains two in-memory tables: + +1. The _snippets_ table -- Contains a record for each snippet +2. The _categories_ table -- Contains a record for each category + +Both Snippet and Category records identify which data source they belong to by means of a `UserDefined` field. This is true for the "user" data source and false for the "main" data source. + +> ⭐ When adding further data sources we will need to change the `UserDefined` fields to something like `DataSource` or `Origin` so we know which data source the snippet belongs to. + +> ⭐ When creating snippets we will need to get the user to specify a data source for. Since it's very likely that a snippet will be mis-allocated we will also need to provide a way to move snippets between data sources. + +> ⭐ For as long as the "main" data source is special, we will need a property or method for snippets like `IsEditable` or `IsMain` that can be used to prevent editing a snippet. + From 9066a07985ee494c6350d5a0ab1e54aef70d465b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 28 Oct 2024 23:28:14 +0000 Subject: [PATCH 003/222] Add TryStrToByte function to UUtils unit Also corrected XMLDoc comments for TryStrToWord. --- Src/UUtils.pas | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/Src/UUtils.pas b/Src/UUtils.pas index 279d62080..d3ec22136 100644 --- a/Src/UUtils.pas +++ b/Src/UUtils.pas @@ -3,7 +3,7 @@ * v. 2.0. If a copy of the MPL was not distributed with this file, You can * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2024, Peter Johnson (gravatar.com/delphidabbler). * * General utility routines. } @@ -174,13 +174,23 @@ function IsEqualBytes(const BA1, BA2: TBytes): Boolean; overload; /// Attempts to convert string S into a Word value. /// string [in] String to be converted. -/// Cardinal [out] Value of converted string. Undefined if +/// Word [out] Value of converted string. Undefined if /// conversion fails. /// Boolean. True if conversion succeeds, False if not. /// String must represent a non-negative integer that is representable /// as a Word. function TryStrToWord(const S: string; out W: Word): Boolean; +/// Attempts to convert string S into a Byye value. +/// string [in] String to be converted. +/// Byte [out] Value of converted string. Undefined if +/// conversion fails. +/// Boolean. True if conversion succeeds, False if not. +/// String must represent a non-negative integer that is representable +/// as a Byte. +function TryStrToByte(const S: string; out B: Byte): Boolean; + + implementation @@ -473,5 +483,17 @@ function TryStrToWord(const S: string; out W: Word): Boolean; W := Word(I); end; +function TryStrToByte(const S: string; out B: Byte): Boolean; +var + I: Integer; +begin + Result := TryStrToInt(S, I); + if not Result then + Exit; + if (I < Low(Byte)) or (I > High(Byte)) then + Exit(False); + B := Byte(I); +end; + end. From a5d2b5598ffddfe99174ad75318ce853ec16dfce Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 28 Oct 2024 23:48:09 +0000 Subject: [PATCH 004/222] Add methods to get & set byte arrays in settings New methods added to ISettingsSection and TIniSettingsSection that store byte arrays as comma delimited lists of decimal values in range 0..255. --- Src/USettings.pas | 87 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 85 insertions(+), 2 deletions(-) diff --git a/Src/USettings.pas b/Src/USettings.pas index 5e38e3227..bd6227e62 100644 --- a/Src/USettings.pas +++ b/Src/USettings.pas @@ -119,6 +119,20 @@ interface /// regardless of locale. procedure SetDateTime(const Name: string; const Value: TDateTime); + /// Gets a named byte array from settings. + /// string [in] Name of value. + /// TBytes. The required array of bytes. + /// The value is stored as a comma separated sequence of decimal + /// values in the range 0..255. + function GetBytes(const Name: string): TBytes; + + /// Stores a named byte array in settings. + /// string [in] Name of value. + /// TBytes [in] Byte array to be recorded. + /// The bytes must be stored as comma separated decimal values. + /// + procedure SetBytes(const Name: string; const Value: TBytes); + /// Gets a list of related string values from the section. /// /// string [in] Name of an integer value that @@ -222,7 +236,8 @@ implementation UAppInfo, UHexUtils, UIOUtils, - UStrUtils; + UStrUtils, + UUtils; var @@ -442,7 +457,7 @@ TIniSettingsSection = class(TIniSettingsBase, ISettingsSection) /// Records a named date time value in settings. /// string [in] Name of value. - /// TDateTime [in] Value to be recored. + /// TDateTime [in] Value to be recorded. /// /// The value must be stored in YYYY-MM-DD hh:mm:ss format /// regardless of locale. @@ -450,6 +465,26 @@ TIniSettingsSection = class(TIniSettingsBase, ISettingsSection) /// procedure SetDateTime(const Name: string; const Value: TDateTime); + /// Gets a named byte array from settings. + /// string [in] Name of value. + /// TBytes. The required array of bytes. + /// + /// The value is stored as a comma separated sequence of decimal + /// values in the range 0..255. + /// Method of ISettingsSection. + /// + function GetBytes(const Name: string): TBytes; + + /// Stores a named byte array in settings. + /// string [in] Name of value. + /// TBytes [in] Byte array to be recorded. + /// + /// The bytes must be stored as comma separated decimal values. + /// + /// Method of ISettingsSection. + /// + procedure SetBytes(const Name: string; const Value: TBytes); + /// Gets a list of related string values from the section. /// /// string [in] Name of an integer value that @@ -475,6 +510,7 @@ TIniSettingsSection = class(TIniSettingsBase, ISettingsSection) /// Method of ISettingsSection. procedure SetStrings(const CountName, ItemFmt: string; Value: IStringList); + end; function Settings: ISettings; @@ -589,6 +625,35 @@ function TIniSettingsSection.GetBoolean(const Name: string; Result := not StrMatchText(ValStr, ['0', 'false', 'no', 'n']); end; +function TIniSettingsSection.GetBytes(const Name: string): TBytes; +var + ValStr: string; + ValSL: TStrings; + B: Byte; + Idx: Integer; +begin + ValStr := StrTrim(GetItemValue(Name)); + if ValStr = '' then + begin + SetLength(Result, 0); + Exit; + end; + ValSL := TStringList.Create; + try + StrExplode(ValStr, ',', ValSL, False, True); + SetLength(Result, ValSL.Count); + for Idx := 0 to Pred(ValSL.Count) do + begin + if TryStrToByte(ValSL[Idx], B) then + Result[Idx] := B + else + Result[Idx] := 0; + end; + finally + ValSL.Free; + end; +end; + function TIniSettingsSection.GetDateTime(const Name: string; const Default: TDateTime): TDateTime; var @@ -702,6 +767,24 @@ procedure TIniSettingsSection.SetBoolean(const Name: string; SetItemValue(Name, BoolStrs[Value]); end; +procedure TIniSettingsSection.SetBytes(const Name: string; + const Value: TBytes); +var + SL: TStrings; + B: Byte; +begin + SL := TStringList.Create; + try + for B in Value do + begin + SL.Add(IntToStr(B)); + end; + SetItemValue(Name, StrJoin(SL, ',')); + finally + SL.Free; + end; +end; + procedure TIniSettingsSection.SetDateTime(const Name: string; const Value: TDateTime); begin From 2220309f3fb0fe73fb45a8702360a7efb161139d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 29 Oct 2024 01:43:18 +0000 Subject: [PATCH 005/222] Add GUIDToBytes routine to UUtils unit --- Src/UUtils.pas | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/Src/UUtils.pas b/Src/UUtils.pas index d3ec22136..434fb0a4b 100644 --- a/Src/UUtils.pas +++ b/Src/UUtils.pas @@ -172,6 +172,11 @@ function IsEqualBytes(const BA1, BA2: TBytes; const Count: Cardinal): /// If both arrays are empty they are considered equal. function IsEqualBytes(const BA1, BA2: TBytes): Boolean; overload; +/// Converts a TGUID record into an array of bytes. +/// TGUID [in] GUID to be converted. +/// TBytes. Required byte array. +function GUIDToBytes(const AGUID: TGUID): TBytes; + /// Attempts to convert string S into a Word value. /// string [in] String to be converted. /// Word [out] Value of converted string. Undefined if @@ -471,6 +476,19 @@ function IsEqualBytes(const BA1, BA2: TBytes): Boolean; Result := True; end; +function GUIDToBytes(const AGUID: TGUID): TBytes; +type + TGUIDCracker = array[1..SizeOf(TGUID) div SizeOf(Byte)] of Byte; +var + Idx: Integer; +begin + Assert(SizeOf(TGUID) = SizeOf(TGUIDCracker), + 'GUIDToBytes: Size of TGUID <> size of TGUIDCracker'); + SetLength(Result, SizeOf(TGUIDCracker)); + for Idx := Low(TGUIDCracker) to High(TGUIDCracker) do + Result[Idx - Low(TGUIDCracker)] := TGUIDCracker(AGUID)[Idx]; +end; + function TryStrToWord(const S: string; out W: Word): Boolean; var I: Integer; From cee2aff0869b7d3f0ca69cb19407b90d1c7b22ef Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 29 Oct 2024 21:06:17 +0000 Subject: [PATCH 006/222] Add new hex conversion routines to UUtils unit Added TryHexStringToBytes and BytesToHexString routines --- Src/UUtils.pas | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) diff --git a/Src/UUtils.pas b/Src/UUtils.pas index 434fb0a4b..285197f30 100644 --- a/Src/UUtils.pas +++ b/Src/UUtils.pas @@ -195,6 +195,27 @@ function TryStrToWord(const S: string; out W: Word): Boolean; /// as a Byte. function TryStrToByte(const S: string; out B: Byte): Boolean; +/// Converts a byte array to a string that is a concatentation of the +/// hex representation of the bytes of the array. +/// TBytes [in] Byte array to convert. +/// string. String of hex digits or empty string if BA is empty. +/// +/// The returned string is twice the length of BA, since each byte +/// occupies two hex digits. +function BytesToHexString(const BA: TBytes): string; + +/// Attempts to convert a string of hex digits to an array of bytes. +/// +/// string [in] String of hex digits. Alphabetic +/// characters can be either upper or lower case. +/// TBytes [out] Array of bytes converted from string. +/// Undefined if conversion fails. +/// Boolean. True if conversion succeeds, False if not. +/// String must be composed of valid hex digits, with two characters +/// per byte. Therefore the string must have an even number of characters. +/// +function TryHexStringToBytes(const AHexStr: string; out ABytes: TBytes): + Boolean; implementation @@ -513,5 +534,41 @@ function TryStrToByte(const S: string; out B: Byte): Boolean; B := Byte(I); end; +function BytesToHexString(const BA: TBytes): string; +var + B: Byte; +begin + Result := ''; + for B in BA do + Result := Result + IntToHex(B, 2); +end; + +function TryHexStringToBytes(const AHexStr: string; out ABytes: TBytes): + Boolean; +const + HexByteStrLength = 2; +var + HexByteStart: Integer; + HexByteStr: string; + ResIdx: Integer; + ConvertedByte: Byte; +begin + Result := True; + if Length(AHexStr) mod HexByteStrLength <> 0 then + Exit(False); + SetLength(ABytes, Length(AHexStr) div HexByteStrLength); + ResIdx := 0; + HexByteStart := 1; + while HexByteStart < Length(AHexStr) do + begin + HexByteStr := Copy(AHexStr, HexByteStart, HexByteStrLength); + if not TryStrToByte('$' + HexByteStr, ConvertedByte) then + Exit(False); + ABytes[ResIdx] := ConvertedByte; + Inc(HexByteStart, HexByteStrLength); + Inc(ResIdx); + end; +end; + end. From 5d0550cf46f39b26a61ec3b4b24a62bccdb5534e Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 29 Oct 2024 21:10:20 +0000 Subject: [PATCH 007/222] Add new tests to TestUUtils unit Added tests for: * Two overloads for IsEqualBytes * BytesToHexString * TryHexStringToBytes --- Tests/Src/DUnit/TestUUtils.pas | 87 ++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) diff --git a/Tests/Src/DUnit/TestUUtils.pas b/Tests/Src/DUnit/TestUUtils.pas index f4c117554..845dbcb10 100644 --- a/Tests/Src/DUnit/TestUUtils.pas +++ b/Tests/Src/DUnit/TestUUtils.pas @@ -24,6 +24,10 @@ TTestUtilsRoutines = class(TTestCase) procedure TestIsValidDriveLetter; procedure TestURIBaseName; procedure TestTryStrToCardinal; + procedure TestIsEqualBytes_NoCount_overload; + procedure TestIsEqualBytes_Count_overload; + procedure TestBytesToHexString; + procedure TestTryHexStringToBytes; end; @@ -37,6 +41,22 @@ implementation { TTestUtilsRoutines } +procedure TTestUtilsRoutines.TestBytesToHexString; +const + B0Str = ''; + B1Str = 'FA'; + B2Str = '010EAA42B656'; +var + BA0, BA1, BA2: TBytes; +begin + BA0 := TBytes.Create(); + BA1 := TBytes.Create($fa); + BA2 := TBytes.Create($01, $0E, $AA, $42, $B6, $56); + CheckEquals(B0Str, BytesToHexString(BA0), 'BA0'); + CheckEquals(B1Str, BytesToHexString(BA1), 'BA1'); + CheckEquals(B2Str, BytesToHexString(BA2), 'BA2'); +end; + procedure TTestUtilsRoutines.TestFloatToInt; begin CheckEquals(42, FloatToInt(42.0), 'Test 1'); @@ -80,6 +100,50 @@ procedure TTestUtilsRoutines.TestIsBaseFileName; CheckFalse(IsBaseFileName(''), 'Test 9'); end; +procedure TTestUtilsRoutines.TestIsEqualBytes_Count_overload; +var + B0, B0a, B1, B1a, B2, B3, B4: TBytes; +begin + B0 := TBytes.Create(); + B0a := TBytes.Create(); + B1 := TBytes.Create(1,2,3,4,5,6,7,8,9,10); + B1a := TBytes.Create(1,2,3,4,5,6,7,8,9,10); + B2 := TBytes.Create(1,2,3,4,5,6,7,8,9,11); + B3 := TBytes.Create(1,2,3,4,5,6,7,8,9); + B4 := TBytes.Create(0,1,2,3,4,5,6,7,8,9,10); + CheckTrue(IsEqualBytes(B1, B1a, 10), 'B1 = B1a (10)'); + CheckTrue(IsEqualBytes(B1, B2, 9), 'B1 = B2 (9)'); + CheckFalse(IsEqualBytes(B1, B2, 10), 'B1 <> B2 (10)'); + CheckFalse(IsEqualBytes(B1, B1a, 15), 'B1 <> B1a (15)'); + CheckFalse(IsEqualBytes(B3, B4, 1), 'B3 <> B4 (1)'); + CheckTrue(IsEqualBytes(B2, B3, 1), 'B2 <> B3 (1)'); + CheckFalse(IsEqualBytes(B0, B0a, 1), 'B0 <> B0a (0)'); +end; + +procedure TTestUtilsRoutines.TestIsEqualBytes_NoCount_overload; +var + B0, B0a, B1, B1a, B2, B3, B4, B5, B5a, B6: TBytes; +begin + B0 := TBytes.Create(); + B0a := TBytes.Create(); + B1 := TBytes.Create(1,2,3,4,5,6,7,8,9,10); + B1a := TBytes.Create(1,2,3,4,5,6,7,8,9,10); + B2 := TBytes.Create(1,2,3,4,5,6,7,8,9,11); + B3 := TBytes.Create(1,2,3,4,5,6,7,8,9); + B4 := TBytes.Create(0,1,2,3,4,5,6,7,8,9,10); + B5 := TBytes.Create(7); + B5a := TBytes.Create(7); + B6 := TBytes.Create(6); + CheckTrue(IsEqualBytes(B1, B1a), 'B1 = B1a'); + CheckTrue(IsEqualBytes(B5, B5a), 'B5 = B5a'); + CheckTrue(IsEqualBytes(B0, B0a), 'B0 = B0a'); + CheckFalse(IsEqualBytes(B1, B2), 'B1 <> B2'); + CheckFalse(IsEqualBytes(B5, B6), 'B5 <> B6'); + CheckFalse(IsEqualBytes(B2, B4), 'B2 <> B4'); + CheckFalse(IsEqualBytes(B0, B4), 'B0 <> B4'); + CheckFalse(IsEqualBytes(B0, B6), 'B0 <> B6'); +end; + procedure TTestUtilsRoutines.TestIsHexDigit; const GoodChars = '1234567890ABCDEFabcdef'; @@ -106,6 +170,29 @@ procedure TTestUtilsRoutines.TestIsValidDriveLetter; CheckFalse(IsValidDriveLetter(BadChars[Idx]), 'Bad Test ' + IntToStr(Idx)); end; +procedure TTestUtilsRoutines.TestTryHexStringToBytes; +const + B0Str = ''; + B1Str = 'FA'; + B2Str = '010EAa42b656'; + Bad1Str = '3abc7'; + Bad2Str = '010EAbx2b656'; +var + BA0, BA1, BA2, Res: TBytes; +begin + BA0 := TBytes.Create(); + BA1 := TBytes.Create($fa); + BA2 := TBytes.Create($01, $0E, $AA, $42, $B6, $56); + CheckTrue(TryHexStringToBytes(B0Str, Res), '#1: Boolean'); + CheckTrue(IsEqualBytes(BA0, Res), '#1: Array'); + Checktrue(TryHexStringToBytes(B1Str, Res), '#2: Boolean'); + CheckTrue(IsEqualBytes(BA1, Res), '#2: Array'); + Checktrue(TryHexStringToBytes(B2Str, Res), '#3: Boolean'); + CheckTrue(IsEqualBytes(BA2, Res), '#3: Array'); + CheckFalse(TryHexStringToBytes(Bad1Str, Res), '#4: Bad length'); + CheckFalse(TryHexStringToBytes(Bad2Str, Res), '#4: Bad digits'); +end; + procedure TTestUtilsRoutines.TestTryStrToCardinal; var V: Cardinal; From e9db068576a45120da1606a6e34591fcd6cc7e8b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 29 Oct 2024 21:15:32 +0000 Subject: [PATCH 008/222] Update settings unit to register new sections Added new ssCollections & ssCollection sections. --- Src/USettings.pas | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/Src/USettings.pas b/Src/USettings.pas index bd6227e62..3f1d26ee8 100644 --- a/Src/USettings.pas +++ b/Src/USettings.pas @@ -179,11 +179,14 @@ interface /// windows /// -ssDatabase - database customisation info /// -ssCompilers - info about all compilers + /// -ssCollections - info about all snippet collections + /// -ssCollection - info about a specific snippet collection /// TSettingsSectionId = ( ssFindText, ssFindCompiler, ssFindXRefs, ssCompilerInfo, ssPreferences, ssUnits, ssDuplicateSnippet, - ssFavourites, ssWindowState, ssDatabase, ssCompilers + ssFavourites, ssWindowState, ssDatabase, ssCompilers, ssCollections, + ssCollection ); type @@ -577,7 +580,9 @@ function TIniSettings.SectionName(const Id: TSettingsSectionId; 'Favourites', // ssFavourites 'WindowState', // ssWindowState 'Database', // ssDatabase - 'Compilers' // ssCompilers + 'Compilers', // ssCompilers + 'Collections', // ssCollections + 'Collection' // ssCollection ); begin Result := cSectionNames[Id]; From 2ed1f99c61ce28877fd7aefb1e2da935d4731b4a Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 30 Oct 2024 12:01:28 +0000 Subject: [PATCH 009/222] Add new DB.Collections unit Provides support for multiple snippets collections. Contains code to: * Encapsulate a collection ID * Encapsulate a collection location * Encapsulate a collection, including ID, name, location and file format. * Maintain a single list of available collections. * Persist the collection list to settings. Uses a singleton to maintain the list of collections. Ensures that collections are always defined that are the equivalent of the CodeSnip 4 "main" & "user" databases. This code may be removed when the changeover from the two databases to multiple data sources is achieved. Some __TMP__ methods are provided to ease the changeover from CodeSnip v4 to v5. --- Src/CodeSnip.dpr | 3 +- Src/CodeSnip.dproj | 1 + Src/DB.UCollections.pas | 685 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 688 insertions(+), 1 deletion(-) create mode 100644 Src/DB.UCollections.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 1fe24aca3..c2c6be15d 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -374,7 +374,8 @@ uses Compilers.USettings in 'Compilers.USettings.pas', FmRegisterCompilersDlg in 'FmRegisterCompilersDlg.pas' {RegisterCompilersDlg}, ClassHelpers.UGraphics in 'ClassHelpers.UGraphics.pas', - ClassHelpers.UActions in 'ClassHelpers.UActions.pas'; + ClassHelpers.UActions in 'ClassHelpers.UActions.pas', + DB.UCollections in 'DB.UCollections.pas'; // Include resources {$Resource ExternalObj.tlb} // Type library file diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index dc6c27915..f0d0f83f1 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -581,6 +581,7 @@ + Base diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas new file mode 100644 index 000000000..b32c1ed09 --- /dev/null +++ b/Src/DB.UCollections.pas @@ -0,0 +1,685 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). + * + * Implements support for multiple snippet collections. +} + + +unit DB.UCollections; + +{$ScopedEnums ON} + +interface + +uses + SysUtils, + Generics.Collections, + UEncodings, + UExceptions, + USettings, + USingleton; + +type + + /// Enumeration of the kinds of supported snippet collection data + /// formats. + /// + /// Error -- Invalid format. Used to indicate an unknown format + /// or other error. + /// DCSC_v2 -- Format used by the DelphiDabbler Code Snippets + /// Collection v2. + /// Native_v4 -- Native format used by CodeSnip v4 to store user + /// snippets. + /// + TCollectionFormatKind = ( // TODO: move to more appropriate unit + // NEVER specify a literal ordinal value in this enumeration. + // NEVER delete or re-order the enumeration items: the ordinal values may + // be written to a config file and changing the ordinal value here can + // cause hard to trace bugs. If an item goes out of use then leave it + // in place & possibly rename the item to indicate its redundancy. + // NEVER associate error with a format loader or saver class. + Error, + DCSC_v2, + Native_v4 + ); + + + TCollectionFormatInfo = record // TODO: move to more appropriate unit + strict private + type + TMapRecord = record + /// Collection data format kind. + Kind: TCollectionFormatKind; + /// Collection data format name. + Name: string; + end; + const + // There are so few entries in this table it's not worth the overhead + // of using a dicitionary for the lookup. + LookupTable: array[0..1] of TMapRecord = ( + (Kind: TCollectionFormatKind.DCSC_v2; + Name: 'DelphiDabbler Code Snippets Collection format v2'), + (Kind: TCollectionFormatKind.Native_v4; + Name: 'CodeSnip v4 native snippet collection format') + ); + class function IndexOf(const AKind: TCollectionFormatKind): Integer; static; + public + /// Gets the name of the data format specified by + /// AKind. Returns an empty string if no name is associated with + /// AKind. + class function GetName(const AKind: TCollectionFormatKind): string; static; + end; + +type + + TCollectionID = record + strict private + var + fID: TBytes; + public + const + DCSC_v2_ID: TGUID = '{9F3A4A8A-0A2B-4088-B7C9-AE1D32D3FF9A}'; + SWAG_v1_ID: TGUID = '{ADA985E0-0929-4986-A3FE-B2C981D430F1}'; + Native_v4_ID: TGUID = '{E63E7160-2389-45F2-B712-EA0449D30B1F}'; + constructor Create(const ABytes: TBytes); overload; + constructor Create(const AStr: string); overload; + constructor Create(const AGUID: TGUID); overload; + class function CreateFromHexString(const AHexStr: string): TCollectionID; + static; + class function CreateNull: TCollectionID; static; + function Clone: TCollectionID; + function ToArray: TBytes; + function ToHexString: string; + function IsBuiltInID: Boolean; + function IsNull: Boolean; + class function Compare(Left, Right: TCollectionID): Integer; static; + class operator Equal(Left, Right: TCollectionID): Boolean; + class operator NotEqual(Left, Right: TCollectionID): Boolean; + {TODO -c__TMP__: remove following __TMP__*** methods} + class function __TMP__MainDBCollectionID: TCollectionID; static; + class function __TMP__UserDBCollectionID: TCollectionID; static; + class function __TMP__DBCollectionID(const AUserDefined: Boolean): TCollectionID; + static; + end; + + ECollectionID = class(ECodeSnip); + + TCollectionLocation = record + strict private + var + fDirectory: string; + fMetaDataFile: string; + fEncodingHint: TEncodingType; + procedure SetDirectory(const ANewDirectory: string); + public + + /// Instantiates a record with given values. + /// string [in] File system directory + /// containing the collection data. Must be non-empty and a valid directory + /// name. + /// string [in] Path to the collection's + /// meta data file, if any. May be empty if collection has no meta data + /// file or if the meta data file name is fixed. If non-empty the path must + /// be relative to ADirectory. Optional: default is empty string. + /// + /// TEncodingType [in] Hints at the + /// encoding used by text files in ADirectory. Only required if the + /// text files are not used in the collection or if the collection format + /// specifies the text format. Optional: default is system default + /// encoding. + constructor Create(const ADirectory: string; + const AMetaDataFile: string = ''; + const AEncodingHint: TEncodingType = TEncodingType.etSysDefault); + + /// File system directory containing the collection data. + /// + /// Must be a valid directory name and must exist. + property Directory: string read fDirectory write SetDirectory; + + /// Name of any meta data file, relative to Directory. + /// + /// May be empty string. If non-empty must be a valid path name + /// and the file must exist. + property MetaDataFile: string read fMetaDataFile; + + /// Hints at the type of encoding used by the text files in + /// Directory. + /// EncodingHint should only be used where the I/O code has + /// no knowledge of the expected text file encoding AND the where the files + /// do not contain preamble bytes that specify the encoding. + property EncodingHint: TEncodingType read fEncodingHint; + + /// Checks if the record instance has valid fields. + function IsValid: Boolean; + + end; + + TCollection = record + strict private + var + fUID: TCollectionID; + fName: string; + fLocation: TCollectionLocation; + fCollectionFormatKind: TCollectionFormatKind; + public + /// Creates a collection record. + /// TCollectionID [in] Unique ID of the + /// collection. Must not be null. + /// string [in] Name of collection. Should be + /// unique. Must not be empty or only whitespace. + constructor Create(const AUID: TCollectionID; const AName: string; + const ALocation: TCollectionLocation; + const ACollectionFormatKind: TCollectionFormatKind); + /// Collection identifier. Must be unique. + property UID: TCollectionID + read fUID; + /// Collection name. Must be unique. + property Name: string read + fName; + /// Collection location information. + property Location: TCollectionLocation + read fLocation; + /// Kind of collection format used for to store data for this + /// collection. + property CollectionFormatKind: TCollectionFormatKind + read fCollectionFormatKind; + /// Checks if this record's fields are valid. + function IsValid: Boolean; + end; + + TCollections = class sealed(TSingleton) + strict private + var + fItems: TList; + function GetItem(const Idx: Integer): TCollection; + class function GetInstance: TCollections; static; + strict protected + procedure Initialize; override; + procedure Finalize; override; + public + class property Instance: TCollections read GetInstance; + function GetEnumerator: TEnumerator; + function IndexOfID(const AUID: TCollectionID): Integer; + function ContainsID(const AUID: TCollectionID): Boolean; + function ContainsName(const AName: string): Boolean; + function GetCollection(const AUID: TCollectionID): TCollection; + procedure Add(const ACollection: TCollection); + procedure Update(const ACollection: TCollection); + procedure AddOrUpdate(const ACollection: TCollection); + procedure Delete(const AUID: TCollectionID); + procedure Clear; + procedure Save; + function ToArray: TArray; + function GetAllIDs: TArray; + function Count: Integer; + property Items[const Idx: Integer]: TCollection read GetItem; default; + end; + + TCollectionsPersist = record + strict private + const + CountKey = 'Count'; + UIDKey = 'UID'; + NameKey = 'Name'; + LocationDirectoryKey = 'Location.Directory'; + LocationMetaDataFileKey = 'Location.MetaDataFile'; + LocationEncodingHintKey = 'Location.EncodingHint'; + DataFormatKey = 'DataFormat'; + class procedure SaveCollection(const AOrdinal: Cardinal; + const ACollection: TCollection); static; + class procedure LoadCollection(const AOrdinal: Cardinal; + const ACollections: TCollections); static; + public + class procedure Save(const ACollections: TCollections); static; + class procedure Load(const ACollections: TCollections); static; + end; + +implementation + +uses + RTLConsts, + IOUtils, + Math, + UAppInfo, // TODO -cVault: needed only for v4 emulation + UStrUtils, + UUtils; + +resourcestring + SBadHexString = 'Invalid Hex String.'; + +{ TCollectionLocation } + +constructor TCollectionLocation.Create(const ADirectory, + AMetaDataFile: string; const AEncodingHint: TEncodingType); +begin + fDirectory := StrTrim(ADirectory); + fMetaDataFile := StrTrim(AMetaDataFile); + fEncodingHint := AEncodingHint; + Assert(IsValid, 'TCollectionLocation.Create: invalid parameter(s)'); +end; + +function TCollectionLocation.IsValid: Boolean; +begin + Result := True; + if fDirectory = '' then + Exit(False); + if not TPath.HasValidPathChars(fDirectory, False) then + Exit(False); + if not TDirectory.Exists(fDirectory) then + Exit(False); + if (fMetaDataFile <> '') then + begin + if not TPath.IsRelativePath(fMetaDataFile) then + Exit(False); + if not TFile.Exists(TPath.Combine(fDirectory, fMetaDataFile)) then + Exit(False); + end; +end; + +procedure TCollectionLocation.SetDirectory(const ANewDirectory: string); +begin + fDirectory := ANewDirectory; +end; + +{ TCollection } + +constructor TCollection.Create(const AUID: TCollectionID; + const AName: string; const ALocation: TCollectionLocation; + const ACollectionFormatKind: TCollectionFormatKind); +var + TrimmedName: string; +begin + TrimmedName := StrTrim(AName); + Assert(not AUID.IsNull, 'TCollection.Create: AUID is null'); + Assert(TrimmedName <> '', + 'TCollection.Create: AName is empty or only whitespace'); + Assert(ALocation.IsValid, 'TCollection.Create: ALocation is not valid'); + Assert(ACollectionFormatKind <> TCollectionFormatKind.Error, + 'TCollection.Create: ACollectionFormatKind = TCollectionFormatKind.Error'); + fUID := AUID.Clone; + fName := TrimmedName; + fLocation := ALocation; + fCollectionFormatKind := ACollectionFormatKind; +end; + +function TCollection.IsValid: Boolean; +begin + {TODO: Constructor enforces all these requirements, so #TCollection.IsValid + may not be needed.} + Result := not fUID.IsNull + and (fName <> '') + and fLocation.IsValid + and (fCollectionFormatKind <> TCollectionFormatKind.Error); +end; + +{ TCollections } + +procedure TCollections.Add(const ACollection: TCollection); +begin + if not ContainsID(ACollection.UID) then + fItems.Add(ACollection); +end; + +procedure TCollections.AddOrUpdate(const ACollection: TCollection); +var + Idx: Integer; +begin + Idx := IndexOfID(ACollection.UID); + if Idx < 0 then + fItems.Add(ACollection) + else + fItems[Idx] := ACollection; +end; + +procedure TCollections.Clear; +begin + fItems.Clear; +end; + +function TCollections.ContainsID(const AUID: TCollectionID): + Boolean; +begin + Result := IndexOfID(AUID) >= 0; +end; + +function TCollections.ContainsName(const AName: string): Boolean; +var + Collection: TCollection; +begin + Result := False; + for Collection in fItems do + if StrSameText(AName, Collection.Name) then + Exit(True); +end; + +function TCollections.Count: Integer; +begin + Result := fItems.Count; +end; + +procedure TCollections.Delete(const AUID: TCollectionID); +var + Idx: Integer; +begin + Idx := IndexOfID(AUID); + if Idx >= 0 then + fItems.Delete(Idx); +end; + +procedure TCollections.Finalize; +begin + Save; + fItems.Free; +end; + +function TCollections.GetAllIDs: TArray; +var + Idx: Integer; +begin + SetLength(Result, fItems.Count); + for Idx := 0 to Pred(fItems.Count) do + Result[Idx] := fItems[Idx].UID; +end; + +function TCollections.GetCollection(const AUID: TCollectionID): TCollection; +var + Idx: Integer; +begin + Idx := IndexOfID(AUID); + if Idx < 0 then + raise EArgumentException.CreateRes(@SGenericItemNotFound); + Result := fItems[Idx]; +end; + +function TCollections.GetEnumerator: TEnumerator; +begin + Result := fItems.GetEnumerator; +end; + +class function TCollections.GetInstance: TCollections; +begin + Result := TCollections.Create; +end; + +function TCollections.GetItem(const Idx: Integer): TCollection; +begin + Result := fItems[Idx]; +end; + +function TCollections.IndexOfID(const AUID: TCollectionID): Integer; +var + Idx: Integer; +begin + Result := -1; + for Idx := 0 to Pred(fItems.Count) do + if AUID = fItems[Idx].UID then + Exit(Idx); +end; + +procedure TCollections.Initialize; +begin + fItems := TList.Create; + TCollectionsPersist.Load(Self); + { TODO -cCollections: following lines are for v4 compatibility + Remove if not required in v5 } + if not ContainsID(TCollectionID.__TMP__MainDBCollectionID) then + Add( + TCollection.Create( + TCollectionID.__TMP__MainDBCollectionID, + { TODO -cVault: change name - this text matches name used in CodeSnip + v4} + 'DelphiDabbler Code Snippets Database', + TCollectionLocation.Create(TAppInfo.AppDataDir), + TCollectionFormatKind.DCSC_v2 + ) + ); + if not ContainsID(TCollectionID.__TMP__UserDBCollectionID) then + Add( + TCollection.Create( + TCollectionID.__TMP__UserDBCollectionID, + { TODO -cVault: change name - this text matches name used in CodeSnip + v4} + 'User Database', + TCollectionLocation.Create(TAppInfo.DefaultUserDataDir, '', etUTF8), + TCollectionFormatKind.Native_v4 + ) + ); +end; + +procedure TCollections.Save; +begin + TCollectionsPersist.Save(Self); +end; + +function TCollections.ToArray: TArray; +begin + Result := fItems.ToArray; +end; + +procedure TCollections.Update(const ACollection: TCollection); +var + Idx: Integer; +begin + Idx := IndexOfID(ACollection.UID); + if Idx >= 0 then + fItems[Idx] := ACollection; +end; + +{ TCollectionID } + +constructor TCollectionID.Create(const ABytes: TBytes); +begin + fID := System.Copy(ABytes); +end; + +constructor TCollectionID.Create(const AStr: string); +begin + fID := TEncoding.UTF8.GetBytes(AStr); +end; + +function TCollectionID.Clone: TCollectionID; +begin + Result := TCollectionID.Create(fID); +end; + +class function TCollectionID.Compare(Left, Right: TCollectionID): Integer; +var + CompareLength: Integer; + Idx: Integer; +begin + CompareLength := Min(Length(Left.fID), Length(Right.fID)); + Result := 0; + for Idx := 0 to Pred(CompareLength) do + begin + Result := Left.fID[Idx] - Right.fID[Idx]; + if Result <> 0 then + Exit; + end; + if Length(Left.fID) < Length(Right.fID) then + Exit(-1) + else if Length(Left.fID) > Length(Right.fID) then + Exit(1); +end; + +constructor TCollectionID.Create(const AGUID: TGUID); +begin + fID := System.Copy(GUIDToBytes(AGUID)); +end; + +class function TCollectionID.CreateFromHexString( + const AHexStr: string): TCollectionID; +var + ConvertedBytes: TBytes; +begin + if not TryHexStringToBytes(AHexStr, ConvertedBytes) then + raise ECollectionID.Create(SBadHexString); + Result := TCollectionID.Create(ConvertedBytes); +end; + +class function TCollectionID.CreateNull: TCollectionID; +var + NullID: TBytes; +begin + SetLength(NullID, 0); + Result := TCollectionID.Create(NullID); +end; + +class operator TCollectionID.Equal(Left, Right: TCollectionID): + Boolean; +begin + Result := IsEqualBytes(Left.fID, Right.fID); +end; + +function TCollectionID.IsBuiltInID: Boolean; +begin + Result := (TCollectionID.Create(DCSC_v2_ID) = Self) + or (TCollectionID.Create(SWAG_v1_ID) = Self); +end; + +function TCollectionID.IsNull: Boolean; +begin + Result := Length(fID) = 0; +end; + +class operator TCollectionID.NotEqual(Left, Right: TCollectionID): + Boolean; +begin + Result := not IsEqualBytes(Left.fID, Right.fID); +end; + +function TCollectionID.ToArray: TBytes; +begin + Result := System.Copy(fID); +end; + +function TCollectionID.ToHexString: string; +begin + Result := BytesToHexString(fID); +end; + +class function TCollectionID.__TMP__DBCollectionID( + const AUserDefined: Boolean): TCollectionID; +begin + if AUserDefined then + Result := __TMP__UserDBCollectionID + else + Result := __TMP__MainDBCollectionID; +end; + +class function TCollectionID.__TMP__MainDBCollectionID: TCollectionID; +begin + Result := TCollectionID.Create(DCSC_v2_ID); +end; + +class function TCollectionID.__TMP__UserDBCollectionID: TCollectionID; +begin + Result := TCollectionID.Create(Native_v4_ID); +end; + +{ TCollectionsPersist } + +class procedure TCollectionsPersist.Load( + const ACollections: TCollections); +var + Storage: ISettingsSection; + Count: Integer; + Idx: Integer; +begin + Storage := Settings.ReadSection(ssCollections); + Count := Storage.GetInteger(CountKey, 0); + for Idx := 0 to Pred(Count) do + LoadCollection(Idx, ACollections); +end; + +class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; + const ACollections: TCollections); +var + Storage: ISettingsSection; + Location: TCollectionLocation; + UID: TCollectionID; + Name: string; + Collection: TCollection; + DataFormat: TCollectionFormatKind; +begin + Storage := Settings.ReadSection(ssCollection, IntToStr(AOrdinal)); + UID := TCollectionID.Create(Storage.GetBytes(UIDKey)); + Name := Storage.GetString(NameKey, ''); + Location := TCollectionLocation.Create( + Storage.GetString(LocationDirectoryKey, ''), + Storage.GetString(LocationMetaDataFileKey, ''), + TEncodingType( + Storage.GetInteger( + LocationEncodingHintKey, Ord(TEncodingType.etSysDefault) + ) + ) + ); + DataFormat := TCollectionFormatKind( + Storage.GetInteger(DataFormatKey, Ord(TCollectionFormatKind.Error)) + ); + Collection := TCollection.Create(UID, Name, Location, DataFormat); + ACollections.Add(Collection); +end; + +class procedure TCollectionsPersist.Save(const + ACollections: TCollections); +var + Storage: ISettingsSection; + Idx: Integer; +begin + // Save number of collections + Storage := Settings.EmptySection(ssCollections); + Storage.SetInteger(CountKey, ACollections.Count); + Storage.Save; + // Save each collection's properties in its own section + for Idx := 0 to Pred(ACollections.Count) do + SaveCollection(Idx, ACollections[Idx]); +end; + +class procedure TCollectionsPersist.SaveCollection(const AOrdinal: Cardinal; + const ACollection: TCollection); +var + Storage: ISettingsSection; +begin + // Save info about collection format in its own section + Storage := Settings.EmptySection(ssCollection, IntToStr(AOrdinal)); + Storage.SetBytes(UIDKey, ACollection.UID.ToArray); + Storage.SetString(NameKey, ACollection.Name); + Storage.SetString(LocationDirectoryKey, ACollection.Location.Directory); + Storage.SetString(LocationMetaDataFileKey, ACollection.Location.MetaDataFile); + Storage.SetInteger( + LocationEncodingHintKey, Ord(ACollection.Location.EncodingHint) + ); + Storage.SetInteger(DataFormatKey, Ord(ACollection.CollectionFormatKind)); + Storage.Save; +end; + +{ TCollectionFormatInfo } + +class function TCollectionFormatInfo.GetName( + const AKind: TCollectionFormatKind): string; +var + Idx: Integer; +begin + Idx := IndexOf(AKind); + if Idx < 0 then + Exit(''); + Result := LookupTable[Idx].Name; +end; + +class function TCollectionFormatInfo.IndexOf( + const AKind: TCollectionFormatKind): Integer; +var + Idx: Integer; +begin + Result := -1; + for Idx := Low(LookupTable) to High(LookupTable) do + if LookupTable[Idx].Kind = AKind then + Exit(Idx); +end; + +end. + From 7ad5e4a240487145d22e45cd1179cba370210548 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 30 Oct 2024 12:54:26 +0000 Subject: [PATCH 010/222] Add CollectionID property to TSnippetID Reimplemented UserDefined property in terms of CollectionID property. Used __TMP__ getter and setter methods to achieve this Removed fUserDefined field. Added overloaded constructor to take collection ID as a parameter. Left original constructor in place that takes UserDefined parameter. Revised CompareTo method to compare CollectionID properties instead of UserDefined properties. Old code was commented out. --- Src/USnippetIDs.pas | 59 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 50 insertions(+), 9 deletions(-) diff --git a/Src/USnippetIDs.pas b/Src/USnippetIDs.pas index 9d775ab89..892290a6f 100644 --- a/Src/USnippetIDs.pas +++ b/Src/USnippetIDs.pas @@ -20,10 +20,13 @@ interface // Delphi Generics.Collections, // Project - IntfCommon; + IntfCommon, + DB.UCollections; type + {TODO -cNote: TSnippetID.UserDefined is now uses CollectionID property.} + /// Record that uniquely identifies a code snippet. Specifies name /// and flag indicating whether snippet is user-defined. @@ -32,17 +35,30 @@ TSnippetID = record var /// Value of Name property. fName: string; - /// Value of UserDefined property. - fUserDefined: Boolean; +// /// Value of UserDefined property. +// fUserDefined: Boolean; + fCollectionID: TCollectionID; +// function __TMP__GetUserDefined: Boolean; +// procedure __TMP__SetUserDefined(const Value: Boolean); + procedure SetCollectionID(const AValue: TCollectionID); public /// Name of snippet. property Name: string read fName write fName; /// Whether snippet is user defined. - property UserDefined: Boolean read fUserDefined write fUserDefined; +// property UserDefined: Boolean read fUserDefined write fUserDefined; + {TODO -cCollections: Remove above property & getter/setter} + + /// ID of the collection to which a snippet with this ID belongs. + /// + /// ID must not be null. + property CollectionID: TCollectionID + read fCollectionID write SetCollectionID; /// Creates a record with given property values. - constructor Create(const AName: string; const AUserDefined: Boolean); + /// ACollectionID must not be null. + constructor Create(const AName: string; const ACollectionID: TCollectionID); + overload; {TODO -cCollections: remove overload} /// Creates copy of given snippet ID constructor Clone(const Src: TSnippetID); @@ -157,7 +173,7 @@ implementation constructor TSnippetID.Clone(const Src: TSnippetID); begin - Create(Src.Name, Src.UserDefined); + Create(Src.Name, Src.CollectionID); end; class function TSnippetID.CompareNames(const Left, Right: string): Integer; @@ -169,15 +185,24 @@ function TSnippetID.CompareTo(const SID: TSnippetID): Integer; begin Result := CompareNames(Name, SID.Name); if Result = 0 then - Result := Ord(UserDefined) - Ord(SID.UserDefined); + // TODO -cNote: New comparison changes ordering (no problem tho!) + Result := TCollectionID.Compare(CollectionID, SID.CollectionID); +// Result := Ord(UserDefined) - Ord(SID.UserDefined); end; -constructor TSnippetID.Create(const AName: string; const AUserDefined: Boolean); +constructor TSnippetID.Create(const AName: string; + const ACollectionID: TCollectionID); begin fName := AName; - fUserDefined := AUserDefined; + SetCollectionID(ACollectionID); end; +//constructor TSnippetID.Create(const AName: string; const AUserDefined: Boolean); +//begin +// fName := AName; +// __TMP__SetUserDefined(AUserDefined); +//end; + class operator TSnippetID.Equal(const SID1, SID2: TSnippetID): Boolean; begin Result := SID1.CompareTo(SID2) = 0; @@ -188,6 +213,22 @@ constructor TSnippetID.Create(const AName: string; const AUserDefined: Boolean); Result := not (SID1 = SID2); end; +procedure TSnippetID.SetCollectionID(const AValue: TCollectionID); +begin + Assert(not AValue.IsNull, 'TSnippetID.SetCollectionID: Value is null'); + fCollectionID := AValue.Clone; +end; + +//function TSnippetID.__TMP__GetUserDefined: Boolean; +//begin +// Result := fCollectionID = TCollectionID.__TMP__UserDBCollectionID; +//end; +// +//procedure TSnippetID.__TMP__SetUserDefined(const Value: Boolean); +//begin +// fCollectionID := TCollectionID.__TMP__DBCollectionID(Value); +//end; + { TSnippetIDList } function TSnippetIDList.Add(const SnippetID: TSnippetID): Integer; From a68244085afa91648a3bf4641fd80a89456378c4 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 30 Oct 2024 13:02:27 +0000 Subject: [PATCH 011/222] Add TSnippet.CollectionID & update TSnippetList Reimplemented TSnippet.UserDefined property in terms of new CollectionID property. Used __TMP__ getter and setter methods to achieve this Removed fUserDefined field from TSnippet. Added overloaded TSnippet constructor to take collection ID as a parameter. Left original constructor in place that takes UserDefined parameter, but changed it to simply call the new constructor with a suitable collection ID. Revised TSnippet.GetID to create a snippet ID using the snippet's CollectionID property instead of the UserDefined property. Updated TSnippetList by adding overloads of all methods that take a UserDefined parameter. Overloads all achieve a similar outcome, but by acting on a TCollectionID parameter. Methods are: * Count * Find (two different overloads) * IsEmpty Reimplemented TSnippetList methods with UserDefined parameters in terms of new methods that take collection ID parameters. Required some __TMP__ calls to do this. Removed redundant private TSnippetList.Find method. Old code was commented out. --- Src/DB.USnippet.pas | 197 ++++++++++++++++++++++++++++++++++++-------- 1 file changed, 161 insertions(+), 36 deletions(-) diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 5af498162..8f9a6f8dc 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -18,10 +18,17 @@ interface uses // Delphi - Classes, Generics.Collections, Generics.Defaults, + Classes, + Generics.Collections, + Generics.Defaults, // Project - ActiveText.UMain, Compilers.UGlobals, DB.USnippetKind, UContainers, - UIStringList, USnippetIDs; + ActiveText.UMain, + Compilers.UGlobals, + DB.UCollections, + DB.USnippetKind, + UContainers, + UIStringList, + USnippetIDs; type /// Enumeration providing information about the level to which a @@ -119,7 +126,8 @@ type TDisplayNameComparer = class(TComparer) fXRef: TSnippetList; // List of cross-referenced snippets fExtra: IActiveText; // Further information for snippet fCompatibility: TCompileResults; // Snippet's compiler compatibility - fUserDefined: Boolean; // If this snippet is user-defined +// fUserDefined: Boolean; // If this snippet is user-defined + fCollectionID: TCollectionID; // Snippet's collection ID fHiliteSource: Boolean; // If source is syntax highlighted fTestInfo: TSnippetTestInfo; // Level of testing of snippet function GetID: TSnippetID; @@ -130,6 +138,7 @@ type TDisplayNameComparer = class(TComparer) {Gets snippet's display name, or name if no display name is set @return Required display name. } + function __TMP__GetUserDefined: Boolean; strict protected procedure SetName(const Name: string); {Sets Name property. @@ -145,12 +154,24 @@ type TDisplayNameComparer = class(TComparer) } public constructor Create(const Name: string; const UserDefined: Boolean; - const Props: TSnippetData); + const Props: TSnippetData); overload; {TODO -cCollections: remove constructor} {Class contructor. Sets up snippet object with given property values. @param Name [in] Name of snippet. @param UserDefined [in] Indicates if this is a user defined snippet. @param Props [in] Values of various snippet properties. } + + /// Object constructor. Sets up snippet object with given property + /// values belonging to a specified collection. + /// string [in] Name of snippet. + /// TCollectionID [in] ID of collection + /// to which the snippet belongs. ID must not be null. + /// TSnippetData [in] Values of snippet + /// properties. + constructor Create(const Name: string; const ACollectionID: TCollectionID; + const Props: TSnippetData); + overload; {TODO -cCollections: remove overload;} + destructor Destroy; override; {Destructor. Tears down object. } @@ -192,8 +213,11 @@ type TDisplayNameComparer = class(TComparer) {List of any other snippet in database on which this snippet depends} property XRef: TSnippetList read fXRef; {List of cross referenced snippets in database} - property UserDefined: Boolean read fUserDefined; +// property UserDefined: Boolean read fUserDefined;; + property UserDefined: Boolean read __TMP__GetUserDefined; + {TODO -cCollections: Remove above property & getter/setter} {Flag that indicates if this is a user defined snippet} + property CollectionID: TCollectionID read fCollectionID; end; { @@ -249,16 +273,29 @@ TSnippetList = class(TObject) @param Idx [in] Index of required snippet in list. @return Snippet at specified index in list. } - function Find(const SnippetName: string; - const UserDefined: Boolean; out Index: Integer): Boolean; overload; - {Finds a snippet in the list that has a specified name and user defined - property. Uses a binary search. - @param SnippetName [in] Name of snippet to be found. - @param UserDefined [in] Whether required snippet is user defined or not. - @param Index [out] Index of required snippet in list. Valid only if - method returns True. - @return True if snippet found, False if not. - } +// function Find(const SnippetName: string; +// const UserDefined: Boolean; out Index: Integer): Boolean; overload; +// {Finds a snippet in the list that has a specified name and user defined +// property. Uses a binary search. +// @param SnippetName [in] Name of snippet to be found. +// @param UserDefined [in] Whether required snippet is user defined or not. +// @param Index [out] Index of required snippet in list. Valid only if +// method returns True. +// @return True if snippet found, False if not. +// } + + /// Finds a snippet in the list with whose name and collection ID + /// match. + /// string [in] Name of snippet. + /// TCollectionID [in] ID of collection + /// to which the snippet belongs. + /// Integer. [out] Set to the index of the + /// required snippet in the list. Valid only if the snippet was found. + /// + /// Boolean. True if snippet found, False if not. + function Find(const SnippetName: string; const ACollectionID: TCollectionID; + out Index: Integer): Boolean; overload; + strict protected var fList: TSortedObjectList; // Sorted list of snippets public @@ -299,6 +336,17 @@ TSnippetList = class(TObject) user defined snippet or one from main database. @return Reference to required snippet or nil if not found. } + + /// Finds a snippet in the list with whose name and collection ID + /// match. + /// string [in] Name of snippet. + /// TCollectionID [in] ID of collection + /// to which the snippet belongs. + /// TSnippet. Reference to the required snippet or nil if + /// not found. + function Find(const SnippetName: string; + const ACollectionID: TCollectionID): TSnippet; overload; + function Contains(const Snippet: TSnippet): Boolean; {Checks whether list contains a specified snippet. @param Snippet [in] Required snippet. @@ -324,6 +372,14 @@ TSnippetList = class(TObject) (True) or in main database (False). @return Number of snippets in specified database. } + + /// Counts number of snippets in list that belong to a specified + /// collection. + /// TCollectionID [in] Required + /// collection. + /// Integer Number of snippets in the collection. + function Count(const ACollectionID: TCollectionID): Integer; overload; + function Count: Integer; overload; {Counts number of snippets in list. @return Number of snippets in list. @@ -332,13 +388,22 @@ TSnippetList = class(TObject) {Checks if list is empty. @return True if list is empty, False otehrwise. } - function IsEmpty(const UserDefined: Boolean): Boolean; overload; inline; + function IsEmpty(const UserDefined: Boolean): Boolean; overload; {__TMP__ inline;} {Checks if sub-set of list from either from or not from use defined database is empty. @param UserDefined [in] Flags whether to check for snippets in user database (True) or in main database (False). @return True if required subset is empty, False if not empty. } + + /// Checks if the sub-set of snippets in the list belonging to a + /// specified collection is empty. + /// TCollectionID [in] ID of collection. + /// + /// Boolean True if the subset is empty, False otherwise. + /// + function IsEmpty(const ACollectionID: TCollectionID): Boolean; overload; + property Items[Idx: Integer]: TSnippet read GetItem; default; {List of snippets} end; @@ -401,9 +466,17 @@ constructor TSnippet.Create(const Name: string; const UserDefined: Boolean; @param UserDefined [in] Indicates if this is a user defined snippet. @param Props [in] Values of various snippet properties. } +begin + Create(Name, TCollectionID.__TMP__DBCollectionID(UserDefined), Props); +end; + +constructor TSnippet.Create(const Name: string; + const ACollectionID: TCollectionID; const Props: TSnippetData); begin Assert(ClassType <> TSnippet, ClassName + '.Create: must only be called from descendants.'); + Assert(not ACollectionID.IsNull, + ClassName + '.Create: ACollectionID is null'); inherited Create; // Record simple property values SetName(Name); @@ -413,8 +486,8 @@ constructor TSnippet.Create(const Name: string; const UserDefined: Boolean; // Create snippets lists for Depends and XRef properties fDepends := TSnippetListEx.Create; fXRef := TSnippetListEx.Create; - // The following properties added to support user defined snippets - fUserDefined := UserDefined; + // The following property added to support multiple snippet collections + fCollectionID := ACollectionID.Clone; end; destructor TSnippet.Destroy; @@ -447,7 +520,7 @@ function TSnippet.GetID: TSnippetID; @return Required ID. } begin - Result := TSnippetID.Create(fName, fUserDefined); + Result := TSnippetID.Create(fName, fCollectionID); end; function TSnippet.IsEqual(const Snippet: TSnippet): Boolean; @@ -484,6 +557,11 @@ procedure TSnippet.SetProps(const Data: TSnippetData); fTestInfo := Data.TestInfo; end; +function TSnippet.__TMP__GetUserDefined: Boolean; +begin + Result := fCollectionID = TCollectionID.__TMP__UserDBCollectionID; +end; + { TSnippet.TDisplayNameComparer } function TSnippet.TDisplayNameComparer.Compare(const Left, @@ -651,12 +729,23 @@ function TSnippetList.Count(const UserDefined: Boolean): Integer; (True) or in main database (False). @return Number of snippets in specified database. } +//var +// Snippet: TSnippet; // refers to all snippets in list +begin + Result := Count(TCollectionID.__TMP__DBCollectionID(UserDefined)); +// Result := 0; +// for Snippet in Self do +// if Snippet.UserDefined = UserDefined then +// Inc(Result); +end; + +function TSnippetList.Count(const ACollectionID: TCollectionID): Integer; var Snippet: TSnippet; // refers to all snippets in list begin Result := 0; for Snippet in Self do - if Snippet.UserDefined = UserDefined then + if Snippet.CollectionID = ACollectionID then Inc(Result); end; @@ -695,24 +784,41 @@ destructor TSnippetList.Destroy; inherited; end; +//function TSnippetList.Find(const SnippetName: string; +// const UserDefined: Boolean; out Index: Integer): Boolean; +// {Finds a snippet in the list that has a specified name and user defined +// property. Uses a binary search. +// @param SnippetName [in] Name of snippet to be found. +// @param UserDefined [in] Whether required snippet is user defined or not. +// @param Index [out] Index of required snippet in list. Valid only if +// method returns True. +// @return True if snippet found, False if not. +// } +//var +// TempSnippet: TSnippet; // temp snippet used to perform search +// NulData: TSnippetData; // nul data used to create snippet +//begin +// // We need a temporary snippet object in order to perform binary search using +// // object list's built in search +// NulData.Init; +// TempSnippet := TTempSnippet.Create(SnippetName, UserDefined, NulData); +// try +// Result := fList.Find(TempSnippet, Index); +// finally +// TempSnippet.Free; +// end; +//end; + function TSnippetList.Find(const SnippetName: string; - const UserDefined: Boolean; out Index: Integer): Boolean; - {Finds a snippet in the list that has a specified name and user defined - property. Uses a binary search. - @param SnippetName [in] Name of snippet to be found. - @param UserDefined [in] Whether required snippet is user defined or not. - @param Index [out] Index of required snippet in list. Valid only if - method returns True. - @return True if snippet found, False if not. - } + const ACollectionID: TCollectionID; out Index: Integer): Boolean; var TempSnippet: TSnippet; // temp snippet used to perform search - NulData: TSnippetData; // nul data used to create snippet + NullData: TSnippetData; // nul data used to create snippet begin // We need a temporary snippet object in order to perform binary search using // object list's built in search - NulData.Init; - TempSnippet := TTempSnippet.Create(SnippetName, UserDefined, NulData); + NullData.Init; + TempSnippet := TTempSnippet.Create(SnippetName, ACollectionID, NullData); try Result := fList.Find(TempSnippet, Index); finally @@ -731,7 +837,19 @@ function TSnippetList.Find(const SnippetName: string; var Idx: Integer; // index of snippet name in list begin - if Find(SnippetName, UserDefined, Idx) then + if Find(SnippetName, TCollectionID.__TMP__DBCollectionID(UserDefined), Idx) then +// if Find(SnippetName, UserDefined, Idx) then + Result := Items[Idx] + else + Result := nil; +end; + +function TSnippetList.Find(const SnippetName: string; + const ACollectionID: TCollectionID): TSnippet; +var + Idx: Integer; // index of snippet name in list +begin + if Find(SnippetName, ACollectionID, Idx) then Result := Items[Idx] else Result := nil; @@ -743,7 +861,8 @@ function TSnippetList.Find(const SnippetID: TSnippetID): TSnippet; @return Reference to required snippet or nil if not found. } begin - Result := Find(SnippetID.Name, SnippetID.UserDefined); +// Result := Find(SnippetID.Name, SnippetID.UserDefined); + Result := Find(SnippetID.Name, SnippetID.CollectionID); end; function TSnippetList.GetEnumerator: TEnumerator; @@ -773,7 +892,13 @@ function TSnippetList.IsEmpty: Boolean; function TSnippetList.IsEmpty(const UserDefined: Boolean): Boolean; begin - Result := Count(UserDefined) = 0; +// Result := Count(UserDefined) = 0; + Result := Count(TCollectionID.__TMP__DBCollectionID(UserDefined)) = 0; +end; + +function TSnippetList.IsEmpty(const ACollectionID: TCollectionID): Boolean; +begin + Result := Count(ACollectionID) = 0; end; function TSnippetList.IsEqual(const AList: TSnippetList): Boolean; From 2f8b4eb0fe7121a3a550b61984c8a98a566f730b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 30 Oct 2024 13:12:21 +0000 Subject: [PATCH 012/222] Update external object's DisplaySnippet method Updated definition of the external object's DisplaySnippet method in ExternalObj.ridl, by replacing Boolean UserDefined parameter with a WideString CollectionIDAsHex parameter. This parameter takes a hex string representation of the named snippet's collection ID. Bumped external object version to 15, and renamed interface to IWBExternal15. Made changes to affected code as follows: Updated TWBExternal re the changes in IWBExternal15. Added overloaded DisplaySnippet method to INotifier and its implementation in TNotifier. The new overload takes a TCollectionID parameter which the revised TWBExternal.DisplaySnippet method calls after converting its Hex string collection ID parameter back into a TCollectionID. The old version of INotifier.DisplaySnippet, that takes a Boolean UserDefined parameter was left in place. The displaySnippet JavaScript function in external.js was modified to take a hex string representation of a collection ID instead of a user-defined boolean parameter. It passes along the new parameter to the revised IWBExternal.DisplaySnippet method. USnippetHTML was changed to pass the expected collection id hex string to the JavaScript displaySnippet() function. All old code was commented out. --- Src/ExternalObj.ridl | 27 +++++++++++----- Src/IntfNotifier.pas | 13 +++++++- Src/Res/Scripts/external.js | 16 +++++++++- Src/UNotifier.pas | 29 +++++++++++++++-- Src/USnippetHTML.pas | 2 +- Src/UWBExternal.pas | 64 ++++++++++++++++++++++++++----------- 6 files changed, 120 insertions(+), 31 deletions(-) diff --git a/Src/ExternalObj.ridl b/Src/ExternalObj.ridl index fcf28f613..76c8ae4f6 100644 --- a/Src/ExternalObj.ridl +++ b/Src/ExternalObj.ridl @@ -3,7 +3,7 @@ * v. 2.0. If a copy of the MPL was not distributed with this file, You can * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2006-2021, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2006-2024, Peter Johnson (gravatar.com/delphidabbler). * * Source for type library that defines the interface to extensions to the * browser control DOM's "external object". @@ -12,7 +12,7 @@ [ uuid(DA95AEFB-3FB5-4A9E-9F9D-A53DD05CA7D4), - version(14.0), + version(15.0), helpstring("CodeSnip DOM External Object Extender Type Library"), custom(DE77BA64-517C-11D1-A2DA-0000F8773CE9, 117441012), custom(DE77BA63-517C-11D1-A2DA-0000F8773CE9, 1219706147) @@ -24,19 +24,19 @@ library ExternalObj importlib("stdole2.tlb"); /* - * V14 interface of extension to browser DOM's "external" object. + * V15 interface of extension to browser DOM's "external" object. */ - interface IWBExternal14; + interface IWBExternal15; [ uuid(BA971829-ED4D-4092-BCAE-4B5DB1A2D74A), - version(14.0), + version(15.0), helpstring("DOM external object extender"), dual, oleautomation ] - interface IWBExternal14: IDispatch + interface IWBExternal15: IDispatch { /* * Update database from internet. @@ -44,14 +44,25 @@ library ExternalObj [id(0x00000065)] HRESULT _stdcall UpdateDbase(void); - /* + /* - TODO: Delete following commented out method * Display named snippet. * @param SnippetName [in] Name of snippet to display. * @param UserDefined [in] Whether snippet is user defined. - */ + * [id(0x00000066)] HRESULT _stdcall DisplaySnippet([in] BSTR SnippetName, [in] VARIANT_BOOL UserDefined, [in] VARIANT_BOOL NewTab); + */ + + /* + * Display named snippet. + * @param SnippetName [in] Name of snippet to display. + * @param CollectionIDAsHex [in] Hex representation of snippet's + * collection ID. + */ + [id(0x00000080)] + HRESULT _stdcall DisplaySnippet([in] BSTR SnippetName, + [in] BSTR CollectionIDAsHex, [in] VARIANT_BOOL NewTab); /* * Displays configure compilers dialog box. diff --git a/Src/IntfNotifier.pas b/Src/IntfNotifier.pas index cb0e460c9..1c15d9b03 100644 --- a/Src/IntfNotifier.pas +++ b/Src/IntfNotifier.pas @@ -20,6 +20,7 @@ interface // Delphi Classes, ActiveX, Windows, // Project + DB.UCollections, UView; @@ -40,7 +41,17 @@ interface /// WordBool [in] Whether to display snippet in a new /// detail pane tab. procedure DisplaySnippet(const SnippetName: WideString; - UserDefined: WordBool; NewTab: WordBool); + UserDefined: WordBool; NewTab: WordBool); overload; + + /// Displays a snippet. + /// WideString [in] Name of required snippet. + /// + /// TCollectionID [in] ID of the snippet's + /// collection. + /// WordBool [in] Whether to display snippet in a new + /// detail pane tab. + procedure DisplaySnippet(const SnippetName: WideString; + ACollectionID: TCollectionID; NewTab: WordBool); overload; /// Displays a category. /// WideString [in] ID of required category. diff --git a/Src/Res/Scripts/external.js b/Src/Res/Scripts/external.js index 0de9f998d..ffaf18be5 100644 --- a/Src/Res/Scripts/external.js +++ b/Src/Res/Scripts/external.js @@ -36,12 +36,26 @@ function updateDbase() { * @param string snippet [in] Name of snippet to be displayed. * @param boolean userdefined [in] Whether snippet is user defined. * @return False. - */ + * function displaySnippet(snippet, userdefined) { var e = window.event; external.DisplaySnippet(snippet, userdefined, e.ctrlKey); return false; } +*/ + +/* + * Calls external object to get host application to display a named snippet. + * @param string snippet [in] Name of snippet to be displayed. + * @param boolean collectionId [in] Hex string representation of collection + * to which the snippet belongs. + * @return False. + */ +function displaySnippet(snippet, collectionId) { + var e = window.event; + external.DisplaySnippet(snippet, collectionId, e.ctrlKey); + return false; +} /* * Calls external object to get host application to display a category. diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index fe3871df4..81db10187 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -19,7 +19,9 @@ interface // Delphi Classes, ActiveX, // Project - IntfNotifier, UView; + DB.UCollections, + IntfNotifier, + UView; type @@ -80,7 +82,17 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) /// detail pane tab. /// Methods of INotifier. procedure DisplaySnippet(const SnippetName: WideString; - UserDefined: WordBool; NewTab: WordBool); + UserDefined: WordBool; NewTab: WordBool); overload; + + /// Displays a snippet. + /// WideString [in] Name of required snippet. + /// + /// TCollectionID [in] ID of the snippet's + /// collection. + /// WordBool [in] Whether to display snippet in a new + /// detail pane tab. + procedure DisplaySnippet(const SnippetName: WideString; + ACollectionID: TCollectionID; NewTab: WordBool); overload; /// Displays a category. /// WideString [in] ID of required category. @@ -253,6 +265,19 @@ procedure TNotifier.DisplayCategory(const CatID: WideString; NewTab: WordBool); end; end; +procedure TNotifier.DisplaySnippet(const SnippetName: WideString; + ACollectionID: TCollectionID; NewTab: WordBool); +begin + if Assigned(fDisplaySnippetAction) then + begin + (fDisplaySnippetAction as TSnippetAction).SnippetName := SnippetName; + (fDisplaySnippetAction as TSnippetAction).UserDefined := + ACollectionID <> TCollectionID.__TMP__MainDBCollectionID; + (fDisplaySnippetAction as TSnippetAction).NewTab := NewTab; + fDisplaySnippetAction.Execute; + end; +end; + procedure TNotifier.DisplaySnippet(const SnippetName: WideString; UserDefined: WordBool; NewTab: WordBool); begin diff --git a/Src/USnippetHTML.pas b/Src/USnippetHTML.pas index a853e74f6..caaca05a7 100644 --- a/Src/USnippetHTML.pas +++ b/Src/USnippetHTML.pas @@ -207,7 +207,7 @@ class function TSnippetHTML.SnippetALink(const Snippet: TSnippet): string; // Create javascript link enclosing snippet name Result := JSALink( TJavaScript.LiteralFunc( - 'displaySnippet', [Snippet.Name, Snippet.UserDefined] + 'displaySnippet', [Snippet.Name, Snippet.CollectionID.ToHexString] ), 'snippet-link', Snippet.DisplayName diff --git a/Src/UWBExternal.pas b/Src/UWBExternal.pas index 46c5fb12d..e219ecb10 100644 --- a/Src/UWBExternal.pas +++ b/Src/UWBExternal.pas @@ -26,7 +26,7 @@ interface type - /// COM object that implements the methods of the IWBExternal14 + /// COM object that implements the methods of the IWBExternal15 /// interface that extend the browser control's 'external' object. /// /// This class enables application code to be called from JavaScript @@ -34,7 +34,7 @@ interface /// The methods a declared in the type library that is defined in /// External.idl. /// - TWBExternal = class(TAutoIntfObject, IWBExternal14, ISetNotifier) + TWBExternal = class(TAutoIntfObject, IWBExternal15, ISetNotifier) strict private var /// Object used to call application code in response to @@ -54,22 +54,34 @@ TWBExternal = class(TAutoIntfObject, IWBExternal14, ISetNotifier) constructor Create; /// Updates database from internet. - /// Method of IWBExternal14. + /// Method of IWBExternal15. procedure UpdateDbase; safecall; +// /// Displays a named snippet. +// /// WideString [in] Name of snippet to be +// /// displayed. +// /// WordBool [in] Whether the snippet is user +// /// defined. +// /// WordBool [in] Whether to display snippet in a new +// /// tab. +// /// Method of IWBExternal14. +// procedure DisplaySnippet(const SnippetName: WideString; +// UserDefined: WordBool; NewTab: WordBool); safecall; + + /// Displays the Configure Compilers dialogue box. /// Displays a named snippet. /// WideString [in] Name of snippet to be /// displayed. - /// WordBool [in] Whether the snippet is user - /// defined. + /// WideString [in] Hex string + /// representation of the ID of the collection to which the snippet + /// belongs. /// WordBool [in] Whether to display snippet in a new /// tab. - /// Method of IWBExternal14. + /// Method of IWBExternal15. procedure DisplaySnippet(const SnippetName: WideString; - UserDefined: WordBool; NewTab: WordBool); safecall; + const CollectionIDAsHex: WideString; NewTab: WordBool); safecall; - /// Displays the Configure Compilers dialogue box. - /// Method of IWBExternal14. + /// Method of IWBExternal15. procedure ConfigCompilers; safecall; /// Edits a named snippet. @@ -77,7 +89,7 @@ TWBExternal = class(TAutoIntfObject, IWBExternal14, ISetNotifier) /// /// /// The named snippet must be user defined. - /// Method of IWBExternal14. + /// Method of IWBExternal15. /// procedure EditSnippet(const SnippetName: WideString); safecall; @@ -86,20 +98,20 @@ TWBExternal = class(TAutoIntfObject, IWBExternal14, ISetNotifier) /// /// WordBool [in] Whether to display category in a new /// tab. - /// Method of IWBExternal14. + /// Method of IWBExternal15. procedure DisplayCategory(const CatID: WideString; NewTab: WordBool); safecall; /// Opens Snippet Editor ready to create a new snippet. - /// Method of IWBExternal14. + /// Method of IWBExternal15. procedure NewSnippet; safecall; /// Shows latest news items from CodeSnip news feed. - /// Method of IWBExternal14. + /// Method of IWBExternal15. procedure ShowNews; safecall; /// Displays the program's About Box. - /// Method of IWBExternal14. + /// Method of IWBExternal15. procedure ShowAboutBox; safecall; /// Records the notifier object that is used to call application @@ -118,6 +130,7 @@ implementation // Delphi Forms, // Project + DB.UCollections, UAppInfo; @@ -142,7 +155,7 @@ constructor TWBExternal.Create; ExeName := TAppInfo.AppExeFilePath; OleCheck(LoadTypeLib(PWideChar(ExeName), TypeLib)); // Create the object using type library - inherited Create(TypeLib, IWBExternal14); + inherited Create(TypeLib, IWBExternal15); end; procedure TWBExternal.DisplayCategory(const CatID: WideString; @@ -156,17 +169,32 @@ procedure TWBExternal.DisplayCategory(const CatID: WideString; end; end; -procedure TWBExternal.DisplaySnippet(const SnippetName: WideString; - UserDefined: WordBool; NewTab: WordBool); +procedure TWBExternal.DisplaySnippet(const SnippetName, + CollectionIDAsHex: WideString; NewTab: WordBool); begin try if Assigned(fNotifier) then - fNotifier.DisplaySnippet(SnippetName, UserDefined, NewTab); + fNotifier.DisplaySnippet( + SnippetName, + TCollectionID.CreateFromHexString(CollectionIDAsHex), + NewTab + ); except HandleException; end; end; +//procedure TWBExternal.DisplaySnippet(const SnippetName: WideString; +// UserDefined: WordBool; NewTab: WordBool); +//begin +// try +// if Assigned(fNotifier) then +// fNotifier.DisplaySnippet(SnippetName, UserDefined, NewTab); +// except +// HandleException; +// end; +//end; + procedure TWBExternal.EditSnippet(const SnippetName: WideString); begin try From 0aa28e71d15d97a78c16f907ef4326ad7d471fcb Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 30 Oct 2024 14:44:13 +0000 Subject: [PATCH 013/222] Remove TSnippetID.UserDefined & related constructor Removed TSnippetID.UserDefined property and constructor that took a Boolean UserDefined parameter. Modified affected units to use TSnippetID.CollectionID instead of TSnippetID.UserDefined and to use the TSnippetID constructor that takes a TCollectionID parameter instead of the constructor that took a Boolean UserDefined parameter. All affected units required __TMP__ code to acheive this. Commented out replaced code. --- Src/Favourites.UPersist.pas | 19 +++++++++++++++---- Src/FmFavouritesDlg.pas | 13 +++++++++---- Src/FmSnippetsEditorDlg.pas | 7 +++++-- Src/UCodeImportExport.pas | 11 ++++++++--- Src/UCodeImportMgr.pas | 23 ++++++++++++++++++----- Src/USnippetIDListIOHandler.pas | 11 ++++++++--- Src/USnippetIDs.pas | 19 +++++-------------- 7 files changed, 68 insertions(+), 35 deletions(-) diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index 9f73ab49d..d1aa43a0e 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -52,9 +52,18 @@ implementation uses // Delphi - SysUtils, IOUtils, Classes, + SysUtils, + IOUtils, + Classes, /// Project - DB.UMain, UAppInfo, UConsts, UIOUtils, UIStringList, USnippetIDs, UStrUtils; + DB.UCollections, + DB.UMain, + UAppInfo, + UConsts, + UIOUtils, + UIStringList, + USnippetIDs, + UStrUtils; { TFavouritesPersist } @@ -109,7 +118,8 @@ class procedure TFavouritesPersist.Load(Favourites: TFavourites); raise EFavouritesPersist.Create(sBadFormat); // only add to favourites if snippet in database if Database.Snippets.Find(SnippetName, UserDef) <> nil then - Favourites.Add(TSnippetID.Create(SnippetName, UserDef), LastAccess); +// Favourites.Add(TSnippetID.Create(SnippetName, UserDef), LastAccess); + Favourites.Add(TSnippetID.Create(SnippetName, TCollectionID.__TMP__DBCollectionID(UserDef)), LastAccess); end; end; @@ -125,7 +135,8 @@ class procedure TFavouritesPersist.Save(Favourites: TFavourites); begin SB.Append(Fav.SnippetID.Name); SB.Append(TAB); - SB.Append(BoolToStr(Fav.SnippetID.UserDefined, True)); +// SB.Append(BoolToStr(Fav.SnippetID.UserDefined, True)); + SB.Append(BoolToStr(Fav.SnippetID.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, True)); SB.Append(TAB); SB.Append(DateTimeToStr(Fav.LastAccessed)); SB.AppendLine; diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index 7213d1852..0ee1c1364 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -273,6 +273,7 @@ implementation // Delphi SysUtils, DateUtils, Windows, Graphics, // Project + DB.UCollections, DB.UMain, DB.USnippet, UCtrlArranger, UMessageBox, UPreferences, USettings, UStructs, UStrUtils; @@ -344,7 +345,8 @@ procedure TFavouritesDlg.actDisplayExecute(Sender: TObject); SelectedSnippet := LI.Favourite.SnippetID; fNotifier.DisplaySnippet( SelectedSnippet.Name, - SelectedSnippet.UserDefined, +// SelectedSnippet.UserDefined, + SelectedSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, chkNewTab.Checked ); fFavourites.Touch(SelectedSnippet); @@ -579,10 +581,13 @@ class function TFavouritesDlg.IsDisplayed: Boolean; procedure TFavouritesDlg.LVCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); var - UserDefined: Boolean; +// UserDefined: Boolean; + IsMainDB: Boolean; begin - UserDefined := (Item as TFavouriteListItem).Favourite.SnippetID.UserDefined; - fLVFavs.Canvas.Font.Color := Preferences.DBHeadingColours[UserDefined]; +// UserDefined := (Item as TFavouriteListItem).Favourite.SnippetID.UserDefined; +// fLVFavs.Canvas.Font.Color := Preferences.DBHeadingColours[UserDefined]; + IsMainDB := (Item as TFavouriteListItem).Favourite.SnippetID.CollectionID = TCollectionID.__TMP__MainDBCollectionID; + fLVFavs.Canvas.Font.Color := Preferences.DBHeadingColours[not IsMainDB]; end; procedure TFavouritesDlg.LVCustomDrawSubItem(Sender: TCustomListView; diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 45e9bc7d7..0e642a4a9 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -254,6 +254,7 @@ implementation // Delphi Windows {for inlining}, Graphics, // Project + DB.UCollections, DB.UMain, DB.USnippetKind, FmDependenciesDlg, IntfCommon, UColours, UConsts, UCSSUtils, UCtrlArranger, UExceptions, UFontHelper, UIStringList, UReservedCategories, USnippetExtraHelper, USnippetValidator, UMessageBox, @@ -424,7 +425,8 @@ procedure TSnippetsEditorDlg.actViewDependenciesExecute(Sender: TObject); fDependsCLBMgr.GetCheckedSnippets(DependsList); TDependenciesDlg.Execute( Self, - TSnippetID.Create(StrTrim(edName.Text), True), +// TSnippetID.Create(StrTrim(edName.Text), True), + TSnippetID.Create(StrTrim(edName.Text), TCollectionID.__TMP__UserDBCollectionID), StrTrim(edDisplayName.Text), DependsList, [tiDependsUpon], @@ -978,7 +980,8 @@ procedure TSnippetsEditorDlg.UpdateReferences; fDependsCLBMgr.Clear; fXRefsCLBMgr.Save; fXRefsCLBMgr.Clear; - EditSnippetID := TSnippetID.Create(fOrigName, True); +// EditSnippetID := TSnippetID.Create(fOrigName, True); + EditSnippetID := TSnippetID.Create(fOrigName, TCollectionID.__TMP__UserDBCollectionID); EditSnippetKind := fSnipKindList.SnippetKind(cbKind.ItemIndex); for Snippet in Database.Snippets do begin diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index e43346daa..580bae8b8 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -165,6 +165,7 @@ implementation XMLDom, // Project ActiveText.UMain, + DB.UCollections, DB.UMain, DB.USnippetKind, UAppInfo, @@ -370,9 +371,13 @@ procedure TCodeImporter.Execute(const Data: TBytes); TXMLDocHelper.GetPascalNameList(fXMLDoc, DependsNode, SnippetNames); Depends.Clear; for SnippetName in SnippetNames do - // Note: in building snippet ID list we assume each snippet is user- - // defined. It may not be, but there is no way of telling from XML. - Depends.Add(TSnippetID.Create(SnippetName, True)); +// // Note: in building snippet ID list we assume each snippet is user- +// // defined. It may not be, but there is no way of telling from XML. +// Depends.Add(TSnippetID.Create(SnippetName, True)); + // Note: in building snippet ID list we assume each snippet is from the + // standard user collection. It may not be, but there is no way of telling + // from XML. + Depends.Add(TSnippetID.Create(SnippetName, TCollectionID.__TMP__UserDBCollectionID)); end; // Reads description node and converts to active text. diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index ba328ea9e..7f21d1fee 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -148,9 +148,16 @@ implementation uses // Delphi - SysUtils, Classes, + SysUtils, + Classes, // Project - ActiveText.UMain, DB.UMain, DB.USnippet, UIOUtils, USnippetIDs, UStrUtils; + ActiveText.UMain, + DB.UCollections, + DB.UMain, + DB.USnippet, + UIOUtils, + USnippetIDs, + UStrUtils; { TCodeImportMgr } @@ -178,7 +185,8 @@ function TCodeImportMgr.DisallowedNames(const ExcludedName: string): Result := TIStringList.Create; Result.CaseSensitive := False; for Snippet in Database.Snippets do - if Snippet.UserDefined then +// if Snippet.UserDefined then + if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then Result.Add(Snippet.Name); for SnippetInfo in fSnippetInfoList do if not StrSameText(SnippetInfo.Name, ExcludedName) then @@ -241,6 +249,7 @@ procedure TCodeImportMgr.UpdateDatabase; var Idx: Integer; // loops through dependencies SnippetID: TSnippetID; // each snippet ID in dependency list + CollectionID: TCollectionID; begin // NOTE: The data file format does not record which database a required // snippet belongs to, so we first look in the user database and if it's @@ -248,8 +257,12 @@ procedure TCodeImportMgr.UpdateDatabase; for Idx := 0 to Pred(Depends.Count) do begin SnippetID := Depends[Idx]; - SnippetID.UserDefined := - Database.Snippets.Find(SnippetID.Name, True) <> nil; +// SnippetID.UserDefined := +// Database.Snippets.Find(SnippetID.Name, True) <> nil; + CollectionID := TCollectionID.__TMP__UserDBCollectionID; + if Database.Snippets.Find(SnippetID.Name, CollectionID) = nil then + CollectionID := TCollectionID.__TMP__MainDBCollectionID; + SnippetID.CollectionID := CollectionID; Depends[Idx] := SnippetID; end; end; diff --git a/Src/USnippetIDListIOHandler.pas b/Src/USnippetIDListIOHandler.pas index 4aed2f246..ac994fa35 100644 --- a/Src/USnippetIDListIOHandler.pas +++ b/Src/USnippetIDListIOHandler.pas @@ -66,7 +66,10 @@ implementation // Delphi Classes, // Project - UConsts, UIOUtils, UStrUtils; + DB.UCollections, + UConsts, + UIOUtils, + UStrUtils; { TSnippetIDListFileReader } @@ -109,7 +112,8 @@ procedure TSnippetIDListFileReader.Parse; if not TryStrToInt(UserDefStr, UserDefInt) or not (UserDefInt in [0, 1]) then raise ESnippetIDListFileReader.CreateFmt(sBadUserDef, [Line]); - fSnippetIDs.Add(TSnippetID.Create(Name, Boolean(UserDefInt))); +// fSnippetIDs.Add(TSnippetID.Create(Name, Boolean(UserDefInt))); + fSnippetIDs.Add(TSnippetID.Create(Name, TCollectionID.__TMP__DBCollectionID(Boolean(UserDefInt)))); end; end; @@ -157,7 +161,8 @@ procedure TSnippetIDListFileWriter.CreateContent( fBuilder.Append(TAB); // NOTE: TStringBuilder.Append(Boolean) override not used here since ordinal // value wanted instead of "True" or "False" or localised equivalent. - fBuilder.Append(Ord(SnippetID.UserDefined)); +// fBuilder.Append(Ord(SnippetID.UserDefined)); + fBuilder.Append(Ord(SnippetID.CollectionID <> TCollectionID.__TMP__MainDBCollectionID)); fBuilder.AppendLine; end; end; diff --git a/Src/USnippetIDs.pas b/Src/USnippetIDs.pas index 892290a6f..620472dcb 100644 --- a/Src/USnippetIDs.pas +++ b/Src/USnippetIDs.pas @@ -38,8 +38,6 @@ TSnippetID = record // /// Value of UserDefined property. // fUserDefined: Boolean; fCollectionID: TCollectionID; -// function __TMP__GetUserDefined: Boolean; -// procedure __TMP__SetUserDefined(const Value: Boolean); procedure SetCollectionID(const AValue: TCollectionID); public /// Name of snippet. @@ -55,10 +53,13 @@ TSnippetID = record property CollectionID: TCollectionID read fCollectionID write SetCollectionID; +// /// Creates a record with given property values. +// constructor Create(const AName: string; const AUserDefined: Boolean); +// overload; {TODO -cCollections: remove constructor} + /// Creates a record with given property values. /// ACollectionID must not be null. constructor Create(const AName: string; const ACollectionID: TCollectionID); - overload; {TODO -cCollections: remove overload} /// Creates copy of given snippet ID constructor Clone(const Src: TSnippetID); @@ -200,7 +201,7 @@ constructor TSnippetID.Create(const AName: string; //constructor TSnippetID.Create(const AName: string; const AUserDefined: Boolean); //begin // fName := AName; -// __TMP__SetUserDefined(AUserDefined); +// fUserDefined := AUserDefined); //end; class operator TSnippetID.Equal(const SID1, SID2: TSnippetID): Boolean; @@ -219,16 +220,6 @@ procedure TSnippetID.SetCollectionID(const AValue: TCollectionID); fCollectionID := AValue.Clone; end; -//function TSnippetID.__TMP__GetUserDefined: Boolean; -//begin -// Result := fCollectionID = TCollectionID.__TMP__UserDBCollectionID; -//end; -// -//procedure TSnippetID.__TMP__SetUserDefined(const Value: Boolean); -//begin -// fCollectionID := TCollectionID.__TMP__DBCollectionID(Value); -//end; - { TSnippetIDList } function TSnippetIDList.Add(const SnippetID: TSnippetID): Integer; From 6a9d1d458a36e0ad5beec52e05dcf45ae3d17d3d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 30 Oct 2024 17:15:37 +0000 Subject: [PATCH 014/222] Remove TSnippetList.IsEmpty Boolean method overload Removed overload of TSnippetList.IsEmpty that took a Boolean UserDefined parameter. The only place this method was called was in FmMain. This code was changed to call the TCollectionID overload of TSnippetList.IsEmpty. Used __TMP__ methods to achieve this. Removed source code was commented out. --- Src/DB.USnippet.pas | 24 ++++++++++++------------ Src/FmMain.pas | 9 +++++++-- 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 8f9a6f8dc..9ff222da0 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -388,13 +388,13 @@ TSnippetList = class(TObject) {Checks if list is empty. @return True if list is empty, False otehrwise. } - function IsEmpty(const UserDefined: Boolean): Boolean; overload; {__TMP__ inline;} - {Checks if sub-set of list from either from or not from use defined - database is empty. - @param UserDefined [in] Flags whether to check for snippets in user - database (True) or in main database (False). - @return True if required subset is empty, False if not empty. - } +// function IsEmpty(const UserDefined: Boolean): Boolean; overload; {__TMP__ inline;} +// {Checks if sub-set of list from either from or not from use defined +// database is empty. +// @param UserDefined [in] Flags whether to check for snippets in user +// database (True) or in main database (False). +// @return True if required subset is empty, False if not empty. +// } /// Checks if the sub-set of snippets in the list belonging to a /// specified collection is empty. @@ -890,11 +890,11 @@ function TSnippetList.IsEmpty: Boolean; Result := Count = 0; end; -function TSnippetList.IsEmpty(const UserDefined: Boolean): Boolean; -begin -// Result := Count(UserDefined) = 0; - Result := Count(TCollectionID.__TMP__DBCollectionID(UserDefined)) = 0; -end; +//function TSnippetList.IsEmpty(const UserDefined: Boolean): Boolean; +//begin +//// Result := Count(UserDefined) = 0; +// Result := Count(TCollectionID.__TMP__DBCollectionID(UserDefined)) = 0; +//end; function TSnippetList.IsEmpty(const ACollectionID: TCollectionID): Boolean; begin diff --git a/Src/FmMain.pas b/Src/FmMain.pas index 725d241aa..91163c63b 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -585,7 +585,9 @@ implementation // Project ClassHelpers.UControls, ClassHelpers.UGraphics, - DB.UCategory, DB.UMain, DB.USnippet, FmSplash, FmTrappedBugReportDlg, + DB.UCategory, + DB.UCollections, + DB.UMain, DB.USnippet, FmSplash, FmTrappedBugReportDlg, FmWaitDlg, IntfFrameMgrs, UActionFactory, UAppInfo, UCodeShareMgr, UCommandBars, UConsts, UCopyInfoMgr, UCopySourceMgr, UDatabaseLoader, UDatabaseLoaderUI, UDetailTabAction, @@ -940,7 +942,10 @@ procedure TMainForm.ActNonEmptyDBUpdate(Sender: TObject); procedure TMainForm.ActNonEmptyUserDBUpdate(Sender: TObject); begin - (Sender as TAction).Enabled := not Database.Snippets.IsEmpty(True); +// (Sender as TAction).Enabled := not Database.Snippets.IsEmpty(True); + (Sender as TAction).Enabled := not Database.Snippets.IsEmpty( + TCollectionID.__TMP__UserDBCollectionID + ); end; procedure TMainForm.ActOverviewTabExecute(Sender: TObject); From 3b61f8c4b058f3e291086c20faf2d0f9d8b4c183 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 30 Oct 2024 17:42:45 +0000 Subject: [PATCH 015/222] Remove TSnippetList.Count Boolean overload method Removed overload of TSnippetList.Count that took a Boolean UserDefined parameter. Updated all affected code by changing to the TCollectionID overload of either TSnippetList.Count or TSnippetList.IsEmpty, as appropriate. Used __TMP__ methods to achieve this. Removed source code was commented out. --- Src/DB.USnippet.pas | 46 ++++++++++++++++++------------------ Src/FmAboutDlg.pas | 7 +++++- Src/FmSelectionSearchDlg.pas | 10 ++++++-- Src/FrSelectUserSnippets.pas | 9 ++++++- Src/UCodeShareMgr.pas | 12 ++++++++-- Src/UDetailPageHTML.pas | 33 +++++++++++++++++++++----- Src/UStatusBarMgr.pas | 14 ++++++++--- 7 files changed, 93 insertions(+), 38 deletions(-) diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 9ff222da0..e47226230 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -365,13 +365,13 @@ TSnippetList = class(TObject) {Gets an intialised snippet list enumerator. @return Required enumerator. } - function Count(const UserDefined: Boolean): Integer; overload; - {Counts number of snippets in list that are either from or not from user - defined database. - @param UserDefined [in] Flags whether to count snippets in user database - (True) or in main database (False). - @return Number of snippets in specified database. - } +// function Count(const UserDefined: Boolean): Integer; overload; +// {Counts number of snippets in list that are either from or not from user +// defined database. +// @param UserDefined [in] Flags whether to count snippets in user database +// (True) or in main database (False). +// @return Number of snippets in specified database. +// } /// Counts number of snippets in list that belong to a specified /// collection. @@ -722,22 +722,22 @@ function TSnippetList.ContainsKinds(const Kinds: TSnippetKinds): Boolean; end; end; -function TSnippetList.Count(const UserDefined: Boolean): Integer; - {Counts number of snippets in list that are either from or not from user - defined database. - @param UserDefined [in] Flags whether to count snippets in user database - (True) or in main database (False). - @return Number of snippets in specified database. - } -//var -// Snippet: TSnippet; // refers to all snippets in list -begin - Result := Count(TCollectionID.__TMP__DBCollectionID(UserDefined)); -// Result := 0; -// for Snippet in Self do -// if Snippet.UserDefined = UserDefined then -// Inc(Result); -end; +//function TSnippetList.Count(const UserDefined: Boolean): Integer; +// {Counts number of snippets in list that are either from or not from user +// defined database. +// @param UserDefined [in] Flags whether to count snippets in user database +// (True) or in main database (False). +// @return Number of snippets in specified database. +// } +////var +//// Snippet: TSnippet; // refers to all snippets in list +//begin +// Result := Count(TCollectionID.__TMP__DBCollectionID(UserDefined)); +//// Result := 0; +//// for Snippet in Self do +//// if Snippet.UserDefined = UserDefined then +//// Inc(Result); +//end; function TSnippetList.Count(const ACollectionID: TCollectionID): Integer; var diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index 6584a4ffd..22b0eb8a0 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -179,6 +179,7 @@ implementation ShellAPI, IOUtils, // Project + DB.UCollections, DB.UMain, FmEasterEgg, FmPreviewDlg, @@ -442,7 +443,11 @@ procedure TAboutDlg.InitHTMLFrames; begin // Resolve conditionally displayed block placeholders - IsDBAvalable := Database.Snippets.Count(False) > 0; +// IsDBAvalable := Database.Snippets.Count(False) > 0; + // check if DelphiDabbler Code Snippets Collection is in use + IsDBAvalable := not Database.Snippets.IsEmpty( + TCollectionID.__TMP__MainDBCollectionID + ); IsMetaDataAvailable := fMetaData.IsSupportedVersion and not fMetaData.IsCorrupt; IsLicenseInfoAvailable := IsMetaDataAvailable diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index a1dcf49bc..3aeaed97f 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -96,7 +96,10 @@ implementation // Delphi SysUtils, // Project - DB.UMain, UCtrlArranger, UQuery; + DB.UCollections, + DB.UMain, + UCtrlArranger, + UQuery; {$R *.dfm} @@ -225,7 +228,10 @@ procedure TSelectionSearchDlg.InitForm; begin inherited; frmSelect.CollapseTree; - btnUserDB.Enabled := Database.Snippets.Count(True) > 0; +// btnUserDB.Enabled := Database.Snippets.Count(True) > 0; + btnUserDB.Enabled := not Database.Snippets.IsEmpty( + TCollectionID.__TMP__UserDBCollectionID + ); end; procedure TSelectionSearchDlg.SelectDB(const UserDefined: Boolean); diff --git a/Src/FrSelectUserSnippets.pas b/Src/FrSelectUserSnippets.pas index 28c684c67..54177bbac 100644 --- a/Src/FrSelectUserSnippets.pas +++ b/Src/FrSelectUserSnippets.pas @@ -51,6 +51,10 @@ TSelectUserSnippetsFrame = class(TSelectSnippetsBaseFrame) implementation +uses + DB.UCollections; + + {$R *.dfm} @@ -62,7 +66,10 @@ function TSelectUserSnippetsFrame.CanAddCatNode(const Cat: TCategory): Boolean; @return True if category contains any user-defined snippets. } begin - Result := Cat.Snippets.Count(True) > 0; +// Result := Cat.Snippets.Count(True) > 0; + Result := not Cat.Snippets.IsEmpty( + TCollectionID.__TMP__UserDBCollectionID + ); end; function TSelectUserSnippetsFrame.CanAddSnippetNode( diff --git a/Src/UCodeShareMgr.pas b/Src/UCodeShareMgr.pas index 3f811b898..099cdf34d 100644 --- a/Src/UCodeShareMgr.pas +++ b/Src/UCodeShareMgr.pas @@ -62,7 +62,11 @@ implementation // Delphi SysUtils, // Project - DB.UMain, FmCodeExportDlg, FmCodeImportDlg, UCodeImportMgr; + DB.UCollections, + DB.UMain, + FmCodeExportDlg, + FmCodeImportDlg, + UCodeImportMgr; { TCodeShareMgr } @@ -73,7 +77,10 @@ class function TCodeShareMgr.CanShare: Boolean; @return True if user defined snippets exist in database. } begin - Result := Database.Snippets.Count(True) > 0; +// Result := Database.Snippets.Count(True) > 0; + Result := not Database.Snippets.IsEmpty( + TCollectionID.__TMP__UserDBCollectionID + ); end; class procedure TCodeShareMgr.ExportCode(ViewItem: IView); @@ -118,3 +125,4 @@ class procedure TCodeShareMgr.ImportCode; end. + diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 718aa7032..9b50c4680 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -66,10 +66,25 @@ implementation // Delphi SysUtils, Generics.Defaults, // Project - Compilers.UGlobals, Compilers.UCompilers, DB.UMain, DB.USnippet, UConsts, - UContainers, UCSSUtils, UEncodings, UHTMLTemplate, UHTMLUtils, - UJavaScriptUtils, UPreferences, UQuery, UResourceUtils, USnippetHTML, - USnippetPageHTML, UStrUtils, USystemInfo; + Compilers.UGlobals, + Compilers.UCompilers, + DB.UCollections, + DB.UMain, + DB.USnippet, + UConsts, + UContainers, + UCSSUtils, + UEncodings, + UHTMLTemplate, + UHTMLUtils, + UJavaScriptUtils, + UPreferences, + UQuery, + UResourceUtils, + USnippetHTML, + USnippetPageHTML, + UStrUtils, + USystemInfo; type @@ -418,7 +433,10 @@ procedure TWelcomePageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); 'externalScript', TJavaScript.LoadScript('external.js', etWindows1252) ); - UserDBCount := Database.Snippets.Count(True); +// UserDBCount := Database.Snippets.Count(True); + UserDBCount := Database.Snippets.Count( + TCollectionID.__TMP__UserDBCollectionID + ); Tplt.ResolvePlaceholderHTML( 'HaveUserDB', TCSS.BlockDisplayProp(UserDBCount > 0) ); @@ -429,7 +447,10 @@ procedure TWelcomePageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); 'UserDBCount', IntToStr(UserDBCount) ); - MainDBCount := Database.Snippets.Count(False); +// MainDBCount := Database.Snippets.Count(False); + MainDBCount := Database.Snippets.Count( + TCollectionID.__TMP__MainDBCollectionID + ); Tplt.ResolvePlaceholderHTML( 'HaveMainDB', TCSS.BlockDisplayProp(MainDBCount > 0) ); diff --git a/Src/UStatusBarMgr.pas b/Src/UStatusBarMgr.pas index dc501db74..3cf6aad69 100644 --- a/Src/UStatusBarMgr.pas +++ b/Src/UStatusBarMgr.pas @@ -118,9 +118,14 @@ implementation uses // Delphi - SysUtils, Forms, + SysUtils, + Forms, // Project - DB.UMain, UQuery, USearch, UStructs; + DB.UCollections, + DB.UMain, + UQuery, + USearch, + UStructs; { TStatusBarMgr } @@ -357,7 +362,10 @@ procedure TStatusBarMgr.ShowSnippetsInfo; begin // Calculate database stats TotalSnippets := Database.Snippets.Count; - TotalUserSnippets := Database.Snippets.Count(True); +// TotalUserSnippets := Database.Snippets.Count(True); + TotalUserSnippets := Database.Snippets.Count( + TCollectionID.__TMP__UserDBCollectionID + ); TotalMainSnippets := TotalSnippets - TotalUserSnippets; // Build display text and display it fStatusBar.Panels[cDBPanel].Text := Format( From cddfe2b6156decf083c68195f29ab84668f04562 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 30 Oct 2024 21:42:01 +0000 Subject: [PATCH 016/222] Add collection IDs to TDatabaseLoader classes Add TDatabaseLoader.CollectionID abstract method with implementation in base classes. Changed as much code as possible to use CollectionID instead of IsUserDatabase. Pulled some former abstract methods from descendant classes into base class. Required some __TMP__ methods to implement these changes. Removed code was commented out. --- Src/DB.UDatabaseIO.pas | 153 ++++++++++++++++++++++++++--------------- 1 file changed, 97 insertions(+), 56 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 4fe633fbb..f93fba6b8 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -101,6 +101,7 @@ implementation // Delphi SysUtils, // Project + DB.UCollections, DBIO.UFileIOIntf, DBIO.UIniDataReader, DBIO.UNulDataReader, DBIO.UXMLDataIO, UAppInfo, UConsts, UIStringList, UReservedCategories, USnippetIDs; @@ -153,15 +154,20 @@ TDatabaseLoader = class(TInterfacedObject, IDatabaseLoader) found. } function IsNativeSnippet(const Snippet: TSnippet): Boolean; - virtual; abstract; + virtual; {Checks if a snippet is native (belongs) to the database being read. @param Snippet [in] Snippet to test. @return True if snippet is native, False if not. } - function IsUserDatabase: Boolean; virtual; abstract; + function IsUserDatabase: Boolean; virtual; {Checks if the database is the user database. @return True if the database is the user database, False if not. } + + /// Returns the ID of the collection being loaded into the + /// database. + function CollectionID: TCollectionID; virtual; abstract; + function ErrorMessageHeading: string; virtual; abstract; {Returns heading to use in error messages. Should identify the database. @return Required heading. @@ -211,15 +217,20 @@ TMainDatabaseLoader = class(TDatabaseLoader, IDatabaseLoader) @return Reference to required snippet object or nil if snippet is not found. } - function IsNativeSnippet(const Snippet: TSnippet): Boolean; override; - {Checks if a snippet is native (belongs) to the main database. - @param Snippet [in] Snippet to test. - @return True if snippet is native, False if not. - } - function IsUserDatabase: Boolean; override; - {Checks if the database is the user database. - @return False - this is not the user database. - } +// function IsNativeSnippet(const Snippet: TSnippet): Boolean; override; +// {Checks if a snippet is native (belongs) to the main database. +// @param Snippet [in] Snippet to test. +// @return True if snippet is native, False if not. +// } +// function IsUserDatabase: Boolean; override; +// {Checks if the database is the user database. +// @return False - this is not the user database. +// } + + /// Returns the ID of the collection being loaded into the + /// database. + function CollectionID: TCollectionID; override; + function ErrorMessageHeading: string; override; {Returns heading to use in error messages. Identifies main database. @return Required heading. @@ -246,15 +257,20 @@ TUserDatabaseLoader = class(TDatabaseLoader, IDatabaseLoader) @return Reference to required snippet object or nil if snippet is not found. } - function IsNativeSnippet(const Snippet: TSnippet): Boolean; override; - {Checks if a snippet is native (belongs) to the user database. - @param Snippet [in] Snippet to test. - @return True if snippet is native, False if not. - } - function IsUserDatabase: Boolean; override; - {Checks if the database is the user database. - @return True - this is the user database. - } +// function IsNativeSnippet(const Snippet: TSnippet): Boolean; override; +// {Checks if a snippet is native (belongs) to the user database. +// @param Snippet [in] Snippet to test. +// @return True if snippet is native, False if not. +// } +// function IsUserDatabase: Boolean; override; +// {Checks if the database is the user database. +// @return True - this is the user database. +// } + + /// Returns the ID of the collection being loaded into the + /// database. + function CollectionID: TCollectionID; override; + function ErrorMessageHeading: string; override; {Returns heading to use in error messages. Identifies main database. @return Required heading. @@ -354,6 +370,16 @@ procedure TDatabaseLoader.HandleException(const E: Exception); raise E; end; +function TDatabaseLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; +begin + Result := Snippet.CollectionID = CollectionID; +end; + +function TDatabaseLoader.IsUserDatabase: Boolean; +begin + Result := CollectionID <> TCollectionID.__TMP__MainDBCollectionID; +end; + procedure TDatabaseLoader.Load(const SnipList: TSnippetList; const Categories: TCategoryList; const DBDataItemFactory: IDBDataItemFactory); {Loads data from storage and updates database object. @@ -472,7 +498,8 @@ procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); for SnippetName in SnippetNames do begin // Check if snippet exists in current database and add it to list if not - Snippet := fSnipList.Find(SnippetName, IsUserDatabase); +// Snippet := fSnipList.Find(SnippetName, IsUserDatabase); + Snippet := fSnipList.Find(SnippetName, CollectionID); if not Assigned(Snippet) then begin fReader.GetSnippetProps(SnippetName, SnippetProps); @@ -489,6 +516,11 @@ procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); { TMainDatabaseLoader } +function TMainDatabaseLoader.CollectionID: TCollectionID; +begin + Result := TCollectionID.__TMP__MainDBCollectionID; +end; + function TMainDatabaseLoader.CreateReader: IDataReader; {Creates reader object. If main database doesn't exist a nul reader is created. @@ -519,28 +551,34 @@ function TMainDatabaseLoader.FindSnippet(const SnippetName: string; } begin // We only search main database - Result := SnipList.Find(SnippetName, False); +// Result := SnipList.Find(SnippetName, False); + Result := SnipList.Find(SnippetName, CollectionID); end; -function TMainDatabaseLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; - {Checks if a snippet is native (belongs) to the main database. - @param Snippet [in] Snippet to test. - @return True if snippet is native, False if not. - } -begin - Result := not Snippet.UserDefined; -end; +//function TMainDatabaseLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; +// {Checks if a snippet is native (belongs) to the main database. +// @param Snippet [in] Snippet to test. +// @return True if snippet is native, False if not. +// } +//begin +// Result := not Snippet.UserDefined; +//end; + +//function TMainDatabaseLoader.IsUserDatabase: Boolean; +// {Checks if the database is the user database. +// @return False - this is not the user database. +// } +//begin +// Result := False; +//end; -function TMainDatabaseLoader.IsUserDatabase: Boolean; - {Checks if the database is the user database. - @return False - this is not the user database. - } +{ TUserDatabaseLoader } + +function TUserDatabaseLoader.CollectionID: TCollectionID; begin - Result := False; + Result := TCollectionID.__TMP__UserDBCollectionID; end; -{ TUserDatabaseLoader } - function TUserDatabaseLoader.CreateReader: IDataReader; {Creates reader object. If user database doesn't exist a nul reader is created. @@ -572,28 +610,30 @@ function TUserDatabaseLoader.FindSnippet(const SnippetName: string; } begin // Search in user database - Result := SnipList.Find(SnippetName, True); +// Result := SnipList.Find(SnippetName, True); + Result := SnipList.Find(SnippetName, CollectionID); if not Assigned(Result) then // Not in user database: try main database - Result := SnipList.Find(SnippetName, False); +// Result := SnipList.Find(SnippetName, False); + Result := SnipList.Find(SnippetName, TCollectionID.__TMP__MainDBCollectionID); end; -function TUserDatabaseLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; - {Checks if a snippet is native (belongs) to the user database. - @param Snippet [in] Snippet to test. - @return True if snippet is native, False if not. - } -begin - Result := Snippet.UserDefined; -end; - -function TUserDatabaseLoader.IsUserDatabase: Boolean; - {Checks if the database is the user database. - @return True - this is the user database. - } -begin - Result := True; -end; +//function TUserDatabaseLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; +// {Checks if a snippet is native (belongs) to the user database. +// @param Snippet [in] Snippet to test. +// @return True if snippet is native, False if not. +// } +//begin +// Result := Snippet.UserDefined; +//end; + +//function TUserDatabaseLoader.IsUserDatabase: Boolean; +// {Checks if the database is the user database. +// @return True - this is the user database. +// } +//begin +// Result := True; +//end; procedure TUserDatabaseLoader.LoadCategories; {Loads all categories from storage and adds user and imports categories if not @@ -690,7 +730,8 @@ procedure TDatabaseWriter.WriteSnippets; for Snippet in fSnipList do begin // Only write user-defined snippets - if Snippet.UserDefined then +// if Snippet.UserDefined then + if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then begin // Get and write a snippet's properties Props := fProvider.GetSnippetProps(Snippet); From 3116d2165d94a2c336c233cad9602ef125a00806 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 1 Nov 2024 12:05:29 +0000 Subject: [PATCH 017/222] Remove UserDefined params from TSnippetDoc classes TSnippetDoc's abstract RenderHeading settings method was changed from taking a Boolean UserDefined parameter to a TCollectionID parameter. Implementations in descendant clases in TTextSnippetDoc and TRTFSnippetDoc were changed accordingly. TSnippetDoc and TRTFSnippetDoc both required __TMP__ method calls to be used to implement the changes. Removed code was commented out. --- Src/URTFSnippetDoc.pas | 35 ++++++++++++++++++++++++++++------- Src/USnippetDoc.pas | 27 +++++++++++++++++++-------- Src/UTextSnippetDoc.pas | 29 ++++++++++++++++++++++------- 3 files changed, 69 insertions(+), 22 deletions(-) diff --git a/Src/URTFSnippetDoc.pas b/Src/URTFSnippetDoc.pas index 4bb6399c1..185dc8ca9 100644 --- a/Src/URTFSnippetDoc.pas +++ b/Src/URTFSnippetDoc.pas @@ -18,6 +18,7 @@ interface uses // Project + DB.UCollections, ActiveText.UMain, ActiveText.URTFRenderer, Hiliter.UGlobals, UEncodings, UIStringList, USnippetDoc, URTFBuilder, URTFStyles; @@ -75,12 +76,20 @@ TRTFSnippetDoc = class(TSnippetDoc) strict protected /// Initialises rich text document. procedure InitialiseDoc; override; - /// Adds given heading (i.e. snippet name) to document. Can be - /// user defined or from main database. - /// Heading is coloured according to whether user defined or not. + +// /// Adds given heading (i.e. snippet name) to document. Can be +// /// user defined or from main database. +// /// Heading is coloured according to whether user defined or not. +// /// +// procedure RenderHeading(const Heading: string; const UserDefined: Boolean); +// override; + + /// Output given heading, i.e. snippet name for snippet from a + /// given collection.. + /// Heading is coloured according the the snippet's collection. /// - procedure RenderHeading(const Heading: string; const UserDefined: Boolean); - override; + procedure RenderHeading(const Heading: string; + const ACollectionID: TCollectionID); override; /// Adds given snippet description to document. /// Active text formatting is observed and styled to suit /// document. @@ -416,13 +425,25 @@ procedure TRTFSnippetDoc.RenderExtra(const ExtraText: IActiveText); end; end; +//procedure TRTFSnippetDoc.RenderHeading(const Heading: string; +// const UserDefined: Boolean); +//begin +// fBuilder.SetFontStyle([fsBold]); +// fBuilder.SetFontSize(HeadingFontSize); +// if fUseColour then +// fBuilder.SetColour(Preferences.DBHeadingColours[UserDefined]); +// fBuilder.SetParaSpacing(TRTFParaSpacing.Create(0.0, ParaSpacing)); +// fBuilder.AddText(Heading); +// fBuilder.EndPara; +//end; + procedure TRTFSnippetDoc.RenderHeading(const Heading: string; - const UserDefined: Boolean); + const ACollectionID: TCollectionID); begin fBuilder.SetFontStyle([fsBold]); fBuilder.SetFontSize(HeadingFontSize); if fUseColour then - fBuilder.SetColour(Preferences.DBHeadingColours[UserDefined]); + fBuilder.SetColour(Preferences.DBHeadingColours[ACollectionID <> TCollectionID.__TMP__MainDBCollectionID]); fBuilder.SetParaSpacing(TRTFParaSpacing.Create(0.0, ParaSpacing)); fBuilder.AddText(Heading); fBuilder.EndPara; diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index e11245322..7e679a52c 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -21,6 +21,7 @@ interface // Delphi Classes, // Project + DB.UCollections, ActiveText.UMain, Compilers.UGlobals, DB.USnippet, UEncodings, UIStringList; @@ -60,12 +61,20 @@ TSnippetDoc = class(TObject) /// Does nothing. Descendant classes should perform any required /// initialisation here. procedure InitialiseDoc; virtual; - /// Output given heading, i.e. snippet name. Can be user defined - /// or from main database. - /// Heading may be rendered differently depending on whether user - /// defined or not. - procedure RenderHeading(const Heading: string; const UserDefined: Boolean); - virtual; abstract; + +// /// Output given heading, i.e. snippet name. Can be user defined +// /// or from main database. +// /// Heading may be rendered differently depending on whether user +// /// defined or not. +// procedure RenderHeading(const Heading: string; const UserDefined: Boolean); +// virtual; abstract; + + /// Output given heading, i.e. snippet name for snippet from a + /// given collection.. + /// Heading may be rendered differently depending on the snippet's + /// collection. + procedure RenderHeading(const Heading: string; + const ACollectionID: TCollectionID); virtual; abstract; /// Output given snippet description. procedure RenderDescription(const Desc: IActiveText); virtual; abstract; /// Output given source code. @@ -178,7 +187,8 @@ function TSnippetDoc.Generate(const Snippet: TSnippet): TEncodedData; Assert(Assigned(Snippet), ClassName + '.Create: Snippet is nil'); // generate document InitialiseDoc; - RenderHeading(Snippet.DisplayName, Snippet.UserDefined); +// RenderHeading(Snippet.DisplayName, Snippet.UserDefined); + RenderHeading(Snippet.DisplayName, Snippet.CollectionID); RenderDescription(Snippet.Description); RenderSourceCode(Snippet.SourceCode); RenderTitledText( @@ -200,7 +210,8 @@ function TSnippetDoc.Generate(const Snippet: TSnippet): TEncodedData; end; if Snippet.Extra.HasContent then RenderExtra(Snippet.Extra); - if not Snippet.UserDefined then +// if not Snippet.UserDefined then + if Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then // database info written only if snippet is from main database RenderDBInfo(MainDBInfo); Result := FinaliseDoc; diff --git a/Src/UTextSnippetDoc.pas b/Src/UTextSnippetDoc.pas index 923637950..70babef0a 100644 --- a/Src/UTextSnippetDoc.pas +++ b/Src/UTextSnippetDoc.pas @@ -20,6 +20,7 @@ interface // Delphi Classes, // Project + DB.UCollections, ActiveText.UMain, UEncodings, UIStringList, USnippetDoc; @@ -44,12 +45,20 @@ TTextSnippetDoc = class(TSnippetDoc) strict protected /// Initialises plain text document. procedure InitialiseDoc; override; - /// Adds given heading (i.e. snippet name) to document. Can be - /// user defined or from main database. - /// Heading is output the same whether user defined or not, so - /// UserDefined parameter is ignored. - procedure RenderHeading(const Heading: string; const UserDefined: Boolean); - override; + +// /// Adds given heading (i.e. snippet name) to document. Can be +// /// user defined or from main database. +// /// Heading is output the same whether user defined or not, so +// /// UserDefined parameter is ignored. +// procedure RenderHeading(const Heading: string; const UserDefined: Boolean); +// override; + + /// Output given heading, i.e. snippet name for snippet from a + /// given collection. + /// Heading is output the same regardless of the snippet's + /// collection. + procedure RenderHeading(const Heading: string; + const ACollectionID: TCollectionID); override; /// Interprets and adds given snippet description to document. /// /// Active text is converted to word-wrapped plain text @@ -165,11 +174,17 @@ procedure TTextSnippetDoc.RenderExtra(const ExtraText: IActiveText); end; procedure TTextSnippetDoc.RenderHeading(const Heading: string; - const UserDefined: Boolean); + const ACollectionID: TCollectionID); begin fWriter.WriteLine(Heading); end; +//procedure TTextSnippetDoc.RenderHeading(const Heading: string; +// const UserDefined: Boolean); +//begin +// fWriter.WriteLine(Heading); +//end; + procedure TTextSnippetDoc.RenderNoCompilerInfo(const Heading, NoCompileTests: string); begin From bf1cd51a04912ae54b13244baedbde10b2b1fa8f Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 2 Nov 2024 08:21:59 +0000 Subject: [PATCH 018/222] Remove INotifier.DisplaySnippet Boolean overload Also removed method from TNotifier. Updated FmFavouritesDlg to call TCollectionID version of DisplaySnippet instead of removed overload. Removed code was commented out. --- Src/FmFavouritesDlg.pas | 2 +- Src/IntfNotifier.pas | 20 +++++++++---------- Src/UNotifier.pas | 44 ++++++++++++++++++++--------------------- 3 files changed, 33 insertions(+), 33 deletions(-) diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index 0ee1c1364..ac2b4f936 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -346,7 +346,7 @@ procedure TFavouritesDlg.actDisplayExecute(Sender: TObject); fNotifier.DisplaySnippet( SelectedSnippet.Name, // SelectedSnippet.UserDefined, - SelectedSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, + SelectedSnippet.CollectionID,// <> TCollectionID.__TMP__MainDBCollectionID, chkNewTab.Checked ); fFavourites.Touch(SelectedSnippet); diff --git a/Src/IntfNotifier.pas b/Src/IntfNotifier.pas index 1c15d9b03..4c15ae69c 100644 --- a/Src/IntfNotifier.pas +++ b/Src/IntfNotifier.pas @@ -33,15 +33,15 @@ interface /// Requests a database update. procedure UpdateDbase; - /// Displays a snippet. - /// WideString [in] Name of required snippet. - /// - /// WordBool [in] Indicates whether snippet is - /// user defined. - /// WordBool [in] Whether to display snippet in a new - /// detail pane tab. - procedure DisplaySnippet(const SnippetName: WideString; - UserDefined: WordBool; NewTab: WordBool); overload; +// /// Displays a snippet. +// /// WideString [in] Name of required snippet. +// /// +// /// WordBool [in] Indicates whether snippet is +// /// user defined. +// /// WordBool [in] Whether to display snippet in a new +// /// detail pane tab. +// procedure DisplaySnippet(const SnippetName: WideString; +// UserDefined: WordBool; NewTab: WordBool); overload; /// Displays a snippet. /// WideString [in] Name of required snippet. @@ -51,7 +51,7 @@ interface /// WordBool [in] Whether to display snippet in a new /// detail pane tab. procedure DisplaySnippet(const SnippetName: WideString; - ACollectionID: TCollectionID; NewTab: WordBool); overload; + ACollectionID: TCollectionID; NewTab: WordBool); /// Displays a category. /// WideString [in] ID of required category. diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index 81db10187..c0dcd22fa 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -73,16 +73,16 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) /// Methods of INotifier. procedure UpdateDbase; - /// Displays a snippet. - /// WideString [in] Name of required snippet. - /// - /// WordBool [in] Indicates whether snippet is - /// user defined. - /// WordBool [in] Whether to display snippet in a new - /// detail pane tab. - /// Methods of INotifier. - procedure DisplaySnippet(const SnippetName: WideString; - UserDefined: WordBool; NewTab: WordBool); overload; +// /// Displays a snippet. +// /// WideString [in] Name of required snippet. +// /// +// /// WordBool [in] Indicates whether snippet is +// /// user defined. +// /// WordBool [in] Whether to display snippet in a new +// /// detail pane tab. +// /// Methods of INotifier. +// procedure DisplaySnippet(const SnippetName: WideString; +// UserDefined: WordBool; NewTab: WordBool); overload; /// Displays a snippet. /// WideString [in] Name of required snippet. @@ -92,7 +92,7 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) /// WordBool [in] Whether to display snippet in a new /// detail pane tab. procedure DisplaySnippet(const SnippetName: WideString; - ACollectionID: TCollectionID; NewTab: WordBool); overload; + ACollectionID: TCollectionID; NewTab: WordBool); /// Displays a category. /// WideString [in] ID of required category. @@ -278,17 +278,17 @@ procedure TNotifier.DisplaySnippet(const SnippetName: WideString; end; end; -procedure TNotifier.DisplaySnippet(const SnippetName: WideString; - UserDefined: WordBool; NewTab: WordBool); -begin - if Assigned(fDisplaySnippetAction) then - begin - (fDisplaySnippetAction as TSnippetAction).SnippetName := SnippetName; - (fDisplaySnippetAction as TSnippetAction).UserDefined := UserDefined; - (fDisplaySnippetAction as TSnippetAction).NewTab := NewTab; - fDisplaySnippetAction.Execute; - end; -end; +//procedure TNotifier.DisplaySnippet(const SnippetName: WideString; +// UserDefined: WordBool; NewTab: WordBool); +//begin +// if Assigned(fDisplaySnippetAction) then +// begin +// (fDisplaySnippetAction as TSnippetAction).SnippetName := SnippetName; +// (fDisplaySnippetAction as TSnippetAction).UserDefined := UserDefined; +// (fDisplaySnippetAction as TSnippetAction).NewTab := NewTab; +// fDisplaySnippetAction.Execute; +// end; +//end; procedure TNotifier.EditSnippet(const SnippetName: WideString); begin From b490893cf0739c70912f49f002e381247f95769a Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 30 Oct 2024 22:20:57 +0000 Subject: [PATCH 019/222] Add TCategory.CollectionID property Reimplemented UserDefined property in terms of CollectionID property. Used __TMP__ getter and setter methods to achieve this Removed fUserDefined field. Added overloaded constructor to take collection ID as a parameter. Left original constructor in place that takes UserDefined parameter. Old code was commented out. --- Src/DB.UCategory.pas | 64 ++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 59 insertions(+), 5 deletions(-) diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index c5860d3c0..8a5741e85 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -20,6 +20,7 @@ interface // Delphi Generics.Collections, // Project + DB.UCollections, DB.USnippet; @@ -51,7 +52,12 @@ TCategory = class(TObject) fSnippets: TSnippetList; // List of snippet objects in category fID: string; // Category id fDescription: string; // Category description - fUserDefined: Boolean; // Whether this is a user-defined snippet +// fUserDefined: Boolean; // Whether this is a user-defined snippet + fCollectionID: TCollectionID; + + function __TMP__GetUserDefined: Boolean; + procedure __TMP__SetUserDefined(const AValue: Boolean); + procedure SetCollectionID(const AValue: TCollectionID); function CompareIDTo(const Cat: TCategory): Integer; {Compares this category's ID to that of a given category. The check is not case sensitive. @@ -60,8 +66,20 @@ TCategory = class(TObject) are equal or +1 if this category's ID is greater than Cat's. } public - constructor Create(const CatID: string; const UserDefined: Boolean; + /// Object constructor. Sets up category object with given + /// property values. + /// CatID [in] Category ID. + /// TCollectionID [in] ID of collection + /// that defines this category. ID must not be null. + /// TCategoryData [in] category properties. + /// + constructor Create(const CatID: string; const ACollectionID: TCollectionID; const Data: TCategoryData); + overload; {TODO -cCollections: remove overload } + + constructor Create(const CatID: string; const UserDefined: Boolean; + const Data: TCategoryData); overload; + {TODO -cCollections: remove this constructor} {Class contructor. Sets up category object with given property values. @param Data [in] Contains required property values. } @@ -93,8 +111,14 @@ TCategory = class(TObject) {Description of category} property Snippets: TSnippetList read fSnippets; {List of snippets in this category} - property UserDefined: Boolean read fUserDefined; +// property UserDefined: Boolean read fUserDefined; + property UserDefined: Boolean + read __TMP__GetUserDefined write __TMP__SetUserDefined; {Flag that indicates if this is a user defined category} + /// ID of collection that defines this category. + /// ID must not be null. + property CollectionID: TCollectionID + read fCollectionID write SetCollectionID; end; { @@ -194,7 +218,7 @@ function TCategory.CanDelete: Boolean; @return True if deletion allowed, False if not. } begin - Result := fUserDefined and fSnippets.IsEmpty + Result := __TMP__GetUserDefined and fSnippets.IsEmpty and not TReservedCategories.IsReserved(Self); end; @@ -224,6 +248,19 @@ function TCategory.CompareIDTo(const Cat: TCategory): Integer; Result := StrCompareText(Self.ID, Cat.ID); end; +constructor TCategory.Create(const CatID: string; + const ACollectionID: TCollectionID; const Data: TCategoryData); +begin + Assert(ClassType <> TCategory, + ClassName + '.Create: must only be called from descendants.'); + inherited Create; + fID := CatID; + fDescription := Data.Desc; + SetCollectionID(ACollectionID); + // Create list to store snippets in category + fSnippets := TSnippetListEx.Create; +end; + constructor TCategory.Create(const CatID: string; const UserDefined: Boolean; const Data: TCategoryData); {Class contructor. Sets up category object with given property values. @@ -235,7 +272,8 @@ constructor TCategory.Create(const CatID: string; const UserDefined: Boolean; inherited Create; fID := CatID; fDescription := Data.Desc; - fUserDefined := UserDefined; +// fUserDefined := UserDefined; + __TMP__SetUserDefined(UserDefined); // sets CollectionID property // Create list to store snippets in category fSnippets := TSnippetListEx.Create; end; @@ -258,6 +296,22 @@ function TCategory.IsEqual(const Cat: TCategory): Boolean; Result := CompareIDTo(Cat) = 0; end; +procedure TCategory.SetCollectionID(const AValue: TCollectionID); +begin + Assert(not AValue.IsNull, ClassName + '.SetCollectionID: Value is null'); + fCollectionID := AValue; +end; + +function TCategory.__TMP__GetUserDefined: Boolean; +begin + Result := fCollectionID <> TCollectionID.__TMP__MainDBCollectionID; +end; + +procedure TCategory.__TMP__SetUserDefined(const AValue: Boolean); +begin + fCollectionID := TCollectionID.__TMP__DBCollectionID(AValue); +end; + { TCategoryEx } function TCategoryEx.GetEditData: TCategoryData; From 42a49d3f99b2fe8dced73185a7a7e4ead1273d2f Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 2 Nov 2024 08:29:42 +0000 Subject: [PATCH 020/222] Remove TCategory's Boolean ctor overload The Boolean constructor took a UserDefined parameter. Modified TDatabase.InternalAddCategory and TDBDataItemFactory.CreateCategory in DB.UMain to call the remaining TCategory constructor that takes a TCollectionID parameter. __TMP__ methods were required to achieve changes to DB.UMain. Removed code was commented out. --- Src/DB.UCategory.pas | 45 ++++++++++++++++++++++---------------------- Src/DB.UMain.pas | 12 +++++++++--- 2 files changed, 31 insertions(+), 26 deletions(-) diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index 8a5741e85..663ad6da9 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -75,14 +75,13 @@ TCategory = class(TObject) /// constructor Create(const CatID: string; const ACollectionID: TCollectionID; const Data: TCategoryData); - overload; {TODO -cCollections: remove overload } - constructor Create(const CatID: string; const UserDefined: Boolean; - const Data: TCategoryData); overload; - {TODO -cCollections: remove this constructor} - {Class contructor. Sets up category object with given property values. - @param Data [in] Contains required property values. - } +// constructor Create(const CatID: string; const UserDefined: Boolean; +// const Data: TCategoryData); overload; +// {Class contructor. Sets up category object with given property values. +// @param Data [in] Contains required property values. +// } + destructor Destroy; override; {Destructor. Tears down object. } @@ -261,22 +260,22 @@ constructor TCategory.Create(const CatID: string; fSnippets := TSnippetListEx.Create; end; -constructor TCategory.Create(const CatID: string; const UserDefined: Boolean; - const Data: TCategoryData); - {Class contructor. Sets up category object with given property values. - @param Data [in] Contains required property values. - } -begin - Assert(ClassType <> TCategory, - ClassName + '.Create: must only be called from descendants.'); - inherited Create; - fID := CatID; - fDescription := Data.Desc; -// fUserDefined := UserDefined; - __TMP__SetUserDefined(UserDefined); // sets CollectionID property - // Create list to store snippets in category - fSnippets := TSnippetListEx.Create; -end; +//constructor TCategory.Create(const CatID: string; const UserDefined: Boolean; +// const Data: TCategoryData); +// {Class contructor. Sets up category object with given property values. +// @param Data [in] Contains required property values. +// } +//begin +// Assert(ClassType <> TCategory, +// ClassName + '.Create: must only be called from descendants.'); +// inherited Create; +// fID := CatID; +// fDescription := Data.Desc; +//// fUserDefined := UserDefined; +// __TMP__SetUserDefined(UserDefined); // sets CollectionID property +// // Create list to store snippets in category +// fSnippets := TSnippetListEx.Create; +//end; destructor TCategory.Destroy; {Destructor. Tears down object. diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 6b61183e1..f8bdb3a74 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -272,7 +272,12 @@ implementation // Delphi SysUtils, Generics.Defaults, // Project - DB.UDatabaseIO, IntfCommon, UExceptions, UQuery, UStrUtils; + DB.UCollections, + DB.UDatabaseIO, + IntfCommon, + UExceptions, + UQuery, + UStrUtils; var @@ -888,7 +893,8 @@ function TDatabase.InternalAddCategory(const CatID: string; @return Reference to new category object. } begin - Result := TCategoryEx.Create(CatID, True, Data); +// Result := TCategoryEx.Create(CatID, True, Data); + Result := TCategoryEx.Create(CatID, TCollectionID.__TMP__DBCollectionID(True), Data); fCategories.Add(Result); end; @@ -1152,7 +1158,7 @@ function TDBDataItemFactory.CreateCategory(const CatID: string; @return Instance of new category object. } begin - Result := TCategoryEx.Create(CatID, UserDefined, Data); + Result := TCategoryEx.Create(CatID, TCollectionID.__TMP__DBCollectionID(UserDefined), Data); end; function TDBDataItemFactory.CreateSnippet(const Name: string; From 2c53e74887c4e68969806f919332a0c4e3170f72 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 2 Nov 2024 09:36:29 +0000 Subject: [PATCH 021/222] Remove TCategory.UserDefined property Changed all units affected by the change to perform tests on TCategory.CollectionID instead of checking UserDefined. Used __TMP__ method calls to make these changes. All removed code was commented out. --- Src/DB.UCategory.pas | 25 ++++++------------------- Src/DB.UMain.pas | 4 +++- Src/FrSelectSnippetsBase.pas | 16 ++++++++++++---- Src/FrSelectUserSnippets.pas | 3 ++- Src/UDetailPageHTML.pas | 3 ++- Src/URTFCategoryDoc.pas | 5 +++-- Src/UUserDBMgr.pas | 5 +++-- 7 files changed, 31 insertions(+), 30 deletions(-) diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index 663ad6da9..6aeeb9f8f 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -54,9 +54,6 @@ TCategory = class(TObject) fDescription: string; // Category description // fUserDefined: Boolean; // Whether this is a user-defined snippet fCollectionID: TCollectionID; - - function __TMP__GetUserDefined: Boolean; - procedure __TMP__SetUserDefined(const AValue: Boolean); procedure SetCollectionID(const AValue: TCollectionID); function CompareIDTo(const Cat: TCategory): Integer; {Compares this category's ID to that of a given category. The check is not @@ -111,9 +108,7 @@ TCategory = class(TObject) property Snippets: TSnippetList read fSnippets; {List of snippets in this category} // property UserDefined: Boolean read fUserDefined; - property UserDefined: Boolean - read __TMP__GetUserDefined write __TMP__SetUserDefined; - {Flag that indicates if this is a user defined category} +// {Flag that indicates if this is a user defined category} /// ID of collection that defines this category. /// ID must not be null. property CollectionID: TCollectionID @@ -217,7 +212,10 @@ function TCategory.CanDelete: Boolean; @return True if deletion allowed, False if not. } begin - Result := __TMP__GetUserDefined and fSnippets.IsEmpty +// Result := fUserDefined and fSnippets.IsEmpty +// and not TReservedCategories.IsReserved(Self); + Result := (fCollectionID <> TCollectionID.__TMP__MainDBCollectionID) + and fSnippets.IsEmpty and not TReservedCategories.IsReserved(Self); end; @@ -271,8 +269,7 @@ constructor TCategory.Create(const CatID: string; // inherited Create; // fID := CatID; // fDescription := Data.Desc; -//// fUserDefined := UserDefined; -// __TMP__SetUserDefined(UserDefined); // sets CollectionID property +// fUserDefined := UserDefined; // // Create list to store snippets in category // fSnippets := TSnippetListEx.Create; //end; @@ -301,16 +298,6 @@ procedure TCategory.SetCollectionID(const AValue: TCollectionID); fCollectionID := AValue; end; -function TCategory.__TMP__GetUserDefined: Boolean; -begin - Result := fCollectionID <> TCollectionID.__TMP__MainDBCollectionID; -end; - -procedure TCategory.__TMP__SetUserDefined(const AValue: Boolean); -begin - fCollectionID := TCollectionID.__TMP__DBCollectionID(AValue); -end; - { TCategoryEx } function TCategoryEx.GetEditData: TCategoryData; diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index f8bdb3a74..03c6f433d 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -818,7 +818,9 @@ function TDatabase.GetEditableCategoryInfo( @return Required data. } begin - Assert(not Assigned(Category) or Category.UserDefined, +// Assert(not Assigned(Category) or Category.UserDefined, +// ClassName + '.GetEditableCategoryInfo: Category is not user-defined'); + Assert(not Assigned(Category) or (Category.CollectionID <> TCollectionID.__TMP__MainDBCollectionID), ClassName + '.GetEditableCategoryInfo: Category is not user-defined'); if Assigned(Category) then Result := (Category as TCategoryEx).GetEditData diff --git a/Src/FrSelectSnippetsBase.pas b/Src/FrSelectSnippetsBase.pas index 4952a2ace..3074cf0d1 100644 --- a/Src/FrSelectSnippetsBase.pas +++ b/Src/FrSelectSnippetsBase.pas @@ -42,6 +42,9 @@ TSelectSnippetsBaseFrame = class(TCheckedTVFrame) } TTVDraw = class(TSnippetsTVDraw) strict protected + {TODO -cCollections: Need to change following method in base class to + get collection ID and calling code then needs to take action based + on that instead of user-defined.} function IsUserDefinedNode(const Node: TTreeNode): Boolean; override; {Checks if a node represents a user defined snippets object. @param Node [in] Node to be checked. @@ -118,9 +121,12 @@ implementation uses // Delphi - SysUtils, StdCtrls, + SysUtils, + StdCtrls, // Project - DB.UMain, UGroups; + DB.UCollections, + DB.UMain, + UGroups; {$R *.dfm} @@ -283,9 +289,11 @@ function TSelectSnippetsBaseFrame.TTVDraw.IsUserDefinedNode( SnipObj := TObject(Node.Data); Result := False; if SnipObj is TSnippet then - Result := (SnipObj as TSnippet).UserDefined +// Result := (SnipObj as TSnippet).UserDefined + Result := (SnipObj as TSnippet).CollectionID <> TCollectionID.__TMP__MainDBCollectionID else if SnipObj is TCategory then - Result := (SnipObj as TCategory).UserDefined; +// Result := (SnipObj as TCategory).UserDefined; + Result := (SnipObj as TCategory).CollectionID <> TCollectionID.__TMP__MainDBCollectionID; end; end. diff --git a/Src/FrSelectUserSnippets.pas b/Src/FrSelectUserSnippets.pas index 54177bbac..69ca8307e 100644 --- a/Src/FrSelectUserSnippets.pas +++ b/Src/FrSelectUserSnippets.pas @@ -79,7 +79,8 @@ function TSelectUserSnippetsFrame.CanAddSnippetNode( @return True if snippet is user-defined. } begin - Result := Snippet.UserDefined; +// Result := Snippet.UserDefined; + Result := Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID; end; end. diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 9b50c4680..d8149bae2 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -669,7 +669,8 @@ function TCategoryPageHTML.GetEmptyListNote: string; function TCategoryPageHTML.GetH1ClassName: string; begin - if (View as ICategoryView).Category.UserDefined then +// if (View as ICategoryView).Category.UserDefined then + if (View as ICategoryView).Category.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then Result := 'userdb' else Result := inherited GetH1ClassName; diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index c867c603a..e4d193f5e 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -90,7 +90,7 @@ implementation uses // Project - ActiveText.UMain, UColours, UPreferences; + ActiveText.UMain, DB.UCollections, UColours, UPreferences; { TRTFCategoryDoc } @@ -214,7 +214,8 @@ procedure TRTFCategoryDoc.OutputCategoryHeading(const Category: TCategory); fBuilder.SetFont(MainFontName); fBuilder.SetFontSize(HeadingFontSize); fBuilder.SetFontStyle([fsBold]); - SetColour(Preferences.DBHeadingColours[Category.UserDefined]); +// SetColour(Preferences.DBHeadingColours[Category.UserDefined]); + SetColour(Preferences.DBHeadingColours[Category.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]); fBuilder.AddText(Category.Description); fBuilder.EndPara; fBuilder.EndGroup; diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 48ce2ecd8..758d4af90 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -108,7 +108,7 @@ implementation // Delphi SysUtils, Dialogs, Windows {for inlining}, IOUtils, // Project - DB.UMain, DB.USnippet, + DB.UCollections, DB.UMain, DB.USnippet, FmAddCategoryDlg, FmDeleteCategoryDlg, FmDuplicateSnippetDlg, FmRenameCategoryDlg, FmSnippetsEditorDlg, {$IFNDEF PORTABLE} @@ -362,7 +362,8 @@ class function TUserDBMgr.CreateUserCatList( begin Result := TCategoryList.Create; for Cat in Database.Categories do - if Cat.UserDefined and +// if Cat.UserDefined and + if (Cat.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) and (IncludeSpecial or not TReservedCategories.IsReserved(Cat)) then Result.Add(Cat); end; From 2a6c6d5b07612b2f4e5b6ee000a47477f9565c14 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 3 Nov 2024 00:20:18 +0000 Subject: [PATCH 022/222] Remove TSnippet.UserDefined property Updated all affected units by changing references to TSnippet.UserDefined to checks on TSnippet.CollectionID. Required many __TMP__ method calls to achieve this. Removed redundant TODO from USnippetIDs unit. Removed code was commented out. --- Src/DB.UMain.pas | 19 ++++++++++++++----- Src/DB.USnippet.pas | 8 -------- Src/FmCodeExportDlg.pas | 4 +++- Src/FmDependenciesDlg.pas | 17 +++++++++++++---- Src/FmDuplicateSnippetDlg.pas | 4 +++- Src/FmFindXRefsDlg.pas | 13 ++++++++++--- Src/FmSelectionSearchDlg.pas | 3 ++- Src/FmSnippetsEditorDlg.pas | 3 ++- Src/FmTestCompileDlg.pas | 14 +++++++++++--- Src/UCodeShareMgr.pas | 3 ++- Src/UDetailPageHTML.pas | 12 ++++++++---- Src/URTFCategoryDoc.pas | 3 ++- Src/USaveUnitMgr.pas | 4 +++- Src/USnippetIDs.pas | 2 -- Src/USnippetSourceGen.pas | 7 +++++-- Src/USnippetsChkListMgr.pas | 11 ++++++++--- Src/UUserDBMgr.pas | 7 +++++-- 17 files changed, 91 insertions(+), 43 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 03c6f433d..e77457457 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -666,8 +666,10 @@ function TDatabase.CreateTempSnippet(const Snippet: TSnippet): TSnippet; Assert(Snippet is TSnippetEx, ClassName + '.CreateTempSnippet: Snippet is a TSnippetEx'); Data := (Snippet as TSnippetEx).GetEditData; +// Result := TTempSnippet.Create( +// Snippet.Name, Snippet.UserDefined, (Snippet as TSnippetEx).GetProps); Result := TTempSnippet.Create( - Snippet.Name, Snippet.UserDefined, (Snippet as TSnippetEx).GetProps); + Snippet.Name, Snippet.CollectionID, (Snippet as TSnippetEx).GetProps); (Result as TTempSnippet).UpdateRefs( (Snippet as TSnippetEx).GetReferences, fSnippets ); @@ -718,7 +720,9 @@ procedure TDatabase.DeleteSnippet(const Snippet: TSnippet); Referrer: TSnippet; // loops thru snippets that cross references Snippet Referrers: TSnippetList; // list of referencing snippets begin - Assert(Snippet.UserDefined, +// Assert(Snippet.UserDefined, +// ClassName + '.DeleteSnippet: Snippet is not user-defined'); + Assert(Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, ClassName + '.DeleteSnippet: Snippet is not user-defined'); Assert(fSnippets.Contains(Snippet), ClassName + '.DeleteSnippet: Snippet is not in the database'); @@ -837,8 +841,10 @@ function TDatabase.GetEditableSnippetInfo( @return Required data. } begin - Assert(not Assigned(Snippet) or Snippet.UserDefined, + Assert(not Assigned(Snippet) or (Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID), ClassName + '.GetEditableSnippetInfo: Snippet is not user-defined'); +// Assert(not Assigned(Snippet) or Snippet.UserDefined, +// ClassName + '.GetEditableSnippetInfo: Snippet is not user-defined'); if Assigned(Snippet) then Result := (Snippet as TSnippetEx).GetEditData else @@ -1072,8 +1078,10 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; + '%1:s already exists in user database'; begin Result := Snippet; // keeps compiler happy - Assert(Snippet.UserDefined, + Assert(Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, ClassName + '.UpdateSnippet: Snippet is not user-defined'); +// Assert(Snippet.UserDefined, +// ClassName + '.UpdateSnippet: Snippet is not user-defined'); Referrers := nil; Dependents := nil; TriggerEvent(evChangeBegin); @@ -1211,7 +1219,8 @@ function TUserDataProvider.GetCategorySnippets( begin Result := TIStringList.Create; for Snippet in Cat.Snippets do - if Snippet.UserDefined then +// if Snippet.UserDefined then + if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then Result.Add(Snippet.Name); end; diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index e47226230..ad6cbfa3a 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -138,7 +138,6 @@ type TDisplayNameComparer = class(TComparer) {Gets snippet's display name, or name if no display name is set @return Required display name. } - function __TMP__GetUserDefined: Boolean; strict protected procedure SetName(const Name: string); {Sets Name property. @@ -214,8 +213,6 @@ type TDisplayNameComparer = class(TComparer) property XRef: TSnippetList read fXRef; {List of cross referenced snippets in database} // property UserDefined: Boolean read fUserDefined;; - property UserDefined: Boolean read __TMP__GetUserDefined; - {TODO -cCollections: Remove above property & getter/setter} {Flag that indicates if this is a user defined snippet} property CollectionID: TCollectionID read fCollectionID; end; @@ -557,11 +554,6 @@ procedure TSnippet.SetProps(const Data: TSnippetData); fTestInfo := Data.TestInfo; end; -function TSnippet.__TMP__GetUserDefined: Boolean; -begin - Result := fCollectionID = TCollectionID.__TMP__UserDBCollectionID; -end; - { TSnippet.TDisplayNameComparer } function TSnippet.TDisplayNameComparer.Compare(const Left, diff --git a/Src/FmCodeExportDlg.pas b/Src/FmCodeExportDlg.pas index 39cfdae8e..48ffc385f 100644 --- a/Src/FmCodeExportDlg.pas +++ b/Src/FmCodeExportDlg.pas @@ -72,6 +72,7 @@ implementation // Delphi SysUtils, Dialogs, // Project + DB.UCollections, UCodeImportExport, UCtrlArranger, UEncodings, UExceptions, UIOUtils, UMessageBox, UOpenDialogHelper, USaveDialogEx, UStrUtils, UUtils; @@ -209,7 +210,8 @@ procedure TCodeExportDlg.SelectSnippet(const Snippet: TSnippet); var List: TSnippetList; // list containing only the provided snippet begin - if not Assigned(Snippet) or not Snippet.UserDefined then + if not Assigned(Snippet) or (Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID) then +// if not Assigned(Snippet) or not Snippet.UserDefined then // Snippet is nil or not user-defined: select nothing frmSnippets.SelectedSnippets := nil else diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index e1705a01e..ddc25ee40 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -158,9 +158,16 @@ implementation uses // Delphi - SysUtils, Graphics, + SysUtils, + Graphics, // Project - DB.UMain, DB.USnippetKind, UBox, UColours, UCtrlArranger, UFontHelper, + DB.UCollections, + DB.UMain, + DB.USnippetKind, + UBox, + UColours, + UCtrlArranger, + UFontHelper, UPreferences; {$R *.dfm} @@ -444,7 +451,8 @@ procedure TDependenciesDlg.PopulateRequiredByList; Assert(Assigned(ASnippet), ClassName + '.PopulateRequiredByList: Snippet id not found'); lbDependents.Items.AddObject( - ASnippet.DisplayName, TBox.Create(ASnippet.UserDefined) + ASnippet.DisplayName, TBox.Create(ASnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) +// ASnippet.DisplayName, TBox.Create(ASnippet.UserDefined) ); end; end; @@ -514,7 +522,8 @@ function TDependenciesDlg.TTVDraw.IsUserDefinedNode( if not Assigned(Node.Data) then Result := True else - Result := TSnippet(Node.Data).UserDefined; +// Result := TSnippet(Node.Data).UserDefined; + Result := TSnippet(Node.Data).CollectionID <> TCollectionID.__TMP__MainDBCollectionID; end; end. diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 4c207e683..423c4d7e9 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -77,6 +77,7 @@ implementation // Delphi Math, // Project + DB.UCollections, DB.UCategory, DB.UMain, UCtrlArranger, UExceptions, UMessageBox, USettings, USnippetValidator, UStructs, UStrUtils, UUserDBMgr; @@ -131,7 +132,8 @@ function TDuplicateSnippetDlg.DisallowedNames: IStringList; Result := TIStringList.Create; Result.CaseSensitive := False; for Snippet in Database.Snippets do - if Snippet.UserDefined then +// if Snippet.UserDefined then + if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then Result.Add(Snippet.Name); end; diff --git a/Src/FmFindXRefsDlg.pas b/Src/FmFindXRefsDlg.pas index 0d301ef98..45e280e72 100644 --- a/Src/FmFindXRefsDlg.pas +++ b/Src/FmFindXRefsDlg.pas @@ -127,9 +127,15 @@ implementation uses // Delphi - SysUtils, Graphics, + SysUtils, + Graphics, // Project - UColours, UCtrlArranger, UPreferences, UQuery, USettings; + DB.UCollections, + UColours, + UCtrlArranger, + UPreferences, + UQuery, + USettings; {$R *.dfm} @@ -229,7 +235,8 @@ procedure TFindXRefsDlg.ConfigForm; // Set label font styles and colours lblSnippetName.Font.Style := [fsBold]; lblSnippetName.Font.Color := - Preferences.DBHeadingColours[fSnippet.UserDefined]; +// Preferences.DBHeadingColours[fSnippet.UserDefined]; + Preferences.DBHeadingColours[fSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]; // Display selected snippet name in appropriate controls lblSnippetName.Caption := fSnippet.DisplayName; chkIncludeSnippet.Caption := Format( diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index 3aeaed97f..bf0914b39 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -246,7 +246,8 @@ procedure TSelectionSearchDlg.SelectDB(const UserDefined: Boolean); SnippetList := TSnippetList.Create; try for Snippet in Database.Snippets do - if Snippet.UserDefined = UserDefined then +// if Snippet.UserDefined = UserDefined then + if Snippet.CollectionID = TCollectionID.__TMP__DBCollectionID(UserDefined) then SnippetList.Add(Snippet); frmSelect.SelectedSnippets := SnippetList; finally diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 0e642a4a9..d8222f235 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -989,7 +989,8 @@ procedure TSnippetsEditorDlg.UpdateReferences; // a user-defined one with same name if (Snippet.ID <> EditSnippetID) and ( - Snippet.UserDefined or +// Snippet.UserDefined or + (Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) or not Assigned(Database.Snippets.Find(Snippet.Name, True)) ) then begin diff --git a/Src/FmTestCompileDlg.pas b/Src/FmTestCompileDlg.pas index 5066e2bff..0ed1ba053 100644 --- a/Src/FmTestCompileDlg.pas +++ b/Src/FmTestCompileDlg.pas @@ -155,9 +155,16 @@ implementation uses // Delphi - Math, Windows, Graphics, Types {for inlining}, + Math, + Windows, + Graphics, + Types {for inlining}, // Project - UColours, UCtrlArranger, UFontHelper, UPreferences; + DB.UCollections, + UColours, + UCtrlArranger, + UFontHelper, + UPreferences; {$R *.dfm} @@ -282,7 +289,8 @@ procedure TTestCompileDlg.ConfigForm; // Set required label fonts and captions TFontHelper.SetDefaultBaseFont(lblSnippetName.Font); lblSnippetName.Font.Color := - Preferences.DBHeadingColours[fSnippet.UserDefined]; +// Preferences.DBHeadingColours[fSnippet.UserDefined]; + Preferences.DBHeadingColours[fSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]; lblSnippetName.Caption := fSnippet.DisplayName; end; diff --git a/Src/UCodeShareMgr.pas b/Src/UCodeShareMgr.pas index 099cdf34d..e510ef862 100644 --- a/Src/UCodeShareMgr.pas +++ b/Src/UCodeShareMgr.pas @@ -103,7 +103,8 @@ class function TCodeShareMgr.GetSnippetFromView( SnippetView: ISnippetView; // ViewItem as snippet view if supported begin if Supports(ViewItem, ISnippetView, SnippetView) - and (SnippetView.Snippet.UserDefined) then +// and (SnippetView.Snippet.UserDefined) then + and (SnippetView.Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) then Result := SnippetView.Snippet else Result := nil; diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index d8149bae2..719ef7c11 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -528,15 +528,18 @@ procedure TSnippetInfoPageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); 'overflowXFixScript', 'window.onload = null;' ); - if GetSnippet.UserDefined then +// if GetSnippet.UserDefined then + if GetSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then Tplt.ResolvePlaceholderHTML('SnippetCSSClass', 'userdb') else Tplt.ResolvePlaceholderHTML('SnippetCSSClass', 'maindb'); Tplt.ResolvePlaceholderHTML( - 'TestingInfo', TCSS.BlockDisplayProp(not GetSnippet.UserDefined) +// 'TestingInfo', TCSS.BlockDisplayProp(not GetSnippet.UserDefined) + 'TestingInfo', TCSS.BlockDisplayProp(GetSnippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID) ); Tplt.ResolvePlaceholderHTML( - 'EditLink', TCSS.BlockDisplayProp(GetSnippet.UserDefined) +// 'EditLink', TCSS.BlockDisplayProp(GetSnippet.UserDefined) + 'EditLink', TCSS.BlockDisplayProp(GetSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) ); Tplt.ResolvePlaceholderText( 'EditEventHandler', @@ -544,7 +547,8 @@ procedure TSnippetInfoPageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); ); SnippetHTML := TSnippetHTML.Create(GetSnippet); try - if not GetSnippet.UserDefined then +// if not GetSnippet.UserDefined then + if GetSnippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then Tplt.ResolvePlaceholderHTML('TestingInfoImg', SnippetHTML.TestingImage); Tplt.ResolvePlaceholderHTML('SnippetName', SnippetHTML.SnippetName); finally diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index e4d193f5e..601f41ae0 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -228,7 +228,8 @@ procedure TRTFCategoryDoc.OutputSnippetSubHeading(const Snippet: TSnippet); fBuilder.SetFont(MainFontName); fBuilder.SetFontSize(SubHeadingFontSize); fBuilder.SetFontStyle([fsBold]); - SetColour(Preferences.DBHeadingColours[Snippet.UserDefined]); +// SetColour(Preferences.DBHeadingColours[Snippet.UserDefined]); + SetColour(Preferences.DBHeadingColours[Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]); fBuilder.AddText(Snippet.DisplayName); fBuilder.EndPara; fBuilder.EndGroup; diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index 1cd7841d3..6c4207812 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -96,6 +96,7 @@ implementation // Delphi SysUtils, // Project + DB.UCollections, DB.UMetaData, UAppInfo, UConsts, @@ -262,7 +263,8 @@ constructor TSaveUnitMgr.InternalCreate(const Snips: TSnippetList); fContainsMainDBSnippets := False; for Snippet in Snips do begin - if not Snippet.UserDefined then +// if not Snippet.UserDefined then + if Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then begin fContainsMainDBSnippets := True; Break; diff --git a/Src/USnippetIDs.pas b/Src/USnippetIDs.pas index 620472dcb..9619e6543 100644 --- a/Src/USnippetIDs.pas +++ b/Src/USnippetIDs.pas @@ -25,8 +25,6 @@ interface type - {TODO -cNote: TSnippetID.UserDefined is now uses CollectionID property.} - /// Record that uniquely identifies a code snippet. Specifies name /// and flag indicating whether snippet is user-defined. diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index e7739df85..b6cf42688 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -87,6 +87,7 @@ implementation // Delphi SysUtils, // Project + DB.UCollections, DB.UMetaData, DB.USnippet, DB.USnippetKind, @@ -243,7 +244,8 @@ procedure TSnippetSourceGen.Initialize(View: IView); // view is single snippet: just record that Snippet := (View as ISnippetView).Snippet; fGenerator.IncludeSnippet(Snippet); - fContainsMainDBSnippets := not Snippet.UserDefined; +// fContainsMainDBSnippets := not Snippet.UserDefined; + fContainsMainDBSnippets := Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID; end else begin @@ -254,7 +256,8 @@ procedure TSnippetSourceGen.Initialize(View: IView); fGenerator.IncludeSnippets(Snips); // ignores freeform snippets for Snippet in Snips do begin - if not Snippet.UserDefined then +// if not Snippet.UserDefined then + if Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then begin fContainsMainDBSnippets := True; Break; diff --git a/Src/USnippetsChkListMgr.pas b/Src/USnippetsChkListMgr.pas index 71e5c0561..f6e828052 100644 --- a/Src/USnippetsChkListMgr.pas +++ b/Src/USnippetsChkListMgr.pas @@ -100,9 +100,13 @@ implementation uses // Delphi - Graphics, StdCtrls, + Graphics, + StdCtrls, // Project - UColours, UGraphicUtils, UPreferences; + DB.UCollections, + UColours, + UGraphicUtils, + UPreferences; { TSnippetsChkListMgr } @@ -200,7 +204,8 @@ procedure TSnippetsChkListMgr.DrawItem(Control: TWinControl; Index: Integer; Canvas := fCLB.Canvas; if not (odSelected in State) then Canvas.Font.Color := Preferences.DBHeadingColours[ - (fCLB.Items.Objects[Index] as TSnippet).UserDefined +// (fCLB.Items.Objects[Index] as TSnippet).UserDefined + (fCLB.Items.Objects[Index] as TSnippet).CollectionID <> TCollectionID.__TMP__MainDBCollectionID ]; Canvas.TextRect( Rect, diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 758d4af90..489d751a6 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -294,7 +294,8 @@ class function TUserDBMgr.CanEdit(ViewItem: IView): Boolean; Assert(Assigned(ViewItem), ClassName + '.CanEdit: ViewItem is nil'); Result := Assigned(ViewItem) and Supports(ViewItem, ISnippetView, SnippetView) - and SnippetView.Snippet.UserDefined; +// and SnippetView.Snippet.UserDefined; + and (SnippetView.Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID); end; class procedure TUserDBMgr.CanOpenDialogClose(Sender: TObject; @@ -424,7 +425,9 @@ class procedure TUserDBMgr.DeleteSnippet(ViewItem: IView); Assert(Supports(ViewItem, ISnippetView), ClassName + '.Delete: Current view is not a snippet'); Snippet := (ViewItem as ISnippetView).Snippet; - Assert(Snippet.UserDefined, +// Assert(Snippet.UserDefined, +// ClassName + '.Delete: Snippet must be user defined'); + Assert(Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, ClassName + '.Delete: Snippet must be user defined'); // Check if snippet has dependents: don't allow deletion if so Dependents := (Database as IDatabaseEdit).GetDependents(Snippet); From c2b4a27a12036d14c875a663da1aec962a23f6c0 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 3 Nov 2024 01:43:53 +0000 Subject: [PATCH 023/222] Remove public TSnippetList.Find Boolean overload Updated all affected code to use TSnippetList.Find TCollectionID overload. Used __TMP__ method calls to achieve this. All removed code was commented out. --- Src/DB.UMain.pas | 6 +++-- Src/DB.USnippet.pas | 50 ++++++++++++++++++------------------- Src/Favourites.UPersist.pas | 3 ++- Src/FmSnippetsEditorDlg.pas | 3 ++- Src/UCodeImportMgr.pas | 3 ++- Src/USnippetAction.pas | 8 ++++-- Src/USnippetValidator.pas | 8 ++++-- Src/UUserDBMgr.pas | 3 ++- 8 files changed, 49 insertions(+), 35 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index e77457457..4c08911b6 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -623,7 +623,8 @@ function TDatabase.AddSnippet(const SnippetName: string; TriggerEvent(evChangeBegin); try // Check if snippet with same name exists in user database: error if so - if fSnippets.Find(SnippetName, True) <> nil then +// if fSnippets.Find(SnippetName, True) <> nil then + if fSnippets.Find(SnippetName, TCollectionID.__TMP__DBCollectionID(True)) <> nil then raise ECodeSnip.CreateFmt(sNameExists, [SnippetName]); Result := InternalAddSnippet(SnippetName, Data); Query.Update; @@ -1094,7 +1095,8 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; SnippetName := Snippet.Name; // If name has changed then new name musn't exist in user database if not StrSameText(SnippetName, Snippet.Name) then - if fSnippets.Find(SnippetName, True) <> nil then +// if fSnippets.Find(SnippetName, True) <> nil then + if fSnippets.Find(SnippetName, TCollectionID.__TMP__DBCollectionID(True)) <> nil then raise ECodeSnip.CreateFmt(sCantRename, [Snippet.Name, SnippetName]); // We update by deleting old snippet and inserting new one // get lists of snippets that cross reference or depend on this snippet diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index ad6cbfa3a..abc058d98 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -325,14 +325,14 @@ TSnippetList = class(TObject) @param SnippetID [in] ID of snippet to find. @return Reference to required snippet or nil if not found. } - function Find(const SnippetName: string; - const UserDefined: Boolean): TSnippet; overload; - {Finds a named snippet in list with a matching user defined property. - @param SnippetName [in] Name of required snippet. - @param UserDefined [in] Flag that determines if we are looking for a - user defined snippet or one from main database. - @return Reference to required snippet or nil if not found. - } +// function Find(const SnippetName: string; +// const UserDefined: Boolean): TSnippet; overload; +// {Finds a named snippet in list with a matching user defined property. +// @param SnippetName [in] Name of required snippet. +// @param UserDefined [in] Flag that determines if we are looking for a +// user defined snippet or one from main database. +// @return Reference to required snippet or nil if not found. +// } /// Finds a snippet in the list with whose name and collection ID /// match. @@ -818,23 +818,23 @@ function TSnippetList.Find(const SnippetName: string; end; end; -function TSnippetList.Find(const SnippetName: string; - const UserDefined: Boolean): TSnippet; - {Finds a named snippet in list with a matching user defined property. - @param SnippetName [in] Name of required snippet. - @param UserDefined [in] Flag that determines if we are looking for a - user defined snippet or one from main database. - @return Reference to required snippet or nil if not found. - } -var - Idx: Integer; // index of snippet name in list -begin - if Find(SnippetName, TCollectionID.__TMP__DBCollectionID(UserDefined), Idx) then -// if Find(SnippetName, UserDefined, Idx) then - Result := Items[Idx] - else - Result := nil; -end; +//function TSnippetList.Find(const SnippetName: string; +// const UserDefined: Boolean): TSnippet; +// {Finds a named snippet in list with a matching user defined property. +// @param SnippetName [in] Name of required snippet. +// @param UserDefined [in] Flag that determines if we are looking for a +// user defined snippet or one from main database. +// @return Reference to required snippet or nil if not found. +// } +//var +// Idx: Integer; // index of snippet name in list +//begin +// if Find(SnippetName, TCollectionID.__TMP__DBCollectionID(UserDefined), Idx) then +//// if Find(SnippetName, UserDefined, Idx) then +// Result := Items[Idx] +// else +// Result := nil; +//end; function TSnippetList.Find(const SnippetName: string; const ACollectionID: TCollectionID): TSnippet; diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index d1aa43a0e..b444c5274 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -117,7 +117,8 @@ class procedure TFavouritesPersist.Load(Favourites: TFavourites); if not TryStrToDateTime(Fields[2], LastAccess) then raise EFavouritesPersist.Create(sBadFormat); // only add to favourites if snippet in database - if Database.Snippets.Find(SnippetName, UserDef) <> nil then +// if Database.Snippets.Find(SnippetName, UserDef) <> nil then + if Database.Snippets.Find(SnippetName, TCollectionID.__TMP__DBCollectionID(UserDef)) <> nil then // Favourites.Add(TSnippetID.Create(SnippetName, UserDef), LastAccess); Favourites.Add(TSnippetID.Create(SnippetName, TCollectionID.__TMP__DBCollectionID(UserDef)), LastAccess); end; diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index d8222f235..599699e0b 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -991,7 +991,8 @@ procedure TSnippetsEditorDlg.UpdateReferences; ( // Snippet.UserDefined or (Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) or - not Assigned(Database.Snippets.Find(Snippet.Name, True)) +// not Assigned(Database.Snippets.Find(Snippet.Name, True)) + not Assigned(Database.Snippets.Find(Snippet.Name, TCollectionID.__TMP__DBCollectionID(True))) ) then begin // Decide if snippet can be added to depends list: must be correct kind diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index 7f21d1fee..1ec3e6651 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -287,7 +287,8 @@ procedure TCodeImportMgr.UpdateDatabase; AdjustDependsList(SnippetInfo.Data.Refs.Depends); - Snippet := Database.Snippets.Find(ImportInfo.ImportAsName, True); +// Snippet := Database.Snippets.Find(ImportInfo.ImportAsName, True); + Snippet := Database.Snippets.Find(ImportInfo.ImportAsName, TCollectionID.__TMP__DBCollectionID(True)); if Assigned(Snippet) then // snippet already exists: overwrite it Editor.UpdateSnippet(Snippet, SnippetInfo.Data) diff --git a/Src/USnippetAction.pas b/Src/USnippetAction.pas index 6c0cf81fe..80927a77d 100644 --- a/Src/USnippetAction.pas +++ b/Src/USnippetAction.pas @@ -72,7 +72,10 @@ implementation uses // Project - DB.UMain, DB.USnippet, UView; + DB.UCollections, + DB.UMain, + DB.USnippet, + UView; { TSnippetAction } @@ -83,7 +86,8 @@ function TSnippetAction.Execute: Boolean; begin Assert(Assigned(fNotifier), ClassName + '.Execute: Notifier not set'); Assert(SnippetName <> '', ClassName + '.Execute: SnippetName not provided'); - Snippet := Database.Snippets.Find(SnippetName, UserDefined); +// Snippet := Database.Snippets.Find(SnippetName, UserDefined); + Snippet := Database.Snippets.Find(SnippetName, TCollectionID.__TMP__DBCollectionID(UserDefined)); Assert(Assigned(Snippet), ClassName + '.Execute: SnippetName not valid'); // Create a view item for snippet and get notifier to display it fNotifier.ShowViewItem(TViewFactory.CreateSnippetView(Snippet), NewTab); diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index 83de1adf3..23a21ae67 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -140,7 +140,10 @@ implementation // Delphi SysUtils, // Project - ActiveText.UValidator, DB.UMain, UStrUtils; + ActiveText.UValidator, + DB.UCollections, + DB.UMain, + UStrUtils; { TSnippetValidator } @@ -370,7 +373,8 @@ class function TSnippetValidator.ValidateName(const Name: string; else if not IsValidIdent(TrimmedName) then ErrorMsg := Format(sErrBadName, [TrimmedName]) else if CheckForUniqueness and - (Database.Snippets.Find(TrimmedName, True) <> nil) then +// (Database.Snippets.Find(TrimmedName, True) <> nil) then + (Database.Snippets.Find(TrimmedName, TCollectionID.__TMP__DBCollectionID(True)) <> nil) then ErrorMsg := Format(sErrDupName, [TrimmedName]) else Result := True; diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 489d751a6..8ab42253a 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -469,7 +469,8 @@ class procedure TUserDBMgr.EditSnippet(const SnippetName: string); var Snippet: TSnippet; // reference to snippet to be edited begin - Snippet := Database.Snippets.Find(SnippetName, True); +// Snippet := Database.Snippets.Find(SnippetName, True); + Snippet := Database.Snippets.Find(SnippetName, TCollectionID.__TMP__DBCollectionID(True)); if not Assigned(Snippet) then raise EBug.Create(ClassName + '.EditSnippet: Snippet not in user database'); TSnippetsEditorDlg.EditSnippet(nil, Snippet); From 0b94722c73388cfc4230cf23e8f7b63298bff6b6 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 3 Nov 2024 15:00:23 +0000 Subject: [PATCH 024/222] Remove TSnippet's Boolean ctor overload The Boolean constructor took a UserDefined parameter. Modified TDatabase.CreateTempSnippet and TDatabase.InternalAddSnippet in DB.UMain to call the remaining TSnippet constructor that takes a TCollectionID parameter. __TMP__ methods were required to achieve changes to DB.UMain. Removed code was commented out. --- Src/DB.UMain.pas | 6 ++++-- Src/DB.USnippet.pas | 35 +++++++++++++++++------------------ 2 files changed, 21 insertions(+), 20 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 4c08911b6..4663c7dab 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -686,7 +686,8 @@ function TDatabase.CreateTempSnippet(const SnippetName: string; @return Reference to new snippet. } begin - Result := TTempSnippet.Create(SnippetName, True, Data.Props); +// Result := TTempSnippet.Create(SnippetName, True, Data.Props); + Result := TTempSnippet.Create(SnippetName, TCollectionID.__TMP__UserDBCollectionID, Data.Props); (Result as TTempSnippet).UpdateRefs(Data.Refs, fSnippets); end; @@ -923,7 +924,8 @@ function TDatabase.InternalAddSnippet(const SnippetName: string; sCatNotFound = 'Category "%0:s" referenced by new snippet named "%1:s" does ' + 'not exist'; begin - Result := TSnippetEx.Create(SnippetName, True, Data.Props); +// Result := TSnippetEx.Create(SnippetName, True, Data.Props); + Result := TSnippetEx.Create(SnippetName, TCollectionID.__TMP__UserDBCollectionID, Data.Props); (Result as TSnippetEx).UpdateRefs(Data.Refs, fSnippets); Cat := fCategories.Find(Result.Category); if not Assigned(Cat) then diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index abc058d98..0eacce540 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -152,13 +152,13 @@ type TDisplayNameComparer = class(TComparer) @return Required field content. } public - constructor Create(const Name: string; const UserDefined: Boolean; - const Props: TSnippetData); overload; {TODO -cCollections: remove constructor} - {Class contructor. Sets up snippet object with given property values. - @param Name [in] Name of snippet. - @param UserDefined [in] Indicates if this is a user defined snippet. - @param Props [in] Values of various snippet properties. - } +// constructor Create(const Name: string; const UserDefined: Boolean; +// const Props: TSnippetData); +// {Class contructor. Sets up snippet object with given property values. +// @param Name [in] Name of snippet. +// @param UserDefined [in] Indicates if this is a user defined snippet. +// @param Props [in] Values of various snippet properties. +// } /// Object constructor. Sets up snippet object with given property /// values belonging to a specified collection. @@ -169,7 +169,6 @@ type TDisplayNameComparer = class(TComparer) /// properties. constructor Create(const Name: string; const ACollectionID: TCollectionID; const Props: TSnippetData); - overload; {TODO -cCollections: remove overload;} destructor Destroy; override; {Destructor. Tears down object. @@ -456,16 +455,16 @@ function TSnippet.CanCompile: Boolean; Result := Kind <> skFreeform; end; -constructor TSnippet.Create(const Name: string; const UserDefined: Boolean; - const Props: TSnippetData); - {Class contructor. Sets up snippet object with given property values. - @param Name [in] Name of snippet. - @param UserDefined [in] Indicates if this is a user defined snippet. - @param Props [in] Values of various snippet properties. - } -begin - Create(Name, TCollectionID.__TMP__DBCollectionID(UserDefined), Props); -end; +//constructor TSnippet.Create(const Name: string; const UserDefined: Boolean; +// const Props: TSnippetData); +// {Class contructor. Sets up snippet object with given property values. +// @param Name [in] Name of snippet. +// @param UserDefined [in] Indicates if this is a user defined snippet. +// @param Props [in] Values of various snippet properties. +// } +//begin +// Create(Name, TCollectionID.__TMP__DBCollectionID(UserDefined), Props); +//end; constructor TSnippet.Create(const Name: string; const ACollectionID: TCollectionID; const Props: TSnippetData); From 5e21e4e6789d6915a7f228abe9ce467eea9a7130 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 3 Nov 2024 02:09:41 +0000 Subject: [PATCH 025/222] Replace TSnippetAction.UserDefined with CollectionID Added CollectionID property to TSnippetAction. Removed TSnippetAction.UserDefined property & modified code to use CollectionID instead. This enabled a __TMP__ method call to be removed. Removed code was commented out. --- Src/UNotifier.pas | 3 +-- Src/USnippetAction.pas | 19 ++++++++++++------- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index c0dcd22fa..913593762 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -271,8 +271,7 @@ procedure TNotifier.DisplaySnippet(const SnippetName: WideString; if Assigned(fDisplaySnippetAction) then begin (fDisplaySnippetAction as TSnippetAction).SnippetName := SnippetName; - (fDisplaySnippetAction as TSnippetAction).UserDefined := - ACollectionID <> TCollectionID.__TMP__MainDBCollectionID; + (fDisplaySnippetAction as TSnippetAction).CollectionID := ACollectionID; (fDisplaySnippetAction as TSnippetAction).NewTab := NewTab; fDisplaySnippetAction.Execute; end; diff --git a/Src/USnippetAction.pas b/Src/USnippetAction.pas index 80927a77d..9030c671b 100644 --- a/Src/USnippetAction.pas +++ b/Src/USnippetAction.pas @@ -19,6 +19,7 @@ interface // Delphi Classes, // Project + DB.UCollections, IntfNotifier; @@ -36,8 +37,10 @@ TSnippetAction = class(TBasicAction, ISetNotifier) var /// Value of SnippetName property. fSnippetName: string; - /// Value of UserDefined property. - fUserDefined: Boolean; +// /// Value of UserDefined property. +// fUserDefined: Boolean; + /// Value of CollectionID property. + fCollectionID: TCollectionID; /// Value of NewTab property. fNewTab: Boolean; /// Reference to Notifier object. @@ -58,9 +61,12 @@ TSnippetAction = class(TBasicAction, ISetNotifier) procedure SetNotifier(const Notifier: INotifier); /// Name of snippet to be displayed. property SnippetName: string read fSnippetName write fSnippetName; - /// Flag indicating whether snippet to be displayed is user - /// defined. - property UserDefined: Boolean read fUserDefined write fUserDefined; +// /// Flag indicating whether snippet to be displayed is user +// /// defined. +// property UserDefined: Boolean read fUserDefined write fUserDefined; + /// ID of the collection containing the snippet to be displayed. + /// + property CollectionID: TCollectionID read fCollectionID write fCollectionID; /// Flag indicating if snippet is to be displayed in new detail /// pane tab. property NewTab: Boolean read fNewTab write fNewTab; @@ -72,7 +78,6 @@ implementation uses // Project - DB.UCollections, DB.UMain, DB.USnippet, UView; @@ -87,7 +92,7 @@ function TSnippetAction.Execute: Boolean; Assert(Assigned(fNotifier), ClassName + '.Execute: Notifier not set'); Assert(SnippetName <> '', ClassName + '.Execute: SnippetName not provided'); // Snippet := Database.Snippets.Find(SnippetName, UserDefined); - Snippet := Database.Snippets.Find(SnippetName, TCollectionID.__TMP__DBCollectionID(UserDefined)); + Snippet := Database.Snippets.Find(SnippetName, fCollectionID); Assert(Assigned(Snippet), ClassName + '.Execute: SnippetName not valid'); // Create a view item for snippet and get notifier to display it fNotifier.ShowViewItem(TViewFactory.CreateSnippetView(Snippet), NewTab); From 8d19fdf3b0ab69ae6bdcfd5103c8757e399e9874 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 3 Nov 2024 03:27:22 +0000 Subject: [PATCH 026/222] Change IDBDataItemFactory to use collection IDs Both methods of IDBDataItemFactory, CreateCategory & CreateSnippet, were both changed to accept a TCollectionID parameters instead of Boolean UserDefind parameters. New implementations of the methods were created in TDBDataItemFactory. Revised TDatabaseLoader to use the revised IDBDataItemFactory methods. This change removed a __TMP__method call. Removed code was commented out. --- Src/DB.UDatabaseIO.pas | 8 +- Src/DB.UMain.pas | 178 ++++++++++++++++++++++++++++------------- 2 files changed, 128 insertions(+), 58 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index f93fba6b8..296ee75ef 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -353,7 +353,8 @@ procedure TDatabaseLoader.CreateCategory(const CatID: string; @param CatData [in] Properties of category. } begin - fCategories.Add(fFactory.CreateCategory(CatID, IsUserDatabase, CatData)); +// fCategories.Add(fFactory.CreateCategory(CatID, IsUserDatabase, CatData)); + fCategories.Add(fFactory.CreateCategory(CatID, CollectionID, CatData)); end; procedure TDatabaseLoader.HandleException(const E: Exception); @@ -503,8 +504,11 @@ procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); if not Assigned(Snippet) then begin fReader.GetSnippetProps(SnippetName, SnippetProps); +// Snippet := fFactory.CreateSnippet( +// SnippetName, IsUserDatabase, SnippetProps +// ); Snippet := fFactory.CreateSnippet( - SnippetName, IsUserDatabase, SnippetProps + SnippetName, CollectionID, SnippetProps ); fSnipList.Add(Snippet); end; diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 4663c7dab..3e792663d 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -18,10 +18,18 @@ interface uses // Delphi - Classes, Generics.Collections, + Classes, + Generics.Collections, // Project - ActiveText.UMain, Compilers.UGlobals, DB.UCategory, DB.USnippet, UContainers, - UIStringList, UMultiCastEvents, USnippetIDs; + ActiveText.UMain, + Compilers.UGlobals, + DB.UCategory, + DB.UCollections, + DB.USnippet, + UContainers, + UIStringList, + UMultiCastEvents, + USnippetIDs; type @@ -105,23 +113,46 @@ interface } IDBDataItemFactory = interface(IInterface) ['{C6DD85BD-E649-4A90-961C-4011D2714B3E}'] - function CreateCategory(const CatID: string; const UserDefined: Boolean; - const Data: TCategoryData): TCategory; - {Creates a new category object. - @param CatID [in] ID of new category. Must be unique. - @param UserDefined [in] True if category is user defined, False if not. - @param Data [in] Record describing category's properties. - @return Instance of new category object. - } - function CreateSnippet(const Name: string; const UserDefined: Boolean; - const Props: TSnippetData): TSnippet; - {Creates a new snippet object. - @param Name [in] Name of new snippet. Must not exist in database - specified by UserDefined parameter. - @param UserDefined [in] True if snippet is user defined, False if not. - @param Props [in] Record describing snippet's properties. - @return Instance of new snippet with no references. - } +// function CreateCategory(const CatID: string; const UserDefined: Boolean; +// const Data: TCategoryData): TCategory; +// {Creates a new category object. +// @param CatID [in] ID of new category. Must be unique. +// @param UserDefined [in] True if category is user defined, False if not. +// @param Data [in] Record describing category's properties. +// @return Instance of new category object. +// } +// function CreateSnippet(const Name: string; const UserDefined: Boolean; +// const Props: TSnippetData): TSnippet; +// {Creates a new snippet object. +// @param Name [in] Name of new snippet. Must not exist in database +// specified by UserDefined parameter. +// @param UserDefined [in] True if snippet is user defined, False if not. +// @param Props [in] Record describing snippet's properties. +// @return Instance of new snippet with no references. +// } + + /// Creates a new category object. + /// string [in] ID of new category. Must be + /// unique. + /// TCollectionID [in] Collection with + /// which the category is associated. + /// TCategoryData [in] Record describing + /// category's properties. + /// TCategory. Instance of new category object. + function CreateCategory(const CatID: string; + const ACollectionID: TCollectionID; const Data: TCategoryData): TCategory; + + /// Creates a new snippet object. + /// string [in] Name of new snippet. Must not + /// exist in database + /// TCollectionID [in] Collection + /// containing the snippet. + /// TSnippetData [in] Record describing + /// snippet's properties. + /// Instance of new snippet with no references. + function CreateSnippet(const Name: string; + const ACollectionID: TCollectionID; const Props: TSnippetData): TSnippet; + end; { @@ -270,9 +301,9 @@ implementation uses // Delphi - SysUtils, Generics.Defaults, + SysUtils, + Generics.Defaults, // Project - DB.UCollections, DB.UDatabaseIO, IntfCommon, UExceptions, @@ -293,23 +324,46 @@ implementation } TDBDataItemFactory = class(TInterfacedObject, IDBDataItemFactory) public - function CreateCategory(const CatID: string; const UserDefined: Boolean; - const Data: TCategoryData): TCategory; - {Creates a new category object. - @param CatID [in] ID of new category. Must be unique. - @param UserDefined [in] True if category is user defined, False if not. - @param Data [in] Record describing category's properties. - @return Instance of new category object. - } - function CreateSnippet(const Name: string; const UserDefined: Boolean; - const Props: TSnippetData): TSnippet; - {Creates a new snippet object. - @param Name [in] Name of new snippet. Must not exist in database - specified by UserDefined parameter. - @param UserDefined [in] True if snippet is user defined, False if not. - @param Props [in] Record describing snippet's properties. - @return Instance of new snippet with no references. - } +// function CreateCategory(const CatID: string; const UserDefined: Boolean; +// const Data: TCategoryData): TCategory; +// {Creates a new category object. +// @param CatID [in] ID of new category. Must be unique. +// @param UserDefined [in] True if category is user defined, False if not. +// @param Data [in] Record describing category's properties. +// @return Instance of new category object. +// } +// function CreateSnippet(const Name: string; const UserDefined: Boolean; +// const Props: TSnippetData): TSnippet; +// {Creates a new snippet object. +// @param Name [in] Name of new snippet. Must not exist in database +// specified by UserDefined parameter. +// @param UserDefined [in] True if snippet is user defined, False if not. +// @param Props [in] Record describing snippet's properties. +// @return Instance of new snippet with no references. +// } + + /// Creates a new category object. + /// string [in] ID of new category. Must be + /// unique. + /// TCollectionID [in] Collection with + /// which the category is associated. + /// TCategoryData [in] Record describing + /// category's properties. + /// TCategory. Instance of new category object. + function CreateCategory(const CatID: string; + const ACollectionID: TCollectionID; const Data: TCategoryData): TCategory; + + /// Creates a new snippet object. + /// string [in] Name of new snippet. Must not + /// exist in database + /// TCollectionID [in] Collection + /// containing the snippet. + /// TSnippetData [in] Record describing + /// snippet's properties. + /// Instance of new snippet with no references. + function CreateSnippet(const Name: string; + const ACollectionID: TCollectionID; const Props: TSnippetData): TSnippet; + end; { @@ -1163,29 +1217,41 @@ function TDatabase.TEventInfo.GetKind: TDatabaseChangeEventKind; { TDBDataItemFactory } +//function TDBDataItemFactory.CreateCategory(const CatID: string; +// const UserDefined: Boolean; const Data: TCategoryData): TCategory; +// {Creates a new category object. +// @param CatID [in] ID of new category. Must be unique. +// @param UserDefined [in] True if category is user defined, False if not. +// @param Data [in] Record describing category's properties. +// @return Instance of new category object. +// } +//begin +// Result := TCategoryEx.Create(CatID, TCollectionID.__TMP__DBCollectionID(UserDefined), Data); +//end; +// +//function TDBDataItemFactory.CreateSnippet(const Name: string; +// const UserDefined: Boolean; const Props: TSnippetData): TSnippet; +// {Creates a new snippet object. +// @param Name [in] Name of new snippet. Must not exist in database specified +// by UserDefined parameter. +// @param UserDefined [in] True if snippet is user defined, False if not. +// @param Props [in] Record describing snippet's properties. +// @return Instance of new snippet with no references. +// } +//begin +// Result := TSnippetEx.Create(Name, UserDefined, Props); +//end; + function TDBDataItemFactory.CreateCategory(const CatID: string; - const UserDefined: Boolean; const Data: TCategoryData): TCategory; - {Creates a new category object. - @param CatID [in] ID of new category. Must be unique. - @param UserDefined [in] True if category is user defined, False if not. - @param Data [in] Record describing category's properties. - @return Instance of new category object. - } + const ACollectionID: TCollectionID; const Data: TCategoryData): TCategory; begin - Result := TCategoryEx.Create(CatID, TCollectionID.__TMP__DBCollectionID(UserDefined), Data); + Result := TCategoryEx.Create(CatID, ACollectionID, Data); end; function TDBDataItemFactory.CreateSnippet(const Name: string; - const UserDefined: Boolean; const Props: TSnippetData): TSnippet; - {Creates a new snippet object. - @param Name [in] Name of new snippet. Must not exist in database specified - by UserDefined parameter. - @param UserDefined [in] True if snippet is user defined, False if not. - @param Props [in] Record describing snippet's properties. - @return Instance of new snippet with no references. - } + const ACollectionID: TCollectionID; const Props: TSnippetData): TSnippet; begin - Result := TSnippetEx.Create(Name, UserDefined, Props); + Result := TSnippetEx.Create(Name, ACollectionID, Props); end; { TUserDataProvider } From baca296064a15245035aeb3fa11891a15048ad83 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 1 Nov 2024 10:13:26 +0000 Subject: [PATCH 027/222] Remove IView.IsUserDefined method IView.IsUserDefined was removed along with all its implementations. The only place that IView.IsUserDefined was used was in FrOverview.TOverviewFrame.TTVDraw.IsUserDefinedNode. This method was modified to retrieve any collection ID associated with any snippet or category view and to calculate its result using those, removing any need for IView to provide a IsUserDefined method. A __TMP__ method was required in the modified TTVDraw.IsUserDefinedNode method. Removed code was commented out. --- Src/FrOverview.pas | 22 ++++++++++--- Src/UView.pas | 78 ++++++++++++++++++++++++---------------------- 2 files changed, 59 insertions(+), 41 deletions(-) diff --git a/Src/FrOverview.pas b/Src/FrOverview.pas index e668c3007..575975387 100644 --- a/Src/FrOverview.pas +++ b/Src/FrOverview.pas @@ -235,9 +235,12 @@ implementation uses // Delphi + SysUtils, Messages, // Project - UKeysHelper, UOverviewTreeBuilder; + DB.UCollections, + UKeysHelper, + UOverviewTreeBuilder; {$R *.dfm} @@ -976,11 +979,22 @@ function TOverviewFrame.TTVDraw.IsUserDefinedNode( @return True if node represents user defined object, False if not. } var - ViewItem: IView; // view item represented by node + ViewItem: IView; // view item represented by node + SnippetView: ISnippetView; // view item if node represents a snippet + CategoryView: ICategoryView; // view item if node represents a category + CollectionID: TCollectionID; // ID of collection node item belongs to, if any begin - ViewItem := (Node as TViewItemTreeNode).ViewItem; // TODO -cBug: Exception reported as issue #70 seems to be triggered here - Result := ViewItem.IsUserDefined; + ViewItem := (Node as TViewItemTreeNode).ViewItem; +// Result := ViewItem.IsUserDefined; + if Supports(ViewItem, ISnippetView, SnippetView) then + CollectionID := SnippetView.Snippet.CollectionID + else if Supports(ViewItem, ICategoryView, CategoryView) then + CollectionID := CategoryView.Category.CollectionID + else + CollectionID := TCollectionID.CreateNull; + Result := (CollectionID <> TCollectionID.__TMP__MainDBCollectionID) + and not CollectionID.IsNull; end; end. diff --git a/Src/UView.pas b/Src/UView.pas index b3425318a..db192a255 100644 --- a/Src/UView.pas +++ b/Src/UView.pas @@ -20,7 +20,11 @@ interface // Delphi Generics.Collections, // Project - DB.UCategory, DB.USnippet, DB.USnippetKind, UBaseObjects, UInitialLetter; + DB.UCategory, + DB.USnippet, + DB.USnippetKind, + UBaseObjects, + UInitialLetter; type @@ -56,8 +60,8 @@ interface /// without having have an instance of any object wrapped by the view. /// function GetKey: IViewKey; - /// Checks if view is user-defined. - function IsUserDefined: Boolean; +// /// Checks if view is user-defined. +// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// A grouping is a view that groups views together. /// @@ -230,9 +234,9 @@ TKey = class(TInterfacedObject, IViewKey) /// Gets object containing view's unique key. /// Method of IView. function GetKey: IViewKey; - /// Checks if view is user-defined. - /// Method of IView. - function IsUserDefined: Boolean; +// /// Checks if view is user-defined. +// /// Method of IView. +// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// Method of IView. function IsGrouping: Boolean; @@ -320,8 +324,8 @@ TKey = class(TInterfacedObject, IViewKey) /// Gets object containing view's unique key. /// Method of IView. function GetKey: IViewKey; - /// Checks if view is user-defined. - function IsUserDefined: Boolean; +// /// Checks if view is user-defined. +// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// Method of IView. function IsGrouping: Boolean; @@ -367,9 +371,9 @@ TKey = class(TInterfacedObject, IViewKey) /// Gets object containing view's unique key. /// Method of IView. function GetKey: IViewKey; - /// Checks if view is user-defined. - /// Method of IView. - function IsUserDefined: Boolean; +// /// Checks if view is user-defined. +// /// Method of IView. +// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// Method of IView. function IsGrouping: Boolean; @@ -417,9 +421,9 @@ TKey = class(TInterfacedObject, IViewKey) /// Gets object containing view's unique key. /// Method of IView. function GetKey: IViewKey; - /// Checks if view is user-defined. - /// Method of IView. - function IsUserDefined: Boolean; +// /// Checks if view is user-defined. +// /// Method of IView. +// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// Method of IView. function IsGrouping: Boolean; @@ -467,9 +471,9 @@ TKey = class(TInterfacedObject, IViewKey) /// Gets object containing view's unique key. /// Method of IView. function GetKey: IViewKey; - /// Checks if view is user-defined. - /// Method of IView. - function IsUserDefined: Boolean; +// /// Checks if view is user-defined. +// /// Method of IView. +// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// Method of IView. function IsGrouping: Boolean; @@ -495,10 +499,10 @@ function TSimpleView.IsGrouping: Boolean; Result := False; end; -function TSimpleView.IsUserDefined: Boolean; -begin - Result := False; -end; +//function TSimpleView.IsUserDefined: Boolean; +//begin +// Result := False; +//end; { TSimpleView.TKey } @@ -586,10 +590,10 @@ function TSnippetView.IsGrouping: Boolean; Result := False; end; -function TSnippetView.IsUserDefined: Boolean; -begin - Result := GetSnippet.UserDefined; -end; +//function TSnippetView.IsUserDefined: Boolean; +//begin +// Result := GetSnippet.UserDefined; +//end; { TSnippetView.TKey } @@ -645,10 +649,10 @@ function TCategoryView.IsGrouping: Boolean; Result := True; end; -function TCategoryView.IsUserDefined: Boolean; -begin - Result := GetCategory.UserDefined; -end; +//function TCategoryView.IsUserDefined: Boolean; +//begin +// Result := GetCategory.UserDefined; +//end; { TCategoryView.TKey } @@ -702,10 +706,10 @@ function TSnippetKindView.IsGrouping: Boolean; Result := True; end; -function TSnippetKindView.IsUserDefined: Boolean; -begin - Result := False; -end; +//function TSnippetKindView.IsUserDefined: Boolean; +//begin +// Result := False; +//end; { TSnippetKindView.TKey } @@ -759,10 +763,10 @@ function TInitialLetterView.IsGrouping: Boolean; Result := True; end; -function TInitialLetterView.IsUserDefined: Boolean; -begin - Result := False; -end; +//function TInitialLetterView.IsUserDefined: Boolean; +//begin +// Result := False; +//end; { TInitialLetterView.TKey } From f946baeb4109cccf709891b42f9ba4de81e6e14b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 3 Nov 2024 13:21:02 +0000 Subject: [PATCH 028/222] Change interface used to set collection colour prefs Changed IPreferences and its implementation to remove DBHeadingColours[] property & getter and setter that took Boolean (user-defined) parameter and to replace with new Getter & Setter methods that work with collections IDS. Made similar changes re DBHeadingCustomColours[] property & getter and setter. The new setter and getter methods for both above still access the existing fDBHeadingColours[] and fDBHeadingCustomColours[] fields which remain array[Boolean] types, which must be changed to support a variable number of collections. Updated TPreferencesPersist to use the new TCollectionID version of the getters and setter methods, while retaining the CodeSnip 4 setting keys (something else that needs changing when moving to a variable number of collections). Made changes to all code that uses the removed properties to work with the new getters and setters. Several __TMP__ method calls were required to make this work, although a few were able to be removed. Introduced new __TMP__ method within UPreferences to map collection IDs to the colour preferences for the CodeSnip 4 main and user databases. Removed code was commented out. --- Src/FmDependenciesDlg.pas | 3 +- Src/FmFavouritesDlg.pas | 6 +- Src/FmFindXRefsDlg.pas | 2 +- Src/FmTestCompileDlg.pas | 2 +- Src/FrDetailView.pas | 12 +- Src/FrDisplayPrefs.pas | 29 +++- Src/UPreferences.pas | 291 +++++++++++++++++++++++++++--------- Src/URTFCategoryDoc.pas | 14 +- Src/URTFSnippetDoc.pas | 11 +- Src/USnippetsChkListMgr.pas | 10 +- Src/USnippetsTVDraw.pas | 7 +- 11 files changed, 286 insertions(+), 101 deletions(-) diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index ddc25ee40..abc91e9db 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -414,7 +414,8 @@ procedure TDependenciesDlg.lbDependentsDrawItem(Control: TWinControl; LB := Control as TListBox; Canvas := LB.Canvas; if not (odSelected in State) then - Canvas.Font.Color := Preferences.DBHeadingColours[IsUserDefinedItem]; +// Canvas.Font.Color := Preferences.DBHeadingColours[IsUserDefinedItem]; + Canvas.Font.Color := Preferences.GetDBHeadingColour(TCollectionID.__TMP__DBCollectionID(IsUserDefinedItem)); Canvas.TextRect( Rect, Rect.Left + 2, diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index ac2b4f936..0a6af9efc 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -582,12 +582,12 @@ procedure TFavouritesDlg.LVCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); var // UserDefined: Boolean; - IsMainDB: Boolean; + CollectionID: TCollectionID; begin // UserDefined := (Item as TFavouriteListItem).Favourite.SnippetID.UserDefined; // fLVFavs.Canvas.Font.Color := Preferences.DBHeadingColours[UserDefined]; - IsMainDB := (Item as TFavouriteListItem).Favourite.SnippetID.CollectionID = TCollectionID.__TMP__MainDBCollectionID; - fLVFavs.Canvas.Font.Color := Preferences.DBHeadingColours[not IsMainDB]; + CollectionID := (Item as TFavouriteListItem).Favourite.SnippetID.CollectionID; + fLVFavs.Canvas.Font.Color := Preferences.GetDBHeadingColour(CollectionID); end; procedure TFavouritesDlg.LVCustomDrawSubItem(Sender: TCustomListView; diff --git a/Src/FmFindXRefsDlg.pas b/Src/FmFindXRefsDlg.pas index 45e280e72..a2f406629 100644 --- a/Src/FmFindXRefsDlg.pas +++ b/Src/FmFindXRefsDlg.pas @@ -236,7 +236,7 @@ procedure TFindXRefsDlg.ConfigForm; lblSnippetName.Font.Style := [fsBold]; lblSnippetName.Font.Color := // Preferences.DBHeadingColours[fSnippet.UserDefined]; - Preferences.DBHeadingColours[fSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]; + Preferences.GetDBHeadingColour(fSnippet.CollectionID); // Display selected snippet name in appropriate controls lblSnippetName.Caption := fSnippet.DisplayName; chkIncludeSnippet.Caption := Format( diff --git a/Src/FmTestCompileDlg.pas b/Src/FmTestCompileDlg.pas index 0ed1ba053..08be15372 100644 --- a/Src/FmTestCompileDlg.pas +++ b/Src/FmTestCompileDlg.pas @@ -290,7 +290,7 @@ procedure TTestCompileDlg.ConfigForm; TFontHelper.SetDefaultBaseFont(lblSnippetName.Font); lblSnippetName.Font.Color := // Preferences.DBHeadingColours[fSnippet.UserDefined]; - Preferences.DBHeadingColours[fSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]; + Preferences.GetDBHeadingColour(fSnippet.CollectionID); lblSnippetName.Caption := fSnippet.DisplayName; end; diff --git a/Src/FrDetailView.pas b/Src/FrDetailView.pas index 8aa41a592..1e93d52b3 100644 --- a/Src/FrDetailView.pas +++ b/Src/FrDetailView.pas @@ -109,7 +109,9 @@ implementation // Delphi SysUtils, Graphics, Menus, Math, // Project - ActiveText.UHTMLRenderer, Browser.UHighlighter, Hiliter.UAttrs, Hiliter.UCSS, + ActiveText.UHTMLRenderer, Browser.UHighlighter, + DB.UCollections, + Hiliter.UAttrs, Hiliter.UCSS, Hiliter.UGlobals, UColours, UCSSUtils, UFontHelper, UPreferences, UQuery, USystemInfo, UUtils, UWBCommandBars; @@ -226,10 +228,14 @@ procedure TDetailViewFrame.BuildCSS(const CSSBuilder: TCSSBuilder); .AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); // Heading colours for user & main databases +// CSSBuilder.AddSelector('.userdb') +// .AddProperty(TCSS.ColorProp(Preferences.DBHeadingColours[True])); +// CSSBuilder.AddSelector('.maindb') +// .AddProperty(TCSS.ColorProp(Preferences.DBHeadingColours[False])); CSSBuilder.AddSelector('.userdb') - .AddProperty(TCSS.ColorProp(Preferences.DBHeadingColours[True])); + .AddProperty(TCSS.ColorProp(Preferences.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID))); CSSBuilder.AddSelector('.maindb') - .AddProperty(TCSS.ColorProp(Preferences.DBHeadingColours[False])); + .AddProperty(TCSS.ColorProp(Preferences.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID))); // Sets CSS for style of New Tab text CSSFont.Assign(ContentFont); diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index 015d1ea02..a540d9e93 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -107,6 +107,7 @@ implementation // Delphi SysUtils, Math, Graphics, ExtCtrls, // Project + DB.UCollections, FmPreferencesDlg, UColours, UCtrlArranger, UFontHelper, UGraphicUtils, UMessageBox; @@ -133,11 +134,15 @@ procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences; chkHideEmptySections.Checked := not Prefs.ShowEmptySections; chkHideEmptySections.OnClick := chkHideEmptySectionsClick; chkSnippetsInNewTab.Checked := Prefs.ShowNewSnippetsInNewTabs; - fMainColourBox.Selected := Prefs.DBHeadingColours[False]; - fUserColourBox.Selected := Prefs.DBHeadingColours[True]; +// fMainColourBox.Selected := Prefs.DBHeadingColours[False]; +// fUserColourBox.Selected := Prefs.DBHeadingColours[True]; + fMainColourBox.Selected := Prefs.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID); + fUserColourBox.Selected := Prefs.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID); fSourceBGColourBox.Selected := Prefs.SourceCodeBGcolour; - Prefs.DBHeadingCustomColours[False].CopyTo(fMainColourDlg.CustomColors, True); - Prefs.DBHeadingCustomColours[True].CopyTo(fUserColourDlg.CustomColors, True); +// Prefs.DBHeadingCustomColours[False].CopyTo(fMainColourDlg.CustomColors, True); +// Prefs.DBHeadingCustomColours[True].CopyTo(fUserColourDlg.CustomColors, True); + Prefs.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID).CopyTo(fMainColourDlg.CustomColors, True); + Prefs.GetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID).CopyTo(fUserColourDlg.CustomColors, True); Prefs.SourceCodeBGCustomColours.CopyTo(fSourceBGColourDlg.CustomColors, True); cbOverviewFontSize.Tag := Prefs.OverviewFontSize; // store font size in .Tag cbOverviewFontSize.Text := IntToStr(Prefs.OverviewFontSize); @@ -294,13 +299,21 @@ procedure TDisplayPrefsFrame.Deactivate(const Prefs: IPreferences); Prefs.OverviewStartState := TOverviewStartState( cbOverviewTree.Items.Objects[cbOverviewTree.ItemIndex] ); - Prefs.DBHeadingColours[False] := fMainColourBox.Selected; - Prefs.DBHeadingColours[True] := fUserColourBox.Selected; +// Prefs.DBHeadingColours[False] := fMainColourBox.Selected; +// Prefs.DBHeadingColours[True] := fUserColourBox.Selected; + Prefs.SetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID, fMainColourBox.Selected); + Prefs.SetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID, fUserColourBox.Selected); Prefs.SourceCodeBGcolour := fSourceBGColourBox.Selected; - Prefs.DBHeadingCustomColours[False].CopyFrom( +// Prefs.DBHeadingCustomColours[False].CopyFrom( +// fMainColourDlg.CustomColors, True +// ); +// Prefs.DBHeadingCustomColours[True].CopyFrom( +// fUserColourDlg.CustomColors, True +// ); + Prefs.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID).CopyFrom( fMainColourDlg.CustomColors, True ); - Prefs.DBHeadingCustomColours[True].CopyFrom( + Prefs.GetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID).CopyFrom( fUserColourDlg.CustomColors, True ); Prefs.SourceCodeBGCustomColours.CopyFrom( diff --git a/Src/UPreferences.pas b/Src/UPreferences.pas index 26a412804..3d3d17632 100644 --- a/Src/UPreferences.pas +++ b/Src/UPreferences.pas @@ -19,6 +19,7 @@ interface // Delphi Graphics, // Project + DB.UCollections, Hiliter.UGlobals, UIStringList, UMeasurement, UPrintInfo, USnippetPageStructure, USourceFileInfo, USourceGen, UWarnings; @@ -136,44 +137,74 @@ interface property ShowNewSnippetsInNewTabs: Boolean read GetShowNewSnippetsInNewTabs write SetShowNewSnippetsInNewTabs; +// /// Gets heading colour used for snippets from a specified +// /// database. +// /// Boolean [in] Required database: True for user +// /// database and False for inline database. +// /// TColor. Required colour. +// function GetDBHeadingColour(UserDefined: Boolean): TColor; +// /// Sets heading colour used for snippets from a specified +// /// database. +// /// Boolean [in] Required database: True for user +// /// database and False for online database. +// /// TColor [in] Required heading colour. +// procedure SetDBHeadingColour(UserDefined: Boolean; +// const Value: TColor); +// /// Records colour to be used for headings of items from either +// /// online database (UserDefined = False) or user database (UserDefined = +// /// True). +// property DBHeadingColours[UserDefined: Boolean]: TColor +// read GetDBHeadingColour write SetDBHeadingColour; + /// Gets heading colour used for snippets from a specified - /// database. - /// Boolean [in] Required database: True for user - /// database and False for inline database. + /// collection. + /// TCollectionID [in] ID of required + /// collection. /// TColor. Required colour. - function GetDBHeadingColour(UserDefined: Boolean): TColor; + function GetDBHeadingColour(const ACollectionID: TCollectionID): TColor; /// Sets heading colour used for snippets from a specified - /// database. - /// Boolean [in] Required database: True for user - /// database and False for online database. - /// TColor [in] Required heading colour. - procedure SetDBHeadingColour(UserDefined: Boolean; + /// collection. + /// TCollectionID [in] ID of required + /// collection. + /// TColor. Required colour. + procedure SetDBHeadingColour(const ACollectionID: TCollectionID; const Value: TColor); - /// Records colour to be used for headings of items from either - /// online database (UserDefined = False) or user database (UserDefined = - /// True). - property DBHeadingColours[UserDefined: Boolean]: TColor - read GetDBHeadingColour write SetDBHeadingColour; + +// /// Gets custom colours available for headings for specified +// /// database. +// /// Boolean [in] Required database: True for user +// /// database and False for online database. +// /// IStringList. String list containing custom colours. +// function GetDBHeadingCustomColours(UserDefined: Boolean): IStringList; +// /// Sets custom colours available for headings for specified +// /// database. +// /// Boolean [in] Required database: True for user +// /// database and False for online database. +// /// IStringList [in] String list containing custom +// /// colours. +// procedure SetDBHeadingCustomColours(UserDefined: Boolean; +// Value: IStringList); +// /// Records custom colours available for headings of items from +// /// either online database (UserDefined = False) or user database +// /// (UserDefined = True). +// property DBHeadingCustomColours[UserDefined: Boolean]: IStringList +// read GetDBHeadingCustomColours write SetDBHeadingCustomColours; /// Gets custom colours available for headings for specified - /// database. - /// Boolean [in] Required database: True for user - /// database and False for online database. + /// collection. + /// TCollectionID [in] ID of required + /// collection. /// IStringList. String list containing custom colours. - function GetDBHeadingCustomColours(UserDefined: Boolean): IStringList; + function GetDBHeadingCustomColours(const ACollectionID: TCollectionID): + IStringList; /// Sets custom colours available for headings for specified - /// database. - /// Boolean [in] Required database: True for user - /// database and False for online database. + /// collection. + /// TCollectionID [in] ID of required + /// collection. /// IStringList [in] String list containing custom /// colours. - procedure SetDBHeadingCustomColours(UserDefined: Boolean; + procedure SetDBHeadingCustomColours(const ACollectionID: TCollectionID; Value: IStringList); - /// Records custom colours available for headings of items from - /// either online database (UserDefined = False) or user database - /// (UserDefined = True). - property DBHeadingCustomColours[UserDefined: Boolean]: IStringList - read GetDBHeadingCustomColours write SetDBHeadingCustomColours; /// Gets size of font used in overview pane tree view. function GetOverviewFontSize: Integer; @@ -340,13 +371,17 @@ TPreferences = class(TInterfacedObject, /// in new tabs in details pane. fShowNewSnippetsInNewTabs: Boolean; /// Records colour to be used for headings of items from either - /// online database (UserDefined = False) or user database (UserDefined = - /// True). + /// main (False) or user (True) collections. fDBHeadingColours: array[Boolean] of TColor; + {TODO -cCollections: WARNING. The fDBHeadingColours field only supports + the two original main & user collections. This MUST be changed + once more than two snippet collections are supported} /// Records custom colours available for headings of items from - /// either online database (UserDefined = False) or user database - /// (UserDefined = True). + /// either main (False) or user (True) collections. fDBHeadingCustomColours: array[Boolean] of IStringList; + {TODO -cCollections: WARNING. The fDBHeadingCustomColours field only + supports the two original main & user collections. This MUST be + changed once more than two snippet collections are supported} /// Records size of font used in overview pane tree view. /// fOverviewFontSize: Integer; @@ -381,6 +416,9 @@ TPreferences = class(TInterfacedObject, function DefaultOverviewFontSize: Integer; /// Returns default font size for details pane. function DefaultDetailFontSize: Integer; + + function __TMP__UseUserDBHeadingColour(const ACollectionID: TCollectionID): + Boolean; public /// Constructs a new object instance. constructor Create; @@ -482,39 +520,75 @@ TPreferences = class(TInterfacedObject, /// Method of IPreferences. procedure SetShowNewSnippetsInNewTabs(const Value: Boolean); +// /// Gets heading colour used for snippets from a specified +// /// database. +// /// Boolean [in] Required database: True for user +// /// database and False for inline database. +// /// TColor. Required colour. +// /// Method of IPreferences. +// function GetDBHeadingColour(UserDefined: Boolean): TColor; + /// Gets heading colour used for snippets from a specified - /// database. - /// Boolean [in] Required database: True for user - /// database and False for inline database. + /// collection. + /// TCollectionID [in] ID of required + /// collection. /// TColor. Required colour. /// Method of IPreferences. - function GetDBHeadingColour(UserDefined: Boolean): TColor; + function GetDBHeadingColour(const ACollectionID: TCollectionID): TColor; + +// /// Sets heading colour used for snippets from a specified +// /// database. +// /// Boolean [in] Required database: True for user +// /// database and False for online database. +// /// TColor [in] Required heading colour. +// /// Method of IPreferences. +// procedure SetDBHeadingColour(UserDefined: Boolean; +// const Value: TColor); /// Sets heading colour used for snippets from a specified - /// database. - /// Boolean [in] Required database: True for user - /// database and False for online database. - /// TColor [in] Required heading colour. + /// collection. + /// TCollectionID [in] ID of required + /// collection. + /// TColor. Required colour. /// Method of IPreferences. - procedure SetDBHeadingColour(UserDefined: Boolean; + procedure SetDBHeadingColour(const ACollectionID: TCollectionID; const Value: TColor); +// /// Gets custom colours available for headings for specified +// /// database. +// /// Boolean [in] Required database: True for user +// /// database and False for online database. +// /// IStringList. String list containing custom colours. +// /// Method of IPreferences. +// function GetDBHeadingCustomColours(UserDefined: Boolean): IStringList; + /// Gets custom colours available for headings for specified - /// database. - /// Boolean [in] Required database: True for user - /// database and False for online database. + /// collection. + /// TCollectionID [in] ID of required + /// collection. /// IStringList. String list containing custom colours. /// Method of IPreferences. - function GetDBHeadingCustomColours(UserDefined: Boolean): IStringList; + function GetDBHeadingCustomColours(const ACollectionID: TCollectionID): + IStringList; + +// /// Sets custom colours available for headings for specified +// /// database. +// /// Boolean [in] Required database: True for user +// /// database and False for online database. +// /// IStringList [in] String list containing custom +// /// colours. +// /// Method of IPreferences. +// procedure SetDBHeadingCustomColours(UserDefined: Boolean; +// Value: IStringList); /// Sets custom colours available for headings for specified - /// database. - /// Boolean [in] Required database: True for user - /// database and False for online database. + /// collection. + /// TCollectionID [in] ID of required + /// collection. /// IStringList [in] String list containing custom /// colours. /// Method of IPreferences. - procedure SetDBHeadingCustomColours(UserDefined: Boolean; + procedure SetDBHeadingCustomColours(const ACollectionID: TCollectionID; Value: IStringList); /// Gets size of font used in overview pane tree view. @@ -695,10 +769,14 @@ procedure TPreferences.Assign(const Src: IInterface); Self.fOverviewStartState := SrcPref.OverviewStartState; Self.fShowEmptySections := SrcPref.ShowEmptySections; Self.fShowNewSnippetsInNewTabs := SrcPref.ShowNewSnippetsInNewTabs; - Self.fDBHeadingColours[False] := SrcPref.DBHeadingColours[False]; - Self.fDBHeadingCustomColours[False] := SrcPref.DBHeadingCustomColours[False]; - Self.fDBHeadingColours[True] := SrcPref.DBHeadingColours[True]; - Self.fDBHeadingCustomColours[True] := SrcPref.DBHeadingCustomColours[True]; +// Self.fDBHeadingColours[False] := SrcPref.DBHeadingColours[False]; + Self.SetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID, SrcPref.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); +// Self.fDBHeadingCustomColours[False] := SrcPref.DBHeadingCustomColours[False]; + Self.SetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID, SrcPref.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID)); +// Self.fDBHeadingColours[True] := SrcPref.DBHeadingColours[True]; + Self.SetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID, SrcPref.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); +// Self.fDBHeadingCustomColours[True] := SrcPref.DBHeadingCustomColours[True]; + Self.SetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID, SrcPref.GetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID)); Self.fOverviewFontSize := SrcPref.OverviewFontSize; Self.fDetailFontSize := SrcPref.DetailFontSize; Self.fSourceCodeBGColour := SrcPref.SourceCodeBGColour; @@ -746,17 +824,39 @@ function TPreferences.GetCustomHiliteColours: IStringList; Result := fHiliteCustomColours; end; -function TPreferences.GetDBHeadingColour(UserDefined: Boolean): TColor; +//function TPreferences.GetDBHeadingColour(UserDefined: Boolean): TColor; +//begin +// Result := fDBHeadingColours[UserDefined]; +//end; + +function TPreferences.GetDBHeadingColour( + const ACollectionID: TCollectionID): TColor; begin - Result := fDBHeadingColours[UserDefined]; + {TODO -cCollections: WARNING: This implementation of GetDBHeadingColour only + supports the old main and user collections. It will break when further + collections are added. + } + Result := fDBHeadingColours[__TMP__UseUserDBHeadingColour(ACollectionID)]; end; function TPreferences.GetDBHeadingCustomColours( - UserDefined: Boolean): IStringList; + const ACollectionID: TCollectionID): IStringList; begin - Result := fDBHeadingCustomColours[UserDefined]; + {TODO -cCollections: WARNING: This implementation of GetDBHeadingCustomColours + only supports the old main and user collections. It will break when + further collections are added. + } + Result := fDBHeadingCustomColours[ + __TMP__UseUserDBHeadingColour(ACollectionID) + ]; end; +//function TPreferences.GetDBHeadingCustomColours( +// UserDefined: Boolean): IStringList; +//begin +// Result := fDBHeadingCustomColours[UserDefined]; +//end; + function TPreferences.GetDetailFontSize: Integer; begin Result := fDetailFontSize; @@ -857,18 +957,40 @@ procedure TPreferences.SetCustomHiliteColours(const Colours: IStringList); fHiliteCustomColours := Colours; end; -procedure TPreferences.SetDBHeadingColour(UserDefined: Boolean; +//procedure TPreferences.SetDBHeadingColour(UserDefined: Boolean; +// const Value: TColor); +//begin +// fDBHeadingColours[UserDefined] := Value; +//end; + +procedure TPreferences.SetDBHeadingColour(const ACollectionID: TCollectionID; const Value: TColor); begin - fDBHeadingColours[UserDefined] := Value; + {TODO -cCollections: WARNING: This implementation of SetDBHeadingColour only + supports the old main and user collections. It will break when further + collections are added. + } + fDBHeadingColours[__TMP__UseUserDBHeadingColour(ACollectionID)] := Value; end; -procedure TPreferences.SetDBHeadingCustomColours(UserDefined: Boolean; - Value: IStringList); +procedure TPreferences.SetDBHeadingCustomColours( + const ACollectionID: TCollectionID; Value: IStringList); begin - fDBHeadingCustomColours[UserDefined] := Value; + {TODO -cCollections: WARNING: This implementation of SetDBHeadingCustomColours + only supports the old main and user collections. It will break when + further collections are added. + } + fDBHeadingCustomColours[ + __TMP__UseUserDBHeadingColour(ACollectionID) + ] := Value; end; +//procedure TPreferences.SetDBHeadingCustomColours(UserDefined: Boolean; +// Value: IStringList); +//begin +// fDBHeadingCustomColours[UserDefined] := Value; +//end; + procedure TPreferences.SetDetailFontSize(const Value: Integer); begin if TFontHelper.IsInCommonFontSizeRange(Value) then @@ -971,6 +1093,13 @@ procedure TPreferences.SetWarnings(Warnings: IWarnings); (fWarnings as IAssignable).Assign(Warnings); end; +function TPreferences.__TMP__UseUserDBHeadingColour( + const ACollectionID: TCollectionID): Boolean; +begin + Result := (ACollectionID <> TCollectionID.__TMP__MainDBCollectionID) + and not ACollectionID.IsNull; +end; + { TPreferencesPersist } function TPreferencesPersist.Clone: IInterface; @@ -990,10 +1119,14 @@ function TPreferencesPersist.Clone: IInterface; NewPref.OverviewStartState := Self.fOverviewStartState; NewPref.ShowEmptySections := Self.fShowEmptySections; NewPref.ShowNewSnippetsInNewTabs := Self.fShowNewSnippetsInNewTabs; - NewPref.DBHeadingColours[False] := Self.fDBHeadingColours[False]; - NewPref.DBHeadingCustomColours[False] := Self.fDBHeadingCustomColours[False]; - NewPref.DBHeadingColours[True] := Self.fDBHeadingColours[True]; - NewPref.DBHeadingCustomColours[True] := Self.fDBHeadingCustomColours[True]; +// NewPref.DBHeadingColours[False] := Self.fDBHeadingColours[False]; + NewPref.SetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID, Self.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); +// NewPref.DBHeadingCustomColours[False] := Self.fDBHeadingCustomColours[False]; + NewPref.SetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID, Self.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID)); +// NewPref.DBHeadingColours[True] := Self.fDBHeadingColours[True]; + NewPref.SetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID, Self.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); +// NewPref.DBHeadingCustomColours[True] := Self.fDBHeadingCustomColours[True]; + NewPref.SetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID, Self.GetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID)); NewPref.OverviewFontSize := Self.fOverviewFontSize; NewPref.DetailFontSize := Self.fDetailFontSize; NewPref.SourceCodeBGColour := Self.fSourceCodeBGColour; @@ -1035,11 +1168,19 @@ constructor TPreferencesPersist.Create; fShowNewSnippetsInNewTabs := Storage.GetBoolean( 'ShowNewSnippetsInNewTabs', False ); - fDBHeadingColours[False] := TColor( - Storage.GetInteger('MainDBHeadingColour', clMainSnippet) +// fDBHeadingColours[False] := TColor( +// Storage.GetInteger('MainDBHeadingColour', clMainSnippet) +// ); + SetDBHeadingColour( + TCollectionID.__TMP__MainDBCollectionID, + TColor(Storage.GetInteger('MainDBHeadingColour', clMainSnippet)) ); - fDBHeadingColours[True] := TColor( - Storage.GetInteger('UserDBHeadingColour', clUserSnippet) +// fDBHeadingColours[True] := TColor( +// Storage.GetInteger('UserDBHeadingColour', clUserSnippet) +// ); + SetDBHeadingColour( + TCollectionID.__TMP__UserDBCollectionID, + TColor(Storage.GetInteger('UserDBHeadingColour', clUserSnippet)) ); fSourceCodeBGColour := TColor( Storage.GetInteger('SourceCodeBGColour', clSourceBg) @@ -1124,8 +1265,16 @@ destructor TPreferencesPersist.Destroy; Storage.SetInteger('OverviewStartState', Ord(fOverviewStartState)); Storage.SetBoolean('ShowEmptySections', fShowEmptySections); Storage.SetBoolean('ShowNewSnippetsInNewTabs', fShowNewSnippetsInNewTabs); - Storage.SetInteger('MainDBHeadingColour', fDBHeadingColours[False]); - Storage.SetInteger('UserDBHeadingColour', fDBHeadingColours[True]); +// Storage.SetInteger('MainDBHeadingColour', fDBHeadingColours[False]); + Storage.SetInteger( + 'MainDBHeadingColour', + GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID) + ); +// Storage.SetInteger('UserDBHeadingColour', fDBHeadingColours[True]); + Storage.SetInteger( + 'UserDBHeadingColour', + GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID) + ); Storage.SetInteger('OverviewFontSize', fOverviewFontSize); Storage.SetInteger('DetailFontSize', fDetailFontSize); Storage.SetInteger('SourceCodeBGColour', fSourceCodeBGColour); diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index 601f41ae0..6e2b0a6ea 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -104,8 +104,12 @@ constructor TRTFCategoryDoc.Create(const UseColour: Boolean); fBuilder.FontTable.Add(MainFontName, rgfSwiss, 0); fBuilder.FontTable.Add(MonoFontName, rgfModern, 0); // Set up colour table - fBuilder.ColourTable.Add(Preferences.DBHeadingColours[False]); - fBuilder.ColourTable.Add(Preferences.DBHeadingColours[True]); +// fBuilder.ColourTable.Add(Preferences.DBHeadingColours[False]); +// fBuilder.ColourTable.Add(Preferences.DBHeadingColours[True]); + {TODO -cCollection: Replace following 2 statements with loop that iterates + over all collections.} + fBuilder.ColourTable.Add(Preferences.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); + fBuilder.ColourTable.Add(Preferences.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); fBuilder.ColourTable.Add(clExternalLink); fDescStyles := TActiveTextRTFStyleMap.Create; InitStyles; @@ -215,7 +219,8 @@ procedure TRTFCategoryDoc.OutputCategoryHeading(const Category: TCategory); fBuilder.SetFontSize(HeadingFontSize); fBuilder.SetFontStyle([fsBold]); // SetColour(Preferences.DBHeadingColours[Category.UserDefined]); - SetColour(Preferences.DBHeadingColours[Category.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]); +// SetColour(Preferences.DBHeadingColours[Category.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]); + SetColour(Preferences.GetDBHeadingColour(Category.CollectionID)); fBuilder.AddText(Category.Description); fBuilder.EndPara; fBuilder.EndGroup; @@ -229,7 +234,8 @@ procedure TRTFCategoryDoc.OutputSnippetSubHeading(const Snippet: TSnippet); fBuilder.SetFontSize(SubHeadingFontSize); fBuilder.SetFontStyle([fsBold]); // SetColour(Preferences.DBHeadingColours[Snippet.UserDefined]); - SetColour(Preferences.DBHeadingColours[Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]); +// SetColour(Preferences.DBHeadingColours[Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]); + SetColour(Preferences.GetDBHeadingColour(Snippet.CollectionID)); fBuilder.AddText(Snippet.DisplayName); fBuilder.EndPara; fBuilder.EndGroup; diff --git a/Src/URTFSnippetDoc.pas b/Src/URTFSnippetDoc.pas index 185dc8ca9..948fc31cb 100644 --- a/Src/URTFSnippetDoc.pas +++ b/Src/URTFSnippetDoc.pas @@ -181,8 +181,13 @@ procedure TRTFSnippetDoc.InitialiseDoc; fBuilder.ColourTable.Add(clWarningText); fBuilder.ColourTable.Add(clVarText); fBuilder.ColourTable.Add(clExternalLink); - fBuilder.ColourTable.Add(Preferences.DBHeadingColours[False]); - fBuilder.ColourTable.Add(Preferences.DBHeadingColours[True]); +// fBuilder.ColourTable.Add(Preferences.DBHeadingColours[False]); +// fBuilder.ColourTable.Add(Preferences.DBHeadingColours[True]); + { TODO -cCollections: Replace following two statements with iteration over all + supported collections when support for multiple collections is added. + } + fBuilder.ColourTable.Add(Preferences.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); + fBuilder.ColourTable.Add(Preferences.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); end; procedure TRTFSnippetDoc.InitStyles; @@ -443,7 +448,7 @@ procedure TRTFSnippetDoc.RenderHeading(const Heading: string; fBuilder.SetFontStyle([fsBold]); fBuilder.SetFontSize(HeadingFontSize); if fUseColour then - fBuilder.SetColour(Preferences.DBHeadingColours[ACollectionID <> TCollectionID.__TMP__MainDBCollectionID]); + fBuilder.SetColour(Preferences.GetDBHeadingColour(ACollectionID)); fBuilder.SetParaSpacing(TRTFParaSpacing.Create(0.0, ParaSpacing)); fBuilder.AddText(Heading); fBuilder.EndPara; diff --git a/Src/USnippetsChkListMgr.pas b/Src/USnippetsChkListMgr.pas index f6e828052..d1bd0c842 100644 --- a/Src/USnippetsChkListMgr.pas +++ b/Src/USnippetsChkListMgr.pas @@ -203,10 +203,12 @@ procedure TSnippetsChkListMgr.DrawItem(Control: TWinControl; Index: Integer; Assert(fCLB = Control, ClassName + '.DrawItem: Control <> fCLB'); Canvas := fCLB.Canvas; if not (odSelected in State) then - Canvas.Font.Color := Preferences.DBHeadingColours[ -// (fCLB.Items.Objects[Index] as TSnippet).UserDefined - (fCLB.Items.Objects[Index] as TSnippet).CollectionID <> TCollectionID.__TMP__MainDBCollectionID - ]; +// Canvas.Font.Color := Preferences.DBHeadingColours[ +//// (fCLB.Items.Objects[Index] as TSnippet).UserDefined +// ]; + Canvas.Font.Color := Preferences.GetDBHeadingColour( + (fCLB.Items.Objects[Index] as TSnippet).CollectionID + ); Canvas.TextRect( Rect, Rect.Left + 2, diff --git a/Src/USnippetsTVDraw.pas b/Src/USnippetsTVDraw.pas index be4c22bb4..2888ab4d6 100644 --- a/Src/USnippetsTVDraw.pas +++ b/Src/USnippetsTVDraw.pas @@ -70,7 +70,9 @@ implementation // Delphi Graphics, // Project - UColours, UPreferences; + DB.UCollections, + UColours, + UPreferences; { TSnippetsTVDraw } @@ -118,7 +120,8 @@ procedure TSnippetsTVDraw.CustomDrawItem(Sender: TCustomTreeView; TV.Canvas.Font.Color := clWarningText else TV.Canvas.Font.Color := - Preferences.DBHeadingColours[IsUserDefinedNode(Node)]; +// Preferences.DBHeadingColours[IsUserDefinedNode(Node)]; + Preferences.GetDBHeadingColour(TCollectionID.__TMP__DBCollectionID(IsUserDefinedNode(Node))); TV.Canvas.Brush.Color := TV.Color; end; if IsSectionHeadNode(Node) then From 16da8d4f6899a547552343d3a35c0ec02a16a0c5 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 3 Nov 2024 16:10:45 +0000 Subject: [PATCH 029/222] Change TSnippetsTVDraw to use collection IDs TSnippetsTVDraw used a IsUserDefinedNode abstract class overridden by descendant classes. This has been replaced by an abstract GetCollectionID method that gets the collection ID associated with a tree node, or a null collection ID if the node doesn't relate to any collection. TSnippetsTVDraw & descendant classes were modified re the above changes. Decisions about which CodeSnip 4 database the collections relate to have effectively been pushed down into the preferences code in UPreferences. Some __TMP__ method calls were removed by these changes. Removed code was commented out. --- Src/FmDependenciesDlg.pas | 53 ++++++++++++++++-------- Src/FrOverview.pas | 74 ++++++++++++++++++++------------- Src/FrSelectSnippetsBase.pas | 80 ++++++++++++++++++++++++------------ Src/USnippetsTVDraw.pas | 27 ++++++++---- 4 files changed, 152 insertions(+), 82 deletions(-) diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index abc91e9db..786f7d5da 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -20,6 +20,7 @@ interface // Delphi ComCtrls, StdCtrls, Controls, ExtCtrls, Classes, Windows, ActnList, // Project + DB.UCollections, DB.USnippet, FmGenericViewDlg, UBaseObjects, USearch, USnippetIDs, USnippetsTVDraw; @@ -65,12 +66,21 @@ TTVDraw = class(TSnippetsTVDraw) strict private fRootID: TSnippetID; // ID of snippet whose dependency nodes displayed strict protected - function IsUserDefinedNode(const Node: TTreeNode): Boolean; + /// Gets the collection ID, if any, associated with a tree + /// node. + /// TTreeNode [in] Node to be checked. + /// + /// TCollectionID. Associated collection ID. If + /// Node has no associated collection then a null collection ID + /// is returned. + function GetCollectionID(const Node: TTreeNode): TCollectionID; override; - {Checks if a node represents a user defined snippets object. - @param Node [in] Node to be checked. - @return True if node represents user defined object, False if not. - } +// function IsUserDefinedNode(const Node: TTreeNode): Boolean; +// override; +// {Checks if a node represents a user defined snippets object. +// @param Node [in] Node to be checked. +// @return True if node represents user defined object, False if not. +// } function IsErrorNode(const Node: TTreeNode): Boolean; override; {Checks if a node represents an error condition. @@ -161,7 +171,6 @@ implementation SysUtils, Graphics, // Project - DB.UCollections, DB.UMain, DB.USnippetKind, UBox, @@ -503,6 +512,15 @@ constructor TDependenciesDlg.TTVDraw.Create( fRootID := RootID; end; +function TDependenciesDlg.TTVDraw.GetCollectionID( + const Node: TTreeNode): TCollectionID; +begin + if not Assigned(Node.Data) then + Result := TCollectionID.CreateNull + else + Result := TSnippet(Node.Data).CollectionID; +end; + function TDependenciesDlg.TTVDraw.IsErrorNode( const Node: TTreeNode): Boolean; {Checks if a node represents an error condition. @@ -513,19 +531,18 @@ function TDependenciesDlg.TTVDraw.IsErrorNode( Result := Assigned(Node.Data) and (TSnippet(Node.Data).ID = fRootID); end; -function TDependenciesDlg.TTVDraw.IsUserDefinedNode( - const Node: TTreeNode): Boolean; - {Checks if a node represents a user defined snippets object. - @param Node [in] Node to be checked. - @return True if node represents user defined object, False if not. - } -begin - if not Assigned(Node.Data) then - Result := True - else +//function TDependenciesDlg.TTVDraw.IsUserDefinedNode( +// const Node: TTreeNode): Boolean; +// {Checks if a node represents a user defined snippets object. +// @param Node [in] Node to be checked. +// @return True if node represents user defined object, False if not. +// } +//begin +// if not Assigned(Node.Data) then +// Result := True +// else // Result := TSnippet(Node.Data).UserDefined; - Result := TSnippet(Node.Data).CollectionID <> TCollectionID.__TMP__MainDBCollectionID; -end; +//end; end. diff --git a/Src/FrOverview.pas b/Src/FrOverview.pas index 575975387..481b6351b 100644 --- a/Src/FrOverview.pas +++ b/Src/FrOverview.pas @@ -20,6 +20,7 @@ interface // Delphi ComCtrls, Controls, Classes, Windows, ExtCtrls, StdCtrls, ToolWin, Menus, // Project + DB.UCollections, DB.USnippet, FrTitled, IntfFrameMgrs, IntfNotifier, UCommandBars, UOverviewTreeState, USnippetsTVDraw, UView, UViewItemTreeNode; @@ -74,11 +75,20 @@ TOverviewFrame = class(TTitledFrame, } TTVDraw = class(TSnippetsTVDraw) strict protected - function IsUserDefinedNode(const Node: TTreeNode): Boolean; override; - {Checks if a node represents a user defined snippets object. - @param Node [in] Node to be checked. - @return True if node represents user defined object, False if not. - } + /// Gets the collection ID, if any, associated with a tree + /// node. + /// TTreeNode [in] Node to be checked. + /// + /// TCollectionID. Associated collection ID. If + /// Node has no associated collection then a null collection ID + /// is returned. + function GetCollectionID(const Node: TTreeNode): TCollectionID; + override; +// function IsUserDefinedNode(const Node: TTreeNode): Boolean; override; +// {Checks if a node represents a user defined snippets object. +// @param Node [in] Node to be checked. +// @return True if node represents user defined object, False if not. +// } function IsSectionHeadNode(const Node: TTreeNode): Boolean; override; {Checks if a node represents a section header. @@ -238,7 +248,6 @@ implementation SysUtils, Messages, // Project - DB.UCollections, UKeysHelper, UOverviewTreeBuilder; @@ -959,6 +968,23 @@ procedure TOverviewFrame.UpdateTreeState(const State: TTreeNodeAction); { TOverviewFrame.TTVDraw } +function TOverviewFrame.TTVDraw.GetCollectionID(const Node: TTreeNode): + TCollectionID; +var + ViewItem: IView; // view item represented by node + SnippetView: ISnippetView; // view item if node represents a snippet + CategoryView: ICategoryView; // view item if node represents a category +begin + // TODO -cBug: Exception reported as issue #70 could have moved here + ViewItem := (Node as TViewItemTreeNode).ViewItem; + if Supports(ViewItem, ISnippetView, SnippetView) then + Result := SnippetView.Snippet.CollectionID + else if Supports(ViewItem, ICategoryView, CategoryView) then + Result := CategoryView.Category.CollectionID + else + Result := TCollectionID.CreateNull; +end; + function TOverviewFrame.TTVDraw.IsSectionHeadNode( const Node: TTreeNode): Boolean; {Checks if a node represents a section header. @@ -972,30 +998,20 @@ function TOverviewFrame.TTVDraw.IsSectionHeadNode( Result := ViewItem.IsGrouping; end; -function TOverviewFrame.TTVDraw.IsUserDefinedNode( - const Node: TTreeNode): Boolean; - {Checks if a node represents a user defined snippets object. - @param Node [in] Node to be checked. - @return True if node represents user defined object, False if not. - } -var - ViewItem: IView; // view item represented by node - SnippetView: ISnippetView; // view item if node represents a snippet - CategoryView: ICategoryView; // view item if node represents a category - CollectionID: TCollectionID; // ID of collection node item belongs to, if any -begin - // TODO -cBug: Exception reported as issue #70 seems to be triggered here - ViewItem := (Node as TViewItemTreeNode).ViewItem; +//function TOverviewFrame.TTVDraw.IsUserDefinedNode( +// const Node: TTreeNode): Boolean; +// {Checks if a node represents a user defined snippets object. +// @param Node [in] Node to be checked. +// @return True if node represents user defined object, False if not. +// } +//var +// ViewItem: IView; // view item represented by node +// CollectionID: TCollectionID; // ID of collection node item belongs to, if any +//begin +// // TODO -cBug: Exception reported as issue #70 seems to be triggered here +// ViewItem := (Node as TViewItemTreeNode).ViewItem; // Result := ViewItem.IsUserDefined; - if Supports(ViewItem, ISnippetView, SnippetView) then - CollectionID := SnippetView.Snippet.CollectionID - else if Supports(ViewItem, ICategoryView, CategoryView) then - CollectionID := CategoryView.Category.CollectionID - else - CollectionID := TCollectionID.CreateNull; - Result := (CollectionID <> TCollectionID.__TMP__MainDBCollectionID) - and not CollectionID.IsNull; -end; +//end; end. diff --git a/Src/FrSelectSnippetsBase.pas b/Src/FrSelectSnippetsBase.pas index 3074cf0d1..04782b63f 100644 --- a/Src/FrSelectSnippetsBase.pas +++ b/Src/FrSelectSnippetsBase.pas @@ -18,9 +18,16 @@ interface uses // Delphi - ImgList, Controls, Classes, ComCtrls, + ImgList, + Controls, + Classes, + ComCtrls, // Project - DB.UCategory, DB.USnippet, FrCheckedTV, USnippetsTVDraw; + DB.UCollections, + DB.UCategory, + DB.USnippet, + FrCheckedTV, + USnippetsTVDraw; type @@ -42,14 +49,22 @@ TSelectSnippetsBaseFrame = class(TCheckedTVFrame) } TTVDraw = class(TSnippetsTVDraw) strict protected - {TODO -cCollections: Need to change following method in base class to - get collection ID and calling code then needs to take action based - on that instead of user-defined.} - function IsUserDefinedNode(const Node: TTreeNode): Boolean; override; - {Checks if a node represents a user defined snippets object. - @param Node [in] Node to be checked. - @return True if node represents user defined object, False if not. - } + /// Gets the collection ID, if any, associated with a tree + /// node. + /// TTreeNode [in] Node to be checked. + /// + /// TCollectionID. Associated collection ID. If + /// Node has no associated collection then a null collection ID + /// is returned. + function GetCollectionID(const Node: TTreeNode): TCollectionID; + override; + +// function IsUserDefinedNode(const Node: TTreeNode): Boolean; override; +// {Checks if a node represents a user defined snippets object. +// @param Node [in] Node to be checked. +// @return True if node represents user defined object, False if not. +// } + function IsSectionHeadNode(const Node: TTreeNode): Boolean; override; {Checks if a node represents a section header. @@ -124,7 +139,6 @@ implementation SysUtils, StdCtrls, // Project - DB.UCollections, DB.UMain, UGroups; @@ -266,6 +280,20 @@ function TSelectSnippetsBaseFrame.SnippetFromNode( { TSelectSnippetsBaseFrame.TTVDraw } +function TSelectSnippetsBaseFrame.TTVDraw.GetCollectionID( + const Node: TTreeNode): TCollectionID; +var + SnipObj: TObject; // object referenced in Node.Data +begin + SnipObj := TObject(Node.Data); + if SnipObj is TSnippet then + Result := (SnipObj as TSnippet).CollectionID + else if SnipObj is TCategory then + Result := (SnipObj as TCategory).CollectionID + else + Result := TCollectionID.CreateNull +end; + function TSelectSnippetsBaseFrame.TTVDraw.IsSectionHeadNode( const Node: TTreeNode): Boolean; {Checks if a node represents a section header. @@ -277,24 +305,22 @@ function TSelectSnippetsBaseFrame.TTVDraw.IsSectionHeadNode( Result := TObject(Node.Data) is TCategory; end; -function TSelectSnippetsBaseFrame.TTVDraw.IsUserDefinedNode( - const Node: TTreeNode): Boolean; - {Checks if a node represents a user defined snippets object. - @param Node [in] Node to be checked. - @return True if node represents user defined object, False if not. - } -var - SnipObj: TObject; // object referenced in Node.Data -begin - SnipObj := TObject(Node.Data); - Result := False; - if SnipObj is TSnippet then +//function TSelectSnippetsBaseFrame.TTVDraw.IsUserDefinedNode( +// const Node: TTreeNode): Boolean; +// {Checks if a node represents a user defined snippets object. +// @param Node [in] Node to be checked. +// @return True if node represents user defined object, False if not. +// } +//var +// SnipObj: TObject; // object referenced in Node.Data +//begin +// SnipObj := TObject(Node.Data); +// Result := False; +// if SnipObj is TSnippet then // Result := (SnipObj as TSnippet).UserDefined - Result := (SnipObj as TSnippet).CollectionID <> TCollectionID.__TMP__MainDBCollectionID - else if SnipObj is TCategory then +// else if SnipObj is TCategory then // Result := (SnipObj as TCategory).UserDefined; - Result := (SnipObj as TCategory).CollectionID <> TCollectionID.__TMP__MainDBCollectionID; -end; +//end; end. diff --git a/Src/USnippetsTVDraw.pas b/Src/USnippetsTVDraw.pas index 2888ab4d6..99f1c9950 100644 --- a/Src/USnippetsTVDraw.pas +++ b/Src/USnippetsTVDraw.pas @@ -18,7 +18,9 @@ interface uses // Delphi - ComCtrls; + ComCtrls, + // Project + DB.UCollections; type @@ -30,12 +32,22 @@ interface } TSnippetsTVDraw = class abstract(TObject) strict protected - function IsUserDefinedNode(const Node: TTreeNode): Boolean; + /// Gets the collection ID, if any, associated with a tree node. + /// + /// TTreeNode [in] Node to be checked. + /// TCollectionID. Associated collection ID. If Node + /// has no associated collection then a null collection ID is returned. + /// + function GetCollectionID(const Node: TTreeNode): TCollectionID; virtual; abstract; - {Checks if a node represents a user defined snippets object. - @param Node [in] Node to be checked. - @return True if node represents user defined object, False if not. - } + +// function IsUserDefinedNode(const Node: TTreeNode): Boolean; +// virtual; abstract; +// {Checks if a node represents a user defined snippets object. +// @param Node [in] Node to be checked. +// @return True if node represents user defined object, False if not. +// } + function IsSectionHeadNode(const Node: TTreeNode): Boolean; virtual; {Checks if a node represents a section header. @@ -70,7 +82,6 @@ implementation // Delphi Graphics, // Project - DB.UCollections, UColours, UPreferences; @@ -121,7 +132,7 @@ procedure TSnippetsTVDraw.CustomDrawItem(Sender: TCustomTreeView; else TV.Canvas.Font.Color := // Preferences.DBHeadingColours[IsUserDefinedNode(Node)]; - Preferences.GetDBHeadingColour(TCollectionID.__TMP__DBCollectionID(IsUserDefinedNode(Node))); + Preferences.GetDBHeadingColour(GetCollectionID(Node)); TV.Canvas.Brush.Color := TV.Color; end; if IsSectionHeadNode(Node) then From 73a7e777de67f9d2a3820e26963329b6901c56d8 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 3 Nov 2024 17:50:43 +0000 Subject: [PATCH 030/222] Store collection IDs in FmDependenciesDlg's listbox FmDependenciesDlg used to record TBox objects in the Objects[] array properties of the list box that displays dependent snippets. This was used to set the colour of a snippet depending on whether it was user defined or not. This was changed to store a TBox object instead of the boxed Boolean object so that collection ID can be used to get the required snippet colour from preferences. Eliminated a __TMP__ method call. Removed code was commented out. --- Src/FmDependenciesDlg.pas | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index 786f7d5da..5058a6cb4 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -414,9 +414,14 @@ procedure TDependenciesDlg.lbDependentsDrawItem(Control: TWinControl; LB: TListBox; Canvas: TCanvas; - function IsUserDefinedItem: Boolean; +// function IsUserDefinedItem: Boolean; +// begin +// Result := (LB.Items.Objects[Index] as TBox).Value; +// end; + + function ExtractCollectionItem: TCollectionID; begin - Result := (LB.Items.Objects[Index] as TBox).Value; + Result := (LB.Items.Objects[Index] as TBox).Value; end; begin @@ -424,7 +429,7 @@ procedure TDependenciesDlg.lbDependentsDrawItem(Control: TWinControl; Canvas := LB.Canvas; if not (odSelected in State) then // Canvas.Font.Color := Preferences.DBHeadingColours[IsUserDefinedItem]; - Canvas.Font.Color := Preferences.GetDBHeadingColour(TCollectionID.__TMP__DBCollectionID(IsUserDefinedItem)); + Canvas.Font.Color := Preferences.GetDBHeadingColour(ExtractCollectionItem); Canvas.TextRect( Rect, Rect.Left + 2, @@ -461,7 +466,7 @@ procedure TDependenciesDlg.PopulateRequiredByList; Assert(Assigned(ASnippet), ClassName + '.PopulateRequiredByList: Snippet id not found'); lbDependents.Items.AddObject( - ASnippet.DisplayName, TBox.Create(ASnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) + ASnippet.DisplayName, TBox.Create(ASnippet.CollectionID) // ASnippet.DisplayName, TBox.Create(ASnippet.UserDefined) ); end; From 71b94e83064c317cec23b52adb1f66e5e3302b23 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 3 Nov 2024 21:22:33 +0000 Subject: [PATCH 031/222] Change FmSelectionSearchDlg to use collection IDs FmSelectionSearchDlg has buttons to select all "user" or all "main" snippets. The events these buttons trigger have been changed from using Boolean UserDefined flags to passing the collection IDs of the CodeSnip 4 "main" and "user" collections. Some __TMP__ methods were required to implement this. Removed code was commented out. --- Src/FmSelectionSearchDlg.pas | 56 ++++++++++++++++++++++++++---------- 1 file changed, 41 insertions(+), 15 deletions(-) diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index bf0914b39..cacdc99ea 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -20,6 +20,7 @@ interface // Delphi Forms, StdCtrls, Controls, ExtCtrls, Classes, // Project + DB.UCollections, DB.USnippet, FmGenericOKDlg, FrCheckedTV, FrSelectSnippets, FrSelectSnippetsBase, UBaseObjects, USearch; @@ -61,12 +62,20 @@ TSelectionSearchDlg = class(TGenericOKDlg, INoPublicConstruct) no snippet selected. @param Sender [in] Not used. } - procedure SelectDB(const UserDefined: Boolean); - {Selects all snippets from either main or user defined database. - @param UserDefined [in] Flag true if user-defined snippets are to be - selected, False if main database snippets are to be selected. - } + +// procedure SelectDB(const UserDefined: Boolean); +// {Selects all snippets from either main or user defined database. +// @param UserDefined [in] Flag true if user-defined snippets are to be +// selected, False if main database snippets are to be selected. +// } + + /// Selects all snippets from the given collection. + /// TCollectionID ID of the required + /// collection. + procedure SelectDB(const ACollectionID: TCollectionID); + strict protected + procedure ConfigForm; override; procedure InitForm; override; {Initialises form. Disables User Defined button if there are no user @@ -96,7 +105,6 @@ implementation // Delphi SysUtils, // Project - DB.UCollections, DB.UMain, UCtrlArranger, UQuery; @@ -140,7 +148,8 @@ procedure TSelectionSearchDlg.btnMainDBClick(Sender: TObject); @param Sender [in] Not used. } begin - SelectDB(False); +// SelectDB(False); + SelectDB(TCollectionID.__TMP__MainDBCollectionID); end; procedure TSelectionSearchDlg.btnOKClick(Sender: TObject); @@ -175,7 +184,8 @@ procedure TSelectionSearchDlg.btnUserDBClick(Sender: TObject); @param Sender [in] Not used. } begin - SelectDB(True); +// SelectDB(True); + SelectDB(TCollectionID.__TMP__UserDBCollectionID); end; procedure TSelectionSearchDlg.ConfigForm; @@ -234,11 +244,28 @@ procedure TSelectionSearchDlg.InitForm; ); end; -procedure TSelectionSearchDlg.SelectDB(const UserDefined: Boolean); - {Selects all snippets from either main or user defined database. - @param UserDefined [in] Flag true if user-defined snippets are to be - selected, False if main database snippets are to be selected. - } +//procedure TSelectionSearchDlg.SelectDB(const UserDefined: Boolean); +// {Selects all snippets from either main or user defined database. +// @param UserDefined [in] Flag true if user-defined snippets are to be +// selected, False if main database snippets are to be selected. +// } +//var +// Snippet: TSnippet; // references each snippet in database +// SnippetList: TSnippetList; // list of selected snippets +//begin +// SnippetList := TSnippetList.Create; +// try +// for Snippet in Database.Snippets do +//// if Snippet.UserDefined = UserDefined then +// if Snippet.CollectionID = TCollectionID.__TMP__DBCollectionID(UserDefined) then +// SnippetList.Add(Snippet); +// frmSelect.SelectedSnippets := SnippetList; +// finally +// FreeAndNil(SnippetList); +// end; +//end; + +procedure TSelectionSearchDlg.SelectDB(const ACollectionID: TCollectionID); var Snippet: TSnippet; // references each snippet in database SnippetList: TSnippetList; // list of selected snippets @@ -246,8 +273,7 @@ procedure TSelectionSearchDlg.SelectDB(const UserDefined: Boolean); SnippetList := TSnippetList.Create; try for Snippet in Database.Snippets do -// if Snippet.UserDefined = UserDefined then - if Snippet.CollectionID = TCollectionID.__TMP__DBCollectionID(UserDefined) then + if Snippet.CollectionID = ACollectionID then SnippetList.Add(Snippet); frmSelect.SelectedSnippets := SnippetList; finally From e837f7da429c016e85acb6ab6fd422b8ff295fcf Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 3 Nov 2024 23:20:02 +0000 Subject: [PATCH 032/222] Remove TCollectionID.__TMP__DBCollectionID This temporary method was removed and all code that used it was modified to call either __TMP__UserDBCollectionID or __TMP__MainDBCollectionID from TCollectionID. The advantage of this change was to removed some more UserDefined Boolean parameters. --- Src/DB.UCollections.pas | 11 ----------- Src/DB.UMain.pas | 10 ++++++---- Src/Favourites.UPersist.pas | 15 ++++++++++----- Src/FmSnippetsEditorDlg.pas | 2 +- Src/UCodeImportMgr.pas | 2 +- Src/USnippetIDListIOHandler.pas | 15 ++++++++++++--- Src/USnippetValidator.pas | 2 +- Src/UUserDBMgr.pas | 2 +- 8 files changed, 32 insertions(+), 27 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index b32c1ed09..3793168f0 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -102,8 +102,6 @@ TCollectionID = record {TODO -c__TMP__: remove following __TMP__*** methods} class function __TMP__MainDBCollectionID: TCollectionID; static; class function __TMP__UserDBCollectionID: TCollectionID; static; - class function __TMP__DBCollectionID(const AUserDefined: Boolean): TCollectionID; - static; end; ECollectionID = class(ECodeSnip); @@ -561,15 +559,6 @@ function TCollectionID.ToHexString: string; Result := BytesToHexString(fID); end; -class function TCollectionID.__TMP__DBCollectionID( - const AUserDefined: Boolean): TCollectionID; -begin - if AUserDefined then - Result := __TMP__UserDBCollectionID - else - Result := __TMP__MainDBCollectionID; -end; - class function TCollectionID.__TMP__MainDBCollectionID: TCollectionID; begin Result := TCollectionID.Create(DCSC_v2_ID); diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 3e792663d..b711690e6 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -3,7 +3,7 @@ * v. 2.0. If a copy of the MPL was not distributed with this file, You can * obtain one at https://mozilla.org/MPL/2.0/ * - * Copyright (C) 2005-2023, Peter Johnson (gravatar.com/delphidabbler). + * Copyright (C) 2005-2024, Peter Johnson (gravatar.com/delphidabbler). * * Defines a singleton object and subsidiary classes that encapsulate the * snippets and categories in the CodeSnip database and user defined databases. @@ -678,7 +678,7 @@ function TDatabase.AddSnippet(const SnippetName: string; try // Check if snippet with same name exists in user database: error if so // if fSnippets.Find(SnippetName, True) <> nil then - if fSnippets.Find(SnippetName, TCollectionID.__TMP__DBCollectionID(True)) <> nil then + if fSnippets.Find(SnippetName, TCollectionID.__TMP__UserDBCollectionID) <> nil then raise ECodeSnip.CreateFmt(sNameExists, [SnippetName]); Result := InternalAddSnippet(SnippetName, Data); Query.Update; @@ -958,7 +958,7 @@ function TDatabase.InternalAddCategory(const CatID: string; } begin // Result := TCategoryEx.Create(CatID, True, Data); - Result := TCategoryEx.Create(CatID, TCollectionID.__TMP__DBCollectionID(True), Data); + Result := TCategoryEx.Create(CatID, TCollectionID.__TMP__UserDBCollectionID, Data); fCategories.Add(Result); end; @@ -1152,7 +1152,7 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; // If name has changed then new name musn't exist in user database if not StrSameText(SnippetName, Snippet.Name) then // if fSnippets.Find(SnippetName, True) <> nil then - if fSnippets.Find(SnippetName, TCollectionID.__TMP__DBCollectionID(True)) <> nil then + if fSnippets.Find(SnippetName, TCollectionID.__TMP__UserDBCollectionID) <> nil then raise ECodeSnip.CreateFmt(sCantRename, [Snippet.Name, SnippetName]); // We update by deleting old snippet and inserting new one // get lists of snippets that cross reference or depend on this snippet @@ -1188,6 +1188,8 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; constructor TDatabase.TEventInfo.Create(const Kind: TDatabaseChangeEventKind; const Info: TObject); + + {Constructor. Creates an event information object. @param Kind [in] Kind of event. @param Info [in] Reference to further information about the event. May be diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index b444c5274..69c03ff24 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -80,8 +80,9 @@ class procedure TFavouritesPersist.Load(Favourites: TFavourites); Line: string; Fields: IStringList; SnippetName: string; - UserDef: Boolean; +// UserDef: Boolean; LastAccess: TDateTime; + CollectionID: TCollectionID; resourcestring sBadFormat = 'Invalid favourites file format'; begin @@ -111,16 +112,20 @@ class procedure TFavouritesPersist.Load(Favourites: TFavourites); if Fields.Count <> 3 then raise EFavouritesPersist.Create(sBadFormat); SnippetName := Fields[0]; - UserDef := True; // accept any text as true excpet "false" +// UserDef := True; // accept any text as true excpet "false" + // accept any text as user collection, except "false" + CollectionID := TCollectionID.__TMP__UserDBCollectionID; if StrSameText(Fields[1], 'false') then - UserDef := False; + // we have "false" so main collection +// UserDef := False; + CollectionID := TCollectionID.__TMP__MainDBCollectionID; if not TryStrToDateTime(Fields[2], LastAccess) then raise EFavouritesPersist.Create(sBadFormat); // only add to favourites if snippet in database // if Database.Snippets.Find(SnippetName, UserDef) <> nil then - if Database.Snippets.Find(SnippetName, TCollectionID.__TMP__DBCollectionID(UserDef)) <> nil then + if Database.Snippets.Find(SnippetName, CollectionID) <> nil then // Favourites.Add(TSnippetID.Create(SnippetName, UserDef), LastAccess); - Favourites.Add(TSnippetID.Create(SnippetName, TCollectionID.__TMP__DBCollectionID(UserDef)), LastAccess); + Favourites.Add(TSnippetID.Create(SnippetName, CollectionID), LastAccess); end; end; diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 599699e0b..ca6fea0bc 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -992,7 +992,7 @@ procedure TSnippetsEditorDlg.UpdateReferences; // Snippet.UserDefined or (Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) or // not Assigned(Database.Snippets.Find(Snippet.Name, True)) - not Assigned(Database.Snippets.Find(Snippet.Name, TCollectionID.__TMP__DBCollectionID(True))) + not Assigned(Database.Snippets.Find(Snippet.Name, TCollectionID.__TMP__UserDBCollectionID)) ) then begin // Decide if snippet can be added to depends list: must be correct kind diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index 1ec3e6651..6c8f545f2 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -288,7 +288,7 @@ procedure TCodeImportMgr.UpdateDatabase; AdjustDependsList(SnippetInfo.Data.Refs.Depends); // Snippet := Database.Snippets.Find(ImportInfo.ImportAsName, True); - Snippet := Database.Snippets.Find(ImportInfo.ImportAsName, TCollectionID.__TMP__DBCollectionID(True)); + Snippet := Database.Snippets.Find(ImportInfo.ImportAsName, TCollectionID.__TMP__UserDBCollectionID); if Assigned(Snippet) then // snippet already exists: overwrite it Editor.UpdateSnippet(Snippet, SnippetInfo.Data) diff --git a/Src/USnippetIDListIOHandler.pas b/Src/USnippetIDListIOHandler.pas index ac994fa35..ef527540e 100644 --- a/Src/USnippetIDListIOHandler.pas +++ b/Src/USnippetIDListIOHandler.pas @@ -95,6 +95,7 @@ procedure TSnippetIDListFileReader.Parse; Name: string; // name of each snippet UserDefStr: string; // user defined value of each snippet as string UserDefInt: Integer; // user defined value of each snippet as integer + CollectionID: TCollectionID; begin fSnippetIDs.Clear; if (fLines.Count <= 1) or (fLines[0] <> fWatermark) then @@ -109,11 +110,19 @@ procedure TSnippetIDListFileReader.Parse; raise ESnippetIDListFileReader.CreateFmt(sMissingName, [Line]); if UserDefStr = '' then raise ESnippetIDListFileReader.CreateFmt(sMissingUserDef, [Line]); - if not TryStrToInt(UserDefStr, UserDefInt) - or not (UserDefInt in [0, 1]) then +// if not TryStrToInt(UserDefStr, UserDefInt) +// or not (UserDefInt in [0, 1]) then +// raise ESnippetIDListFileReader.CreateFmt(sBadUserDef, [Line]); + if not TryStrToInt(UserDefStr, UserDefInt) then raise ESnippetIDListFileReader.CreateFmt(sBadUserDef, [Line]); + case UserDefInt of + 0: CollectionID := TCollectionID.__TMP__MainDBCollectionID; + 1: CollectionID := TCollectionID.__TMP__UserDBCollectionID; + else + raise ESnippetIDListFileReader.CreateFmt(sBadUserDef, [Line]); + end; // fSnippetIDs.Add(TSnippetID.Create(Name, Boolean(UserDefInt))); - fSnippetIDs.Add(TSnippetID.Create(Name, TCollectionID.__TMP__DBCollectionID(Boolean(UserDefInt)))); + fSnippetIDs.Add(TSnippetID.Create(Name, CollectionID)); end; end; diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index 23a21ae67..b5204b771 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -374,7 +374,7 @@ class function TSnippetValidator.ValidateName(const Name: string; ErrorMsg := Format(sErrBadName, [TrimmedName]) else if CheckForUniqueness and // (Database.Snippets.Find(TrimmedName, True) <> nil) then - (Database.Snippets.Find(TrimmedName, TCollectionID.__TMP__DBCollectionID(True)) <> nil) then + (Database.Snippets.Find(TrimmedName, TCollectionID.__TMP__UserDBCollectionID) <> nil) then ErrorMsg := Format(sErrDupName, [TrimmedName]) else Result := True; diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 8ab42253a..88fda6c5c 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -470,7 +470,7 @@ class procedure TUserDBMgr.EditSnippet(const SnippetName: string); Snippet: TSnippet; // reference to snippet to be edited begin // Snippet := Database.Snippets.Find(SnippetName, True); - Snippet := Database.Snippets.Find(SnippetName, TCollectionID.__TMP__DBCollectionID(True)); + Snippet := Database.Snippets.Find(SnippetName, TCollectionID.__TMP__UserDBCollectionID); if not Assigned(Snippet) then raise EBug.Create(ClassName + '.EditSnippet: Snippet not in user database'); TSnippetsEditorDlg.EditSnippet(nil, Snippet); From b007481045c75a05444f211060d77307783dccf5 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 4 Nov 2024 00:36:03 +0000 Subject: [PATCH 033/222] Remove commented out code A lot of redundant commented out code from numerous units was deleted. --- Src/DB.UCategory.pas | 27 ------- Src/DB.UDatabaseIO.pas | 60 ---------------- Src/DB.UMain.pas | 78 -------------------- Src/DB.USnippet.pas | 121 +------------------------------- Src/ExternalObj.ridl | 12 +--- Src/Favourites.UPersist.pas | 6 -- Src/FmCodeExportDlg.pas | 1 - Src/FmDependenciesDlg.pas | 28 +------- Src/FmDuplicateSnippetDlg.pas | 1 - Src/FmFavouritesDlg.pas | 6 +- Src/FmFindXRefsDlg.pas | 1 - Src/FmMain.pas | 1 - Src/FmSelectionSearchDlg.pas | 30 -------- Src/FmSnippetsEditorDlg.pas | 5 +- Src/FmTestCompileDlg.pas | 1 - Src/FrDetailView.pas | 4 -- Src/FrDisplayPrefs.pas | 12 ---- Src/FrOverview.pas | 21 +----- Src/FrSelectSnippetsBase.pas | 24 +------ Src/FrSelectUserSnippets.pas | 2 - Src/IntfNotifier.pas | 10 --- Src/UCodeImportExport.pas | 3 - Src/UCodeImportMgr.pas | 4 -- Src/UCodeShareMgr.pas | 2 - Src/UDetailPageHTML.pas | 7 -- Src/UNotifier.pas | 23 ------ Src/UPreferences.pas | 113 ----------------------------- Src/URTFCategoryDoc.pas | 6 -- Src/URTFSnippetDoc.pas | 22 ------ Src/USaveUnitMgr.pas | 1 - Src/USnippetAction.pas | 6 -- Src/USnippetDoc.pas | 9 --- Src/USnippetIDListIOHandler.pas | 7 -- Src/USnippetIDs.pas | 17 ----- Src/USnippetSourceGen.pas | 2 - Src/USnippetValidator.pas | 1 - Src/USnippetsChkListMgr.pas | 3 - Src/USnippetsTVDraw.pas | 8 --- Src/UStatusBarMgr.pas | 1 - Src/UTextSnippetDoc.pas | 13 ---- Src/UUserDBMgr.pas | 5 -- Src/UView.pas | 41 ----------- Src/UWBExternal.pas | 22 ------ 43 files changed, 8 insertions(+), 759 deletions(-) diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index 6aeeb9f8f..11415a8f6 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -52,7 +52,6 @@ TCategory = class(TObject) fSnippets: TSnippetList; // List of snippet objects in category fID: string; // Category id fDescription: string; // Category description -// fUserDefined: Boolean; // Whether this is a user-defined snippet fCollectionID: TCollectionID; procedure SetCollectionID(const AValue: TCollectionID); function CompareIDTo(const Cat: TCategory): Integer; @@ -73,12 +72,6 @@ TCategory = class(TObject) constructor Create(const CatID: string; const ACollectionID: TCollectionID; const Data: TCategoryData); -// constructor Create(const CatID: string; const UserDefined: Boolean; -// const Data: TCategoryData); overload; -// {Class contructor. Sets up category object with given property values. -// @param Data [in] Contains required property values. -// } - destructor Destroy; override; {Destructor. Tears down object. } @@ -107,8 +100,6 @@ TCategory = class(TObject) {Description of category} property Snippets: TSnippetList read fSnippets; {List of snippets in this category} -// property UserDefined: Boolean read fUserDefined; -// {Flag that indicates if this is a user defined category} /// ID of collection that defines this category. /// ID must not be null. property CollectionID: TCollectionID @@ -212,8 +203,6 @@ function TCategory.CanDelete: Boolean; @return True if deletion allowed, False if not. } begin -// Result := fUserDefined and fSnippets.IsEmpty -// and not TReservedCategories.IsReserved(Self); Result := (fCollectionID <> TCollectionID.__TMP__MainDBCollectionID) and fSnippets.IsEmpty and not TReservedCategories.IsReserved(Self); @@ -258,22 +247,6 @@ constructor TCategory.Create(const CatID: string; fSnippets := TSnippetListEx.Create; end; -//constructor TCategory.Create(const CatID: string; const UserDefined: Boolean; -// const Data: TCategoryData); -// {Class contructor. Sets up category object with given property values. -// @param Data [in] Contains required property values. -// } -//begin -// Assert(ClassType <> TCategory, -// ClassName + '.Create: must only be called from descendants.'); -// inherited Create; -// fID := CatID; -// fDescription := Data.Desc; -// fUserDefined := UserDefined; -// // Create list to store snippets in category -// fSnippets := TSnippetListEx.Create; -//end; - destructor TCategory.Destroy; {Destructor. Tears down object. } diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 296ee75ef..b94509019 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -217,15 +217,6 @@ TMainDatabaseLoader = class(TDatabaseLoader, IDatabaseLoader) @return Reference to required snippet object or nil if snippet is not found. } -// function IsNativeSnippet(const Snippet: TSnippet): Boolean; override; -// {Checks if a snippet is native (belongs) to the main database. -// @param Snippet [in] Snippet to test. -// @return True if snippet is native, False if not. -// } -// function IsUserDatabase: Boolean; override; -// {Checks if the database is the user database. -// @return False - this is not the user database. -// } /// Returns the ID of the collection being loaded into the /// database. @@ -257,15 +248,6 @@ TUserDatabaseLoader = class(TDatabaseLoader, IDatabaseLoader) @return Reference to required snippet object or nil if snippet is not found. } -// function IsNativeSnippet(const Snippet: TSnippet): Boolean; override; -// {Checks if a snippet is native (belongs) to the user database. -// @param Snippet [in] Snippet to test. -// @return True if snippet is native, False if not. -// } -// function IsUserDatabase: Boolean; override; -// {Checks if the database is the user database. -// @return True - this is the user database. -// } /// Returns the ID of the collection being loaded into the /// database. @@ -499,14 +481,10 @@ procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); for SnippetName in SnippetNames do begin // Check if snippet exists in current database and add it to list if not -// Snippet := fSnipList.Find(SnippetName, IsUserDatabase); Snippet := fSnipList.Find(SnippetName, CollectionID); if not Assigned(Snippet) then begin fReader.GetSnippetProps(SnippetName, SnippetProps); -// Snippet := fFactory.CreateSnippet( -// SnippetName, IsUserDatabase, SnippetProps -// ); Snippet := fFactory.CreateSnippet( SnippetName, CollectionID, SnippetProps ); @@ -555,27 +533,9 @@ function TMainDatabaseLoader.FindSnippet(const SnippetName: string; } begin // We only search main database -// Result := SnipList.Find(SnippetName, False); Result := SnipList.Find(SnippetName, CollectionID); end; -//function TMainDatabaseLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; -// {Checks if a snippet is native (belongs) to the main database. -// @param Snippet [in] Snippet to test. -// @return True if snippet is native, False if not. -// } -//begin -// Result := not Snippet.UserDefined; -//end; - -//function TMainDatabaseLoader.IsUserDatabase: Boolean; -// {Checks if the database is the user database. -// @return False - this is not the user database. -// } -//begin -// Result := False; -//end; - { TUserDatabaseLoader } function TUserDatabaseLoader.CollectionID: TCollectionID; @@ -614,31 +574,12 @@ function TUserDatabaseLoader.FindSnippet(const SnippetName: string; } begin // Search in user database -// Result := SnipList.Find(SnippetName, True); Result := SnipList.Find(SnippetName, CollectionID); if not Assigned(Result) then // Not in user database: try main database -// Result := SnipList.Find(SnippetName, False); Result := SnipList.Find(SnippetName, TCollectionID.__TMP__MainDBCollectionID); end; -//function TUserDatabaseLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; -// {Checks if a snippet is native (belongs) to the user database. -// @param Snippet [in] Snippet to test. -// @return True if snippet is native, False if not. -// } -//begin -// Result := Snippet.UserDefined; -//end; - -//function TUserDatabaseLoader.IsUserDatabase: Boolean; -// {Checks if the database is the user database. -// @return True - this is the user database. -// } -//begin -// Result := True; -//end; - procedure TUserDatabaseLoader.LoadCategories; {Loads all categories from storage and adds user and imports categories if not present. @@ -734,7 +675,6 @@ procedure TDatabaseWriter.WriteSnippets; for Snippet in fSnipList do begin // Only write user-defined snippets -// if Snippet.UserDefined then if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then begin // Get and write a snippet's properties diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index b711690e6..f60ef54ae 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -113,23 +113,6 @@ interface } IDBDataItemFactory = interface(IInterface) ['{C6DD85BD-E649-4A90-961C-4011D2714B3E}'] -// function CreateCategory(const CatID: string; const UserDefined: Boolean; -// const Data: TCategoryData): TCategory; -// {Creates a new category object. -// @param CatID [in] ID of new category. Must be unique. -// @param UserDefined [in] True if category is user defined, False if not. -// @param Data [in] Record describing category's properties. -// @return Instance of new category object. -// } -// function CreateSnippet(const Name: string; const UserDefined: Boolean; -// const Props: TSnippetData): TSnippet; -// {Creates a new snippet object. -// @param Name [in] Name of new snippet. Must not exist in database -// specified by UserDefined parameter. -// @param UserDefined [in] True if snippet is user defined, False if not. -// @param Props [in] Record describing snippet's properties. -// @return Instance of new snippet with no references. -// } /// Creates a new category object. /// string [in] ID of new category. Must be @@ -324,24 +307,6 @@ implementation } TDBDataItemFactory = class(TInterfacedObject, IDBDataItemFactory) public -// function CreateCategory(const CatID: string; const UserDefined: Boolean; -// const Data: TCategoryData): TCategory; -// {Creates a new category object. -// @param CatID [in] ID of new category. Must be unique. -// @param UserDefined [in] True if category is user defined, False if not. -// @param Data [in] Record describing category's properties. -// @return Instance of new category object. -// } -// function CreateSnippet(const Name: string; const UserDefined: Boolean; -// const Props: TSnippetData): TSnippet; -// {Creates a new snippet object. -// @param Name [in] Name of new snippet. Must not exist in database -// specified by UserDefined parameter. -// @param UserDefined [in] True if snippet is user defined, False if not. -// @param Props [in] Record describing snippet's properties. -// @return Instance of new snippet with no references. -// } - /// Creates a new category object. /// string [in] ID of new category. Must be /// unique. @@ -677,7 +642,6 @@ function TDatabase.AddSnippet(const SnippetName: string; TriggerEvent(evChangeBegin); try // Check if snippet with same name exists in user database: error if so -// if fSnippets.Find(SnippetName, True) <> nil then if fSnippets.Find(SnippetName, TCollectionID.__TMP__UserDBCollectionID) <> nil then raise ECodeSnip.CreateFmt(sNameExists, [SnippetName]); Result := InternalAddSnippet(SnippetName, Data); @@ -721,8 +685,6 @@ function TDatabase.CreateTempSnippet(const Snippet: TSnippet): TSnippet; Assert(Snippet is TSnippetEx, ClassName + '.CreateTempSnippet: Snippet is a TSnippetEx'); Data := (Snippet as TSnippetEx).GetEditData; -// Result := TTempSnippet.Create( -// Snippet.Name, Snippet.UserDefined, (Snippet as TSnippetEx).GetProps); Result := TTempSnippet.Create( Snippet.Name, Snippet.CollectionID, (Snippet as TSnippetEx).GetProps); (Result as TTempSnippet).UpdateRefs( @@ -740,7 +702,6 @@ function TDatabase.CreateTempSnippet(const SnippetName: string; @return Reference to new snippet. } begin -// Result := TTempSnippet.Create(SnippetName, True, Data.Props); Result := TTempSnippet.Create(SnippetName, TCollectionID.__TMP__UserDBCollectionID, Data.Props); (Result as TTempSnippet).UpdateRefs(Data.Refs, fSnippets); end; @@ -776,8 +737,6 @@ procedure TDatabase.DeleteSnippet(const Snippet: TSnippet); Referrer: TSnippet; // loops thru snippets that cross references Snippet Referrers: TSnippetList; // list of referencing snippets begin -// Assert(Snippet.UserDefined, -// ClassName + '.DeleteSnippet: Snippet is not user-defined'); Assert(Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, ClassName + '.DeleteSnippet: Snippet is not user-defined'); Assert(fSnippets.Contains(Snippet), @@ -878,8 +837,6 @@ function TDatabase.GetEditableCategoryInfo( @return Required data. } begin -// Assert(not Assigned(Category) or Category.UserDefined, -// ClassName + '.GetEditableCategoryInfo: Category is not user-defined'); Assert(not Assigned(Category) or (Category.CollectionID <> TCollectionID.__TMP__MainDBCollectionID), ClassName + '.GetEditableCategoryInfo: Category is not user-defined'); if Assigned(Category) then @@ -899,8 +856,6 @@ function TDatabase.GetEditableSnippetInfo( begin Assert(not Assigned(Snippet) or (Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID), ClassName + '.GetEditableSnippetInfo: Snippet is not user-defined'); -// Assert(not Assigned(Snippet) or Snippet.UserDefined, -// ClassName + '.GetEditableSnippetInfo: Snippet is not user-defined'); if Assigned(Snippet) then Result := (Snippet as TSnippetEx).GetEditData else @@ -957,7 +912,6 @@ function TDatabase.InternalAddCategory(const CatID: string; @return Reference to new category object. } begin -// Result := TCategoryEx.Create(CatID, True, Data); Result := TCategoryEx.Create(CatID, TCollectionID.__TMP__UserDBCollectionID, Data); fCategories.Add(Result); end; @@ -978,7 +932,6 @@ function TDatabase.InternalAddSnippet(const SnippetName: string; sCatNotFound = 'Category "%0:s" referenced by new snippet named "%1:s" does ' + 'not exist'; begin -// Result := TSnippetEx.Create(SnippetName, True, Data.Props); Result := TSnippetEx.Create(SnippetName, TCollectionID.__TMP__UserDBCollectionID, Data.Props); (Result as TSnippetEx).UpdateRefs(Data.Refs, fSnippets); Cat := fCategories.Find(Result.Category); @@ -1137,8 +1090,6 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; Result := Snippet; // keeps compiler happy Assert(Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, ClassName + '.UpdateSnippet: Snippet is not user-defined'); -// Assert(Snippet.UserDefined, -// ClassName + '.UpdateSnippet: Snippet is not user-defined'); Referrers := nil; Dependents := nil; TriggerEvent(evChangeBegin); @@ -1151,7 +1102,6 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; SnippetName := Snippet.Name; // If name has changed then new name musn't exist in user database if not StrSameText(SnippetName, Snippet.Name) then -// if fSnippets.Find(SnippetName, True) <> nil then if fSnippets.Find(SnippetName, TCollectionID.__TMP__UserDBCollectionID) <> nil then raise ECodeSnip.CreateFmt(sCantRename, [Snippet.Name, SnippetName]); // We update by deleting old snippet and inserting new one @@ -1188,8 +1138,6 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; constructor TDatabase.TEventInfo.Create(const Kind: TDatabaseChangeEventKind; const Info: TObject); - - {Constructor. Creates an event information object. @param Kind [in] Kind of event. @param Info [in] Reference to further information about the event. May be @@ -1219,31 +1167,6 @@ function TDatabase.TEventInfo.GetKind: TDatabaseChangeEventKind; { TDBDataItemFactory } -//function TDBDataItemFactory.CreateCategory(const CatID: string; -// const UserDefined: Boolean; const Data: TCategoryData): TCategory; -// {Creates a new category object. -// @param CatID [in] ID of new category. Must be unique. -// @param UserDefined [in] True if category is user defined, False if not. -// @param Data [in] Record describing category's properties. -// @return Instance of new category object. -// } -//begin -// Result := TCategoryEx.Create(CatID, TCollectionID.__TMP__DBCollectionID(UserDefined), Data); -//end; -// -//function TDBDataItemFactory.CreateSnippet(const Name: string; -// const UserDefined: Boolean; const Props: TSnippetData): TSnippet; -// {Creates a new snippet object. -// @param Name [in] Name of new snippet. Must not exist in database specified -// by UserDefined parameter. -// @param UserDefined [in] True if snippet is user defined, False if not. -// @param Props [in] Record describing snippet's properties. -// @return Instance of new snippet with no references. -// } -//begin -// Result := TSnippetEx.Create(Name, UserDefined, Props); -//end; - function TDBDataItemFactory.CreateCategory(const CatID: string; const ACollectionID: TCollectionID; const Data: TCategoryData): TCategory; begin @@ -1291,7 +1214,6 @@ function TUserDataProvider.GetCategorySnippets( begin Result := TIStringList.Create; for Snippet in Cat.Snippets do -// if Snippet.UserDefined then if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then Result.Add(Snippet.Name); end; diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 0eacce540..7032f436d 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -126,7 +126,6 @@ type TDisplayNameComparer = class(TComparer) fXRef: TSnippetList; // List of cross-referenced snippets fExtra: IActiveText; // Further information for snippet fCompatibility: TCompileResults; // Snippet's compiler compatibility -// fUserDefined: Boolean; // If this snippet is user-defined fCollectionID: TCollectionID; // Snippet's collection ID fHiliteSource: Boolean; // If source is syntax highlighted fTestInfo: TSnippetTestInfo; // Level of testing of snippet @@ -152,13 +151,6 @@ type TDisplayNameComparer = class(TComparer) @return Required field content. } public -// constructor Create(const Name: string; const UserDefined: Boolean; -// const Props: TSnippetData); -// {Class contructor. Sets up snippet object with given property values. -// @param Name [in] Name of snippet. -// @param UserDefined [in] Indicates if this is a user defined snippet. -// @param Props [in] Values of various snippet properties. -// } /// Object constructor. Sets up snippet object with given property /// values belonging to a specified collection. @@ -211,8 +203,7 @@ type TDisplayNameComparer = class(TComparer) {List of any other snippet in database on which this snippet depends} property XRef: TSnippetList read fXRef; {List of cross referenced snippets in database} -// property UserDefined: Boolean read fUserDefined;; - {Flag that indicates if this is a user defined snippet} + /// ID of collection to which the snippet belongs. property CollectionID: TCollectionID read fCollectionID; end; @@ -269,16 +260,6 @@ TSnippetList = class(TObject) @param Idx [in] Index of required snippet in list. @return Snippet at specified index in list. } -// function Find(const SnippetName: string; -// const UserDefined: Boolean; out Index: Integer): Boolean; overload; -// {Finds a snippet in the list that has a specified name and user defined -// property. Uses a binary search. -// @param SnippetName [in] Name of snippet to be found. -// @param UserDefined [in] Whether required snippet is user defined or not. -// @param Index [out] Index of required snippet in list. Valid only if -// method returns True. -// @return True if snippet found, False if not. -// } /// Finds a snippet in the list with whose name and collection ID /// match. @@ -324,14 +305,6 @@ TSnippetList = class(TObject) @param SnippetID [in] ID of snippet to find. @return Reference to required snippet or nil if not found. } -// function Find(const SnippetName: string; -// const UserDefined: Boolean): TSnippet; overload; -// {Finds a named snippet in list with a matching user defined property. -// @param SnippetName [in] Name of required snippet. -// @param UserDefined [in] Flag that determines if we are looking for a -// user defined snippet or one from main database. -// @return Reference to required snippet or nil if not found. -// } /// Finds a snippet in the list with whose name and collection ID /// match. @@ -361,13 +334,6 @@ TSnippetList = class(TObject) {Gets an intialised snippet list enumerator. @return Required enumerator. } -// function Count(const UserDefined: Boolean): Integer; overload; -// {Counts number of snippets in list that are either from or not from user -// defined database. -// @param UserDefined [in] Flags whether to count snippets in user database -// (True) or in main database (False). -// @return Number of snippets in specified database. -// } /// Counts number of snippets in list that belong to a specified /// collection. @@ -384,13 +350,6 @@ TSnippetList = class(TObject) {Checks if list is empty. @return True if list is empty, False otehrwise. } -// function IsEmpty(const UserDefined: Boolean): Boolean; overload; {__TMP__ inline;} -// {Checks if sub-set of list from either from or not from use defined -// database is empty. -// @param UserDefined [in] Flags whether to check for snippets in user -// database (True) or in main database (False). -// @return True if required subset is empty, False if not empty. -// } /// Checks if the sub-set of snippets in the list belonging to a /// specified collection is empty. @@ -455,17 +414,6 @@ function TSnippet.CanCompile: Boolean; Result := Kind <> skFreeform; end; -//constructor TSnippet.Create(const Name: string; const UserDefined: Boolean; -// const Props: TSnippetData); -// {Class contructor. Sets up snippet object with given property values. -// @param Name [in] Name of snippet. -// @param UserDefined [in] Indicates if this is a user defined snippet. -// @param Props [in] Values of various snippet properties. -// } -//begin -// Create(Name, TCollectionID.__TMP__DBCollectionID(UserDefined), Props); -//end; - constructor TSnippet.Create(const Name: string; const ACollectionID: TCollectionID; const Props: TSnippetData); begin @@ -713,23 +661,6 @@ function TSnippetList.ContainsKinds(const Kinds: TSnippetKinds): Boolean; end; end; -//function TSnippetList.Count(const UserDefined: Boolean): Integer; -// {Counts number of snippets in list that are either from or not from user -// defined database. -// @param UserDefined [in] Flags whether to count snippets in user database -// (True) or in main database (False). -// @return Number of snippets in specified database. -// } -////var -//// Snippet: TSnippet; // refers to all snippets in list -//begin -// Result := Count(TCollectionID.__TMP__DBCollectionID(UserDefined)); -//// Result := 0; -//// for Snippet in Self do -//// if Snippet.UserDefined = UserDefined then -//// Inc(Result); -//end; - function TSnippetList.Count(const ACollectionID: TCollectionID): Integer; var Snippet: TSnippet; // refers to all snippets in list @@ -775,31 +706,6 @@ destructor TSnippetList.Destroy; inherited; end; -//function TSnippetList.Find(const SnippetName: string; -// const UserDefined: Boolean; out Index: Integer): Boolean; -// {Finds a snippet in the list that has a specified name and user defined -// property. Uses a binary search. -// @param SnippetName [in] Name of snippet to be found. -// @param UserDefined [in] Whether required snippet is user defined or not. -// @param Index [out] Index of required snippet in list. Valid only if -// method returns True. -// @return True if snippet found, False if not. -// } -//var -// TempSnippet: TSnippet; // temp snippet used to perform search -// NulData: TSnippetData; // nul data used to create snippet -//begin -// // We need a temporary snippet object in order to perform binary search using -// // object list's built in search -// NulData.Init; -// TempSnippet := TTempSnippet.Create(SnippetName, UserDefined, NulData); -// try -// Result := fList.Find(TempSnippet, Index); -// finally -// TempSnippet.Free; -// end; -//end; - function TSnippetList.Find(const SnippetName: string; const ACollectionID: TCollectionID; out Index: Integer): Boolean; var @@ -817,24 +723,6 @@ function TSnippetList.Find(const SnippetName: string; end; end; -//function TSnippetList.Find(const SnippetName: string; -// const UserDefined: Boolean): TSnippet; -// {Finds a named snippet in list with a matching user defined property. -// @param SnippetName [in] Name of required snippet. -// @param UserDefined [in] Flag that determines if we are looking for a -// user defined snippet or one from main database. -// @return Reference to required snippet or nil if not found. -// } -//var -// Idx: Integer; // index of snippet name in list -//begin -// if Find(SnippetName, TCollectionID.__TMP__DBCollectionID(UserDefined), Idx) then -//// if Find(SnippetName, UserDefined, Idx) then -// Result := Items[Idx] -// else -// Result := nil; -//end; - function TSnippetList.Find(const SnippetName: string; const ACollectionID: TCollectionID): TSnippet; var @@ -852,7 +740,6 @@ function TSnippetList.Find(const SnippetID: TSnippetID): TSnippet; @return Reference to required snippet or nil if not found. } begin -// Result := Find(SnippetID.Name, SnippetID.UserDefined); Result := Find(SnippetID.Name, SnippetID.CollectionID); end; @@ -881,12 +768,6 @@ function TSnippetList.IsEmpty: Boolean; Result := Count = 0; end; -//function TSnippetList.IsEmpty(const UserDefined: Boolean): Boolean; -//begin -//// Result := Count(UserDefined) = 0; -// Result := Count(TCollectionID.__TMP__DBCollectionID(UserDefined)) = 0; -//end; - function TSnippetList.IsEmpty(const ACollectionID: TCollectionID): Boolean; begin Result := Count(ACollectionID) = 0; diff --git a/Src/ExternalObj.ridl b/Src/ExternalObj.ridl index 76c8ae4f6..47a60868b 100644 --- a/Src/ExternalObj.ridl +++ b/Src/ExternalObj.ridl @@ -16,8 +16,8 @@ helpstring("CodeSnip DOM External Object Extender Type Library"), custom(DE77BA64-517C-11D1-A2DA-0000F8773CE9, 117441012), custom(DE77BA63-517C-11D1-A2DA-0000F8773CE9, 1219706147) - ] + library ExternalObj { @@ -44,16 +44,6 @@ library ExternalObj [id(0x00000065)] HRESULT _stdcall UpdateDbase(void); - /* - TODO: Delete following commented out method - * Display named snippet. - * @param SnippetName [in] Name of snippet to display. - * @param UserDefined [in] Whether snippet is user defined. - * - [id(0x00000066)] - HRESULT _stdcall DisplaySnippet([in] BSTR SnippetName, - [in] VARIANT_BOOL UserDefined, [in] VARIANT_BOOL NewTab); - */ - /* * Display named snippet. * @param SnippetName [in] Name of snippet to display. diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index 69c03ff24..9fb4937dc 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -80,7 +80,6 @@ class procedure TFavouritesPersist.Load(Favourites: TFavourites); Line: string; Fields: IStringList; SnippetName: string; -// UserDef: Boolean; LastAccess: TDateTime; CollectionID: TCollectionID; resourcestring @@ -112,19 +111,15 @@ class procedure TFavouritesPersist.Load(Favourites: TFavourites); if Fields.Count <> 3 then raise EFavouritesPersist.Create(sBadFormat); SnippetName := Fields[0]; -// UserDef := True; // accept any text as true excpet "false" // accept any text as user collection, except "false" CollectionID := TCollectionID.__TMP__UserDBCollectionID; if StrSameText(Fields[1], 'false') then // we have "false" so main collection -// UserDef := False; CollectionID := TCollectionID.__TMP__MainDBCollectionID; if not TryStrToDateTime(Fields[2], LastAccess) then raise EFavouritesPersist.Create(sBadFormat); // only add to favourites if snippet in database -// if Database.Snippets.Find(SnippetName, UserDef) <> nil then if Database.Snippets.Find(SnippetName, CollectionID) <> nil then -// Favourites.Add(TSnippetID.Create(SnippetName, UserDef), LastAccess); Favourites.Add(TSnippetID.Create(SnippetName, CollectionID), LastAccess); end; end; @@ -141,7 +136,6 @@ class procedure TFavouritesPersist.Save(Favourites: TFavourites); begin SB.Append(Fav.SnippetID.Name); SB.Append(TAB); -// SB.Append(BoolToStr(Fav.SnippetID.UserDefined, True)); SB.Append(BoolToStr(Fav.SnippetID.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, True)); SB.Append(TAB); SB.Append(DateTimeToStr(Fav.LastAccessed)); diff --git a/Src/FmCodeExportDlg.pas b/Src/FmCodeExportDlg.pas index 48ffc385f..948f109a4 100644 --- a/Src/FmCodeExportDlg.pas +++ b/Src/FmCodeExportDlg.pas @@ -211,7 +211,6 @@ procedure TCodeExportDlg.SelectSnippet(const Snippet: TSnippet); List: TSnippetList; // list containing only the provided snippet begin if not Assigned(Snippet) or (Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID) then -// if not Assigned(Snippet) or not Snippet.UserDefined then // Snippet is nil or not user-defined: select nothing frmSnippets.SelectedSnippets := nil else diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index 5058a6cb4..00742823a 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -66,6 +66,7 @@ TTVDraw = class(TSnippetsTVDraw) strict private fRootID: TSnippetID; // ID of snippet whose dependency nodes displayed strict protected + /// Gets the collection ID, if any, associated with a tree /// node. /// TTreeNode [in] Node to be checked. @@ -75,12 +76,7 @@ TTVDraw = class(TSnippetsTVDraw) /// is returned. function GetCollectionID(const Node: TTreeNode): TCollectionID; override; -// function IsUserDefinedNode(const Node: TTreeNode): Boolean; -// override; -// {Checks if a node represents a user defined snippets object. -// @param Node [in] Node to be checked. -// @return True if node represents user defined object, False if not. -// } + function IsErrorNode(const Node: TTreeNode): Boolean; override; {Checks if a node represents an error condition. @@ -414,11 +410,6 @@ procedure TDependenciesDlg.lbDependentsDrawItem(Control: TWinControl; LB: TListBox; Canvas: TCanvas; -// function IsUserDefinedItem: Boolean; -// begin -// Result := (LB.Items.Objects[Index] as TBox).Value; -// end; - function ExtractCollectionItem: TCollectionID; begin Result := (LB.Items.Objects[Index] as TBox).Value; @@ -428,7 +419,6 @@ procedure TDependenciesDlg.lbDependentsDrawItem(Control: TWinControl; LB := Control as TListBox; Canvas := LB.Canvas; if not (odSelected in State) then -// Canvas.Font.Color := Preferences.DBHeadingColours[IsUserDefinedItem]; Canvas.Font.Color := Preferences.GetDBHeadingColour(ExtractCollectionItem); Canvas.TextRect( Rect, @@ -467,7 +457,6 @@ procedure TDependenciesDlg.PopulateRequiredByList; ClassName + '.PopulateRequiredByList: Snippet id not found'); lbDependents.Items.AddObject( ASnippet.DisplayName, TBox.Create(ASnippet.CollectionID) -// ASnippet.DisplayName, TBox.Create(ASnippet.UserDefined) ); end; end; @@ -536,18 +525,5 @@ function TDependenciesDlg.TTVDraw.IsErrorNode( Result := Assigned(Node.Data) and (TSnippet(Node.Data).ID = fRootID); end; -//function TDependenciesDlg.TTVDraw.IsUserDefinedNode( -// const Node: TTreeNode): Boolean; -// {Checks if a node represents a user defined snippets object. -// @param Node [in] Node to be checked. -// @return True if node represents user defined object, False if not. -// } -//begin -// if not Assigned(Node.Data) then -// Result := True -// else -// Result := TSnippet(Node.Data).UserDefined; -//end; - end. diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 423c4d7e9..f3a9831e3 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -132,7 +132,6 @@ function TDuplicateSnippetDlg.DisallowedNames: IStringList; Result := TIStringList.Create; Result.CaseSensitive := False; for Snippet in Database.Snippets do -// if Snippet.UserDefined then if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then Result.Add(Snippet.Name); end; diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index 0a6af9efc..02fca4a25 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -345,8 +345,7 @@ procedure TFavouritesDlg.actDisplayExecute(Sender: TObject); SelectedSnippet := LI.Favourite.SnippetID; fNotifier.DisplaySnippet( SelectedSnippet.Name, -// SelectedSnippet.UserDefined, - SelectedSnippet.CollectionID,// <> TCollectionID.__TMP__MainDBCollectionID, + SelectedSnippet.CollectionID, chkNewTab.Checked ); fFavourites.Touch(SelectedSnippet); @@ -581,11 +580,8 @@ class function TFavouritesDlg.IsDisplayed: Boolean; procedure TFavouritesDlg.LVCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); var -// UserDefined: Boolean; CollectionID: TCollectionID; begin -// UserDefined := (Item as TFavouriteListItem).Favourite.SnippetID.UserDefined; -// fLVFavs.Canvas.Font.Color := Preferences.DBHeadingColours[UserDefined]; CollectionID := (Item as TFavouriteListItem).Favourite.SnippetID.CollectionID; fLVFavs.Canvas.Font.Color := Preferences.GetDBHeadingColour(CollectionID); end; diff --git a/Src/FmFindXRefsDlg.pas b/Src/FmFindXRefsDlg.pas index a2f406629..b85259741 100644 --- a/Src/FmFindXRefsDlg.pas +++ b/Src/FmFindXRefsDlg.pas @@ -235,7 +235,6 @@ procedure TFindXRefsDlg.ConfigForm; // Set label font styles and colours lblSnippetName.Font.Style := [fsBold]; lblSnippetName.Font.Color := -// Preferences.DBHeadingColours[fSnippet.UserDefined]; Preferences.GetDBHeadingColour(fSnippet.CollectionID); // Display selected snippet name in appropriate controls lblSnippetName.Caption := fSnippet.DisplayName; diff --git a/Src/FmMain.pas b/Src/FmMain.pas index 91163c63b..5b06ad27a 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -942,7 +942,6 @@ procedure TMainForm.ActNonEmptyDBUpdate(Sender: TObject); procedure TMainForm.ActNonEmptyUserDBUpdate(Sender: TObject); begin -// (Sender as TAction).Enabled := not Database.Snippets.IsEmpty(True); (Sender as TAction).Enabled := not Database.Snippets.IsEmpty( TCollectionID.__TMP__UserDBCollectionID ); diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index cacdc99ea..dae1bc8ce 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -63,12 +63,6 @@ TSelectionSearchDlg = class(TGenericOKDlg, INoPublicConstruct) @param Sender [in] Not used. } -// procedure SelectDB(const UserDefined: Boolean); -// {Selects all snippets from either main or user defined database. -// @param UserDefined [in] Flag true if user-defined snippets are to be -// selected, False if main database snippets are to be selected. -// } - /// Selects all snippets from the given collection. /// TCollectionID ID of the required /// collection. @@ -148,7 +142,6 @@ procedure TSelectionSearchDlg.btnMainDBClick(Sender: TObject); @param Sender [in] Not used. } begin -// SelectDB(False); SelectDB(TCollectionID.__TMP__MainDBCollectionID); end; @@ -184,7 +177,6 @@ procedure TSelectionSearchDlg.btnUserDBClick(Sender: TObject); @param Sender [in] Not used. } begin -// SelectDB(True); SelectDB(TCollectionID.__TMP__UserDBCollectionID); end; @@ -238,33 +230,11 @@ procedure TSelectionSearchDlg.InitForm; begin inherited; frmSelect.CollapseTree; -// btnUserDB.Enabled := Database.Snippets.Count(True) > 0; btnUserDB.Enabled := not Database.Snippets.IsEmpty( TCollectionID.__TMP__UserDBCollectionID ); end; -//procedure TSelectionSearchDlg.SelectDB(const UserDefined: Boolean); -// {Selects all snippets from either main or user defined database. -// @param UserDefined [in] Flag true if user-defined snippets are to be -// selected, False if main database snippets are to be selected. -// } -//var -// Snippet: TSnippet; // references each snippet in database -// SnippetList: TSnippetList; // list of selected snippets -//begin -// SnippetList := TSnippetList.Create; -// try -// for Snippet in Database.Snippets do -//// if Snippet.UserDefined = UserDefined then -// if Snippet.CollectionID = TCollectionID.__TMP__DBCollectionID(UserDefined) then -// SnippetList.Add(Snippet); -// frmSelect.SelectedSnippets := SnippetList; -// finally -// FreeAndNil(SnippetList); -// end; -//end; - procedure TSelectionSearchDlg.SelectDB(const ACollectionID: TCollectionID); var Snippet: TSnippet; // references each snippet in database diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index ca6fea0bc..6e1c15192 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -425,7 +425,6 @@ procedure TSnippetsEditorDlg.actViewDependenciesExecute(Sender: TObject); fDependsCLBMgr.GetCheckedSnippets(DependsList); TDependenciesDlg.Execute( Self, -// TSnippetID.Create(StrTrim(edName.Text), True), TSnippetID.Create(StrTrim(edName.Text), TCollectionID.__TMP__UserDBCollectionID), StrTrim(edDisplayName.Text), DependsList, @@ -980,7 +979,7 @@ procedure TSnippetsEditorDlg.UpdateReferences; fDependsCLBMgr.Clear; fXRefsCLBMgr.Save; fXRefsCLBMgr.Clear; -// EditSnippetID := TSnippetID.Create(fOrigName, True); + EditSnippetID := TSnippetID.Create(fOrigName, TCollectionID.__TMP__UserDBCollectionID); EditSnippetKind := fSnipKindList.SnippetKind(cbKind.ItemIndex); for Snippet in Database.Snippets do @@ -989,9 +988,7 @@ procedure TSnippetsEditorDlg.UpdateReferences; // a user-defined one with same name if (Snippet.ID <> EditSnippetID) and ( -// Snippet.UserDefined or (Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) or -// not Assigned(Database.Snippets.Find(Snippet.Name, True)) not Assigned(Database.Snippets.Find(Snippet.Name, TCollectionID.__TMP__UserDBCollectionID)) ) then begin diff --git a/Src/FmTestCompileDlg.pas b/Src/FmTestCompileDlg.pas index 08be15372..c35ea4c24 100644 --- a/Src/FmTestCompileDlg.pas +++ b/Src/FmTestCompileDlg.pas @@ -289,7 +289,6 @@ procedure TTestCompileDlg.ConfigForm; // Set required label fonts and captions TFontHelper.SetDefaultBaseFont(lblSnippetName.Font); lblSnippetName.Font.Color := -// Preferences.DBHeadingColours[fSnippet.UserDefined]; Preferences.GetDBHeadingColour(fSnippet.CollectionID); lblSnippetName.Caption := fSnippet.DisplayName; end; diff --git a/Src/FrDetailView.pas b/Src/FrDetailView.pas index 1e93d52b3..65411bf8f 100644 --- a/Src/FrDetailView.pas +++ b/Src/FrDetailView.pas @@ -228,10 +228,6 @@ procedure TDetailViewFrame.BuildCSS(const CSSBuilder: TCSSBuilder); .AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); // Heading colours for user & main databases -// CSSBuilder.AddSelector('.userdb') -// .AddProperty(TCSS.ColorProp(Preferences.DBHeadingColours[True])); -// CSSBuilder.AddSelector('.maindb') -// .AddProperty(TCSS.ColorProp(Preferences.DBHeadingColours[False])); CSSBuilder.AddSelector('.userdb') .AddProperty(TCSS.ColorProp(Preferences.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID))); CSSBuilder.AddSelector('.maindb') diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index a540d9e93..3f0433599 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -134,13 +134,9 @@ procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences; chkHideEmptySections.Checked := not Prefs.ShowEmptySections; chkHideEmptySections.OnClick := chkHideEmptySectionsClick; chkSnippetsInNewTab.Checked := Prefs.ShowNewSnippetsInNewTabs; -// fMainColourBox.Selected := Prefs.DBHeadingColours[False]; -// fUserColourBox.Selected := Prefs.DBHeadingColours[True]; fMainColourBox.Selected := Prefs.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID); fUserColourBox.Selected := Prefs.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID); fSourceBGColourBox.Selected := Prefs.SourceCodeBGcolour; -// Prefs.DBHeadingCustomColours[False].CopyTo(fMainColourDlg.CustomColors, True); -// Prefs.DBHeadingCustomColours[True].CopyTo(fUserColourDlg.CustomColors, True); Prefs.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID).CopyTo(fMainColourDlg.CustomColors, True); Prefs.GetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID).CopyTo(fUserColourDlg.CustomColors, True); Prefs.SourceCodeBGCustomColours.CopyTo(fSourceBGColourDlg.CustomColors, True); @@ -299,17 +295,9 @@ procedure TDisplayPrefsFrame.Deactivate(const Prefs: IPreferences); Prefs.OverviewStartState := TOverviewStartState( cbOverviewTree.Items.Objects[cbOverviewTree.ItemIndex] ); -// Prefs.DBHeadingColours[False] := fMainColourBox.Selected; -// Prefs.DBHeadingColours[True] := fUserColourBox.Selected; Prefs.SetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID, fMainColourBox.Selected); Prefs.SetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID, fUserColourBox.Selected); Prefs.SourceCodeBGcolour := fSourceBGColourBox.Selected; -// Prefs.DBHeadingCustomColours[False].CopyFrom( -// fMainColourDlg.CustomColors, True -// ); -// Prefs.DBHeadingCustomColours[True].CopyFrom( -// fUserColourDlg.CustomColors, True -// ); Prefs.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID).CopyFrom( fMainColourDlg.CustomColors, True ); diff --git a/Src/FrOverview.pas b/Src/FrOverview.pas index 481b6351b..d097cff68 100644 --- a/Src/FrOverview.pas +++ b/Src/FrOverview.pas @@ -84,11 +84,7 @@ TTVDraw = class(TSnippetsTVDraw) /// is returned. function GetCollectionID(const Node: TTreeNode): TCollectionID; override; -// function IsUserDefinedNode(const Node: TTreeNode): Boolean; override; -// {Checks if a node represents a user defined snippets object. -// @param Node [in] Node to be checked. -// @return True if node represents user defined object, False if not. -// } + function IsSectionHeadNode(const Node: TTreeNode): Boolean; override; {Checks if a node represents a section header. @@ -998,20 +994,5 @@ function TOverviewFrame.TTVDraw.IsSectionHeadNode( Result := ViewItem.IsGrouping; end; -//function TOverviewFrame.TTVDraw.IsUserDefinedNode( -// const Node: TTreeNode): Boolean; -// {Checks if a node represents a user defined snippets object. -// @param Node [in] Node to be checked. -// @return True if node represents user defined object, False if not. -// } -//var -// ViewItem: IView; // view item represented by node -// CollectionID: TCollectionID; // ID of collection node item belongs to, if any -//begin -// // TODO -cBug: Exception reported as issue #70 seems to be triggered here -// ViewItem := (Node as TViewItemTreeNode).ViewItem; -// Result := ViewItem.IsUserDefined; -//end; - end. diff --git a/Src/FrSelectSnippetsBase.pas b/Src/FrSelectSnippetsBase.pas index 04782b63f..50b233e4d 100644 --- a/Src/FrSelectSnippetsBase.pas +++ b/Src/FrSelectSnippetsBase.pas @@ -49,6 +49,7 @@ TSelectSnippetsBaseFrame = class(TCheckedTVFrame) } TTVDraw = class(TSnippetsTVDraw) strict protected + /// Gets the collection ID, if any, associated with a tree /// node. /// TTreeNode [in] Node to be checked. @@ -59,12 +60,6 @@ TTVDraw = class(TSnippetsTVDraw) function GetCollectionID(const Node: TTreeNode): TCollectionID; override; -// function IsUserDefinedNode(const Node: TTreeNode): Boolean; override; -// {Checks if a node represents a user defined snippets object. -// @param Node [in] Node to be checked. -// @return True if node represents user defined object, False if not. -// } - function IsSectionHeadNode(const Node: TTreeNode): Boolean; override; {Checks if a node represents a section header. @@ -305,22 +300,5 @@ function TSelectSnippetsBaseFrame.TTVDraw.IsSectionHeadNode( Result := TObject(Node.Data) is TCategory; end; -//function TSelectSnippetsBaseFrame.TTVDraw.IsUserDefinedNode( -// const Node: TTreeNode): Boolean; -// {Checks if a node represents a user defined snippets object. -// @param Node [in] Node to be checked. -// @return True if node represents user defined object, False if not. -// } -//var -// SnipObj: TObject; // object referenced in Node.Data -//begin -// SnipObj := TObject(Node.Data); -// Result := False; -// if SnipObj is TSnippet then -// Result := (SnipObj as TSnippet).UserDefined -// else if SnipObj is TCategory then -// Result := (SnipObj as TCategory).UserDefined; -//end; - end. diff --git a/Src/FrSelectUserSnippets.pas b/Src/FrSelectUserSnippets.pas index 69ca8307e..b29044d09 100644 --- a/Src/FrSelectUserSnippets.pas +++ b/Src/FrSelectUserSnippets.pas @@ -66,7 +66,6 @@ function TSelectUserSnippetsFrame.CanAddCatNode(const Cat: TCategory): Boolean; @return True if category contains any user-defined snippets. } begin -// Result := Cat.Snippets.Count(True) > 0; Result := not Cat.Snippets.IsEmpty( TCollectionID.__TMP__UserDBCollectionID ); @@ -79,7 +78,6 @@ function TSelectUserSnippetsFrame.CanAddSnippetNode( @return True if snippet is user-defined. } begin -// Result := Snippet.UserDefined; Result := Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID; end; diff --git a/Src/IntfNotifier.pas b/Src/IntfNotifier.pas index 4c15ae69c..40141c9bd 100644 --- a/Src/IntfNotifier.pas +++ b/Src/IntfNotifier.pas @@ -33,16 +33,6 @@ interface /// Requests a database update. procedure UpdateDbase; -// /// Displays a snippet. -// /// WideString [in] Name of required snippet. -// /// -// /// WordBool [in] Indicates whether snippet is -// /// user defined. -// /// WordBool [in] Whether to display snippet in a new -// /// detail pane tab. -// procedure DisplaySnippet(const SnippetName: WideString; -// UserDefined: WordBool; NewTab: WordBool); overload; - /// Displays a snippet. /// WideString [in] Name of required snippet. /// diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index 580bae8b8..d190fc852 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -371,9 +371,6 @@ procedure TCodeImporter.Execute(const Data: TBytes); TXMLDocHelper.GetPascalNameList(fXMLDoc, DependsNode, SnippetNames); Depends.Clear; for SnippetName in SnippetNames do -// // Note: in building snippet ID list we assume each snippet is user- -// // defined. It may not be, but there is no way of telling from XML. -// Depends.Add(TSnippetID.Create(SnippetName, True)); // Note: in building snippet ID list we assume each snippet is from the // standard user collection. It may not be, but there is no way of telling // from XML. diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index 6c8f545f2..a347b21d3 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -185,7 +185,6 @@ function TCodeImportMgr.DisallowedNames(const ExcludedName: string): Result := TIStringList.Create; Result.CaseSensitive := False; for Snippet in Database.Snippets do -// if Snippet.UserDefined then if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then Result.Add(Snippet.Name); for SnippetInfo in fSnippetInfoList do @@ -257,8 +256,6 @@ procedure TCodeImportMgr.UpdateDatabase; for Idx := 0 to Pred(Depends.Count) do begin SnippetID := Depends[Idx]; -// SnippetID.UserDefined := -// Database.Snippets.Find(SnippetID.Name, True) <> nil; CollectionID := TCollectionID.__TMP__UserDBCollectionID; if Database.Snippets.Find(SnippetID.Name, CollectionID) = nil then CollectionID := TCollectionID.__TMP__MainDBCollectionID; @@ -287,7 +284,6 @@ procedure TCodeImportMgr.UpdateDatabase; AdjustDependsList(SnippetInfo.Data.Refs.Depends); -// Snippet := Database.Snippets.Find(ImportInfo.ImportAsName, True); Snippet := Database.Snippets.Find(ImportInfo.ImportAsName, TCollectionID.__TMP__UserDBCollectionID); if Assigned(Snippet) then // snippet already exists: overwrite it diff --git a/Src/UCodeShareMgr.pas b/Src/UCodeShareMgr.pas index e510ef862..367a02b27 100644 --- a/Src/UCodeShareMgr.pas +++ b/Src/UCodeShareMgr.pas @@ -77,7 +77,6 @@ class function TCodeShareMgr.CanShare: Boolean; @return True if user defined snippets exist in database. } begin -// Result := Database.Snippets.Count(True) > 0; Result := not Database.Snippets.IsEmpty( TCollectionID.__TMP__UserDBCollectionID ); @@ -103,7 +102,6 @@ class function TCodeShareMgr.GetSnippetFromView( SnippetView: ISnippetView; // ViewItem as snippet view if supported begin if Supports(ViewItem, ISnippetView, SnippetView) -// and (SnippetView.Snippet.UserDefined) then and (SnippetView.Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) then Result := SnippetView.Snippet else diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 719ef7c11..d34ec1f5b 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -433,7 +433,6 @@ procedure TWelcomePageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); 'externalScript', TJavaScript.LoadScript('external.js', etWindows1252) ); -// UserDBCount := Database.Snippets.Count(True); UserDBCount := Database.Snippets.Count( TCollectionID.__TMP__UserDBCollectionID ); @@ -447,7 +446,6 @@ procedure TWelcomePageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); 'UserDBCount', IntToStr(UserDBCount) ); -// MainDBCount := Database.Snippets.Count(False); MainDBCount := Database.Snippets.Count( TCollectionID.__TMP__MainDBCollectionID ); @@ -528,17 +526,14 @@ procedure TSnippetInfoPageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); 'overflowXFixScript', 'window.onload = null;' ); -// if GetSnippet.UserDefined then if GetSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then Tplt.ResolvePlaceholderHTML('SnippetCSSClass', 'userdb') else Tplt.ResolvePlaceholderHTML('SnippetCSSClass', 'maindb'); Tplt.ResolvePlaceholderHTML( -// 'TestingInfo', TCSS.BlockDisplayProp(not GetSnippet.UserDefined) 'TestingInfo', TCSS.BlockDisplayProp(GetSnippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID) ); Tplt.ResolvePlaceholderHTML( -// 'EditLink', TCSS.BlockDisplayProp(GetSnippet.UserDefined) 'EditLink', TCSS.BlockDisplayProp(GetSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) ); Tplt.ResolvePlaceholderText( @@ -547,7 +542,6 @@ procedure TSnippetInfoPageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); ); SnippetHTML := TSnippetHTML.Create(GetSnippet); try -// if not GetSnippet.UserDefined then if GetSnippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then Tplt.ResolvePlaceholderHTML('TestingInfoImg', SnippetHTML.TestingImage); Tplt.ResolvePlaceholderHTML('SnippetName', SnippetHTML.SnippetName); @@ -673,7 +667,6 @@ function TCategoryPageHTML.GetEmptyListNote: string; function TCategoryPageHTML.GetH1ClassName: string; begin -// if (View as ICategoryView).Category.UserDefined then if (View as ICategoryView).Category.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then Result := 'userdb' else diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index 913593762..310c570e2 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -73,17 +73,6 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) /// Methods of INotifier. procedure UpdateDbase; -// /// Displays a snippet. -// /// WideString [in] Name of required snippet. -// /// -// /// WordBool [in] Indicates whether snippet is -// /// user defined. -// /// WordBool [in] Whether to display snippet in a new -// /// detail pane tab. -// /// Methods of INotifier. -// procedure DisplaySnippet(const SnippetName: WideString; -// UserDefined: WordBool; NewTab: WordBool); overload; - /// Displays a snippet. /// WideString [in] Name of required snippet. /// @@ -277,18 +266,6 @@ procedure TNotifier.DisplaySnippet(const SnippetName: WideString; end; end; -//procedure TNotifier.DisplaySnippet(const SnippetName: WideString; -// UserDefined: WordBool; NewTab: WordBool); -//begin -// if Assigned(fDisplaySnippetAction) then -// begin -// (fDisplaySnippetAction as TSnippetAction).SnippetName := SnippetName; -// (fDisplaySnippetAction as TSnippetAction).UserDefined := UserDefined; -// (fDisplaySnippetAction as TSnippetAction).NewTab := NewTab; -// fDisplaySnippetAction.Execute; -// end; -//end; - procedure TNotifier.EditSnippet(const SnippetName: WideString); begin if Assigned(fEditSnippetAction) then diff --git a/Src/UPreferences.pas b/Src/UPreferences.pas index 3d3d17632..1137db604 100644 --- a/Src/UPreferences.pas +++ b/Src/UPreferences.pas @@ -137,25 +137,6 @@ interface property ShowNewSnippetsInNewTabs: Boolean read GetShowNewSnippetsInNewTabs write SetShowNewSnippetsInNewTabs; -// /// Gets heading colour used for snippets from a specified -// /// database. -// /// Boolean [in] Required database: True for user -// /// database and False for inline database. -// /// TColor. Required colour. -// function GetDBHeadingColour(UserDefined: Boolean): TColor; -// /// Sets heading colour used for snippets from a specified -// /// database. -// /// Boolean [in] Required database: True for user -// /// database and False for online database. -// /// TColor [in] Required heading colour. -// procedure SetDBHeadingColour(UserDefined: Boolean; -// const Value: TColor); -// /// Records colour to be used for headings of items from either -// /// online database (UserDefined = False) or user database (UserDefined = -// /// True). -// property DBHeadingColours[UserDefined: Boolean]: TColor -// read GetDBHeadingColour write SetDBHeadingColour; - /// Gets heading colour used for snippets from a specified /// collection. /// TCollectionID [in] ID of required @@ -170,26 +151,6 @@ interface procedure SetDBHeadingColour(const ACollectionID: TCollectionID; const Value: TColor); -// /// Gets custom colours available for headings for specified -// /// database. -// /// Boolean [in] Required database: True for user -// /// database and False for online database. -// /// IStringList. String list containing custom colours. -// function GetDBHeadingCustomColours(UserDefined: Boolean): IStringList; -// /// Sets custom colours available for headings for specified -// /// database. -// /// Boolean [in] Required database: True for user -// /// database and False for online database. -// /// IStringList [in] String list containing custom -// /// colours. -// procedure SetDBHeadingCustomColours(UserDefined: Boolean; -// Value: IStringList); -// /// Records custom colours available for headings of items from -// /// either online database (UserDefined = False) or user database -// /// (UserDefined = True). -// property DBHeadingCustomColours[UserDefined: Boolean]: IStringList -// read GetDBHeadingCustomColours write SetDBHeadingCustomColours; - /// Gets custom colours available for headings for specified /// collection. /// TCollectionID [in] ID of required @@ -520,14 +481,6 @@ TPreferences = class(TInterfacedObject, /// Method of IPreferences. procedure SetShowNewSnippetsInNewTabs(const Value: Boolean); -// /// Gets heading colour used for snippets from a specified -// /// database. -// /// Boolean [in] Required database: True for user -// /// database and False for inline database. -// /// TColor. Required colour. -// /// Method of IPreferences. -// function GetDBHeadingColour(UserDefined: Boolean): TColor; - /// Gets heading colour used for snippets from a specified /// collection. /// TCollectionID [in] ID of required @@ -536,15 +489,6 @@ TPreferences = class(TInterfacedObject, /// Method of IPreferences. function GetDBHeadingColour(const ACollectionID: TCollectionID): TColor; -// /// Sets heading colour used for snippets from a specified -// /// database. -// /// Boolean [in] Required database: True for user -// /// database and False for online database. -// /// TColor [in] Required heading colour. -// /// Method of IPreferences. -// procedure SetDBHeadingColour(UserDefined: Boolean; -// const Value: TColor); - /// Sets heading colour used for snippets from a specified /// collection. /// TCollectionID [in] ID of required @@ -554,14 +498,6 @@ TPreferences = class(TInterfacedObject, procedure SetDBHeadingColour(const ACollectionID: TCollectionID; const Value: TColor); -// /// Gets custom colours available for headings for specified -// /// database. -// /// Boolean [in] Required database: True for user -// /// database and False for online database. -// /// IStringList. String list containing custom colours. -// /// Method of IPreferences. -// function GetDBHeadingCustomColours(UserDefined: Boolean): IStringList; - /// Gets custom colours available for headings for specified /// collection. /// TCollectionID [in] ID of required @@ -571,16 +507,6 @@ TPreferences = class(TInterfacedObject, function GetDBHeadingCustomColours(const ACollectionID: TCollectionID): IStringList; -// /// Sets custom colours available for headings for specified -// /// database. -// /// Boolean [in] Required database: True for user -// /// database and False for online database. -// /// IStringList [in] String list containing custom -// /// colours. -// /// Method of IPreferences. -// procedure SetDBHeadingCustomColours(UserDefined: Boolean; -// Value: IStringList); - /// Sets custom colours available for headings for specified /// collection. /// TCollectionID [in] ID of required @@ -769,13 +695,9 @@ procedure TPreferences.Assign(const Src: IInterface); Self.fOverviewStartState := SrcPref.OverviewStartState; Self.fShowEmptySections := SrcPref.ShowEmptySections; Self.fShowNewSnippetsInNewTabs := SrcPref.ShowNewSnippetsInNewTabs; -// Self.fDBHeadingColours[False] := SrcPref.DBHeadingColours[False]; Self.SetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID, SrcPref.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); -// Self.fDBHeadingCustomColours[False] := SrcPref.DBHeadingCustomColours[False]; Self.SetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID, SrcPref.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID)); -// Self.fDBHeadingColours[True] := SrcPref.DBHeadingColours[True]; Self.SetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID, SrcPref.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); -// Self.fDBHeadingCustomColours[True] := SrcPref.DBHeadingCustomColours[True]; Self.SetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID, SrcPref.GetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID)); Self.fOverviewFontSize := SrcPref.OverviewFontSize; Self.fDetailFontSize := SrcPref.DetailFontSize; @@ -824,11 +746,6 @@ function TPreferences.GetCustomHiliteColours: IStringList; Result := fHiliteCustomColours; end; -//function TPreferences.GetDBHeadingColour(UserDefined: Boolean): TColor; -//begin -// Result := fDBHeadingColours[UserDefined]; -//end; - function TPreferences.GetDBHeadingColour( const ACollectionID: TCollectionID): TColor; begin @@ -851,12 +768,6 @@ function TPreferences.GetDBHeadingCustomColours( ]; end; -//function TPreferences.GetDBHeadingCustomColours( -// UserDefined: Boolean): IStringList; -//begin -// Result := fDBHeadingCustomColours[UserDefined]; -//end; - function TPreferences.GetDetailFontSize: Integer; begin Result := fDetailFontSize; @@ -957,12 +868,6 @@ procedure TPreferences.SetCustomHiliteColours(const Colours: IStringList); fHiliteCustomColours := Colours; end; -//procedure TPreferences.SetDBHeadingColour(UserDefined: Boolean; -// const Value: TColor); -//begin -// fDBHeadingColours[UserDefined] := Value; -//end; - procedure TPreferences.SetDBHeadingColour(const ACollectionID: TCollectionID; const Value: TColor); begin @@ -985,12 +890,6 @@ procedure TPreferences.SetDBHeadingCustomColours( ] := Value; end; -//procedure TPreferences.SetDBHeadingCustomColours(UserDefined: Boolean; -// Value: IStringList); -//begin -// fDBHeadingCustomColours[UserDefined] := Value; -//end; - procedure TPreferences.SetDetailFontSize(const Value: Integer); begin if TFontHelper.IsInCommonFontSizeRange(Value) then @@ -1119,13 +1018,9 @@ function TPreferencesPersist.Clone: IInterface; NewPref.OverviewStartState := Self.fOverviewStartState; NewPref.ShowEmptySections := Self.fShowEmptySections; NewPref.ShowNewSnippetsInNewTabs := Self.fShowNewSnippetsInNewTabs; -// NewPref.DBHeadingColours[False] := Self.fDBHeadingColours[False]; NewPref.SetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID, Self.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); -// NewPref.DBHeadingCustomColours[False] := Self.fDBHeadingCustomColours[False]; NewPref.SetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID, Self.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID)); -// NewPref.DBHeadingColours[True] := Self.fDBHeadingColours[True]; NewPref.SetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID, Self.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); -// NewPref.DBHeadingCustomColours[True] := Self.fDBHeadingCustomColours[True]; NewPref.SetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID, Self.GetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID)); NewPref.OverviewFontSize := Self.fOverviewFontSize; NewPref.DetailFontSize := Self.fDetailFontSize; @@ -1168,16 +1063,10 @@ constructor TPreferencesPersist.Create; fShowNewSnippetsInNewTabs := Storage.GetBoolean( 'ShowNewSnippetsInNewTabs', False ); -// fDBHeadingColours[False] := TColor( -// Storage.GetInteger('MainDBHeadingColour', clMainSnippet) -// ); SetDBHeadingColour( TCollectionID.__TMP__MainDBCollectionID, TColor(Storage.GetInteger('MainDBHeadingColour', clMainSnippet)) ); -// fDBHeadingColours[True] := TColor( -// Storage.GetInteger('UserDBHeadingColour', clUserSnippet) -// ); SetDBHeadingColour( TCollectionID.__TMP__UserDBCollectionID, TColor(Storage.GetInteger('UserDBHeadingColour', clUserSnippet)) @@ -1265,12 +1154,10 @@ destructor TPreferencesPersist.Destroy; Storage.SetInteger('OverviewStartState', Ord(fOverviewStartState)); Storage.SetBoolean('ShowEmptySections', fShowEmptySections); Storage.SetBoolean('ShowNewSnippetsInNewTabs', fShowNewSnippetsInNewTabs); -// Storage.SetInteger('MainDBHeadingColour', fDBHeadingColours[False]); Storage.SetInteger( 'MainDBHeadingColour', GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID) ); -// Storage.SetInteger('UserDBHeadingColour', fDBHeadingColours[True]); Storage.SetInteger( 'UserDBHeadingColour', GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID) diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index 6e2b0a6ea..35070366e 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -104,8 +104,6 @@ constructor TRTFCategoryDoc.Create(const UseColour: Boolean); fBuilder.FontTable.Add(MainFontName, rgfSwiss, 0); fBuilder.FontTable.Add(MonoFontName, rgfModern, 0); // Set up colour table -// fBuilder.ColourTable.Add(Preferences.DBHeadingColours[False]); -// fBuilder.ColourTable.Add(Preferences.DBHeadingColours[True]); {TODO -cCollection: Replace following 2 statements with loop that iterates over all collections.} fBuilder.ColourTable.Add(Preferences.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); @@ -218,8 +216,6 @@ procedure TRTFCategoryDoc.OutputCategoryHeading(const Category: TCategory); fBuilder.SetFont(MainFontName); fBuilder.SetFontSize(HeadingFontSize); fBuilder.SetFontStyle([fsBold]); -// SetColour(Preferences.DBHeadingColours[Category.UserDefined]); -// SetColour(Preferences.DBHeadingColours[Category.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]); SetColour(Preferences.GetDBHeadingColour(Category.CollectionID)); fBuilder.AddText(Category.Description); fBuilder.EndPara; @@ -233,8 +229,6 @@ procedure TRTFCategoryDoc.OutputSnippetSubHeading(const Snippet: TSnippet); fBuilder.SetFont(MainFontName); fBuilder.SetFontSize(SubHeadingFontSize); fBuilder.SetFontStyle([fsBold]); -// SetColour(Preferences.DBHeadingColours[Snippet.UserDefined]); -// SetColour(Preferences.DBHeadingColours[Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID]); SetColour(Preferences.GetDBHeadingColour(Snippet.CollectionID)); fBuilder.AddText(Snippet.DisplayName); fBuilder.EndPara; diff --git a/Src/URTFSnippetDoc.pas b/Src/URTFSnippetDoc.pas index 948fc31cb..6781dd3a6 100644 --- a/Src/URTFSnippetDoc.pas +++ b/Src/URTFSnippetDoc.pas @@ -76,14 +76,6 @@ TRTFSnippetDoc = class(TSnippetDoc) strict protected /// Initialises rich text document. procedure InitialiseDoc; override; - -// /// Adds given heading (i.e. snippet name) to document. Can be -// /// user defined or from main database. -// /// Heading is coloured according to whether user defined or not. -// /// -// procedure RenderHeading(const Heading: string; const UserDefined: Boolean); -// override; - /// Output given heading, i.e. snippet name for snippet from a /// given collection.. /// Heading is coloured according the the snippet's collection. @@ -181,8 +173,6 @@ procedure TRTFSnippetDoc.InitialiseDoc; fBuilder.ColourTable.Add(clWarningText); fBuilder.ColourTable.Add(clVarText); fBuilder.ColourTable.Add(clExternalLink); -// fBuilder.ColourTable.Add(Preferences.DBHeadingColours[False]); -// fBuilder.ColourTable.Add(Preferences.DBHeadingColours[True]); { TODO -cCollections: Replace following two statements with iteration over all supported collections when support for multiple collections is added. } @@ -430,18 +420,6 @@ procedure TRTFSnippetDoc.RenderExtra(const ExtraText: IActiveText); end; end; -//procedure TRTFSnippetDoc.RenderHeading(const Heading: string; -// const UserDefined: Boolean); -//begin -// fBuilder.SetFontStyle([fsBold]); -// fBuilder.SetFontSize(HeadingFontSize); -// if fUseColour then -// fBuilder.SetColour(Preferences.DBHeadingColours[UserDefined]); -// fBuilder.SetParaSpacing(TRTFParaSpacing.Create(0.0, ParaSpacing)); -// fBuilder.AddText(Heading); -// fBuilder.EndPara; -//end; - procedure TRTFSnippetDoc.RenderHeading(const Heading: string; const ACollectionID: TCollectionID); begin diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index 6c4207812..eb6c2f9d7 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -263,7 +263,6 @@ constructor TSaveUnitMgr.InternalCreate(const Snips: TSnippetList); fContainsMainDBSnippets := False; for Snippet in Snips do begin -// if not Snippet.UserDefined then if Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then begin fContainsMainDBSnippets := True; diff --git a/Src/USnippetAction.pas b/Src/USnippetAction.pas index 9030c671b..6f801e5bc 100644 --- a/Src/USnippetAction.pas +++ b/Src/USnippetAction.pas @@ -37,8 +37,6 @@ TSnippetAction = class(TBasicAction, ISetNotifier) var /// Value of SnippetName property. fSnippetName: string; -// /// Value of UserDefined property. -// fUserDefined: Boolean; /// Value of CollectionID property. fCollectionID: TCollectionID; /// Value of NewTab property. @@ -61,9 +59,6 @@ TSnippetAction = class(TBasicAction, ISetNotifier) procedure SetNotifier(const Notifier: INotifier); /// Name of snippet to be displayed. property SnippetName: string read fSnippetName write fSnippetName; -// /// Flag indicating whether snippet to be displayed is user -// /// defined. -// property UserDefined: Boolean read fUserDefined write fUserDefined; /// ID of the collection containing the snippet to be displayed. /// property CollectionID: TCollectionID read fCollectionID write fCollectionID; @@ -91,7 +86,6 @@ function TSnippetAction.Execute: Boolean; begin Assert(Assigned(fNotifier), ClassName + '.Execute: Notifier not set'); Assert(SnippetName <> '', ClassName + '.Execute: SnippetName not provided'); -// Snippet := Database.Snippets.Find(SnippetName, UserDefined); Snippet := Database.Snippets.Find(SnippetName, fCollectionID); Assert(Assigned(Snippet), ClassName + '.Execute: SnippetName not valid'); // Create a view item for snippet and get notifier to display it diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index 7e679a52c..7d9e9763b 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -62,13 +62,6 @@ TSnippetDoc = class(TObject) /// initialisation here. procedure InitialiseDoc; virtual; -// /// Output given heading, i.e. snippet name. Can be user defined -// /// or from main database. -// /// Heading may be rendered differently depending on whether user -// /// defined or not. -// procedure RenderHeading(const Heading: string; const UserDefined: Boolean); -// virtual; abstract; - /// Output given heading, i.e. snippet name for snippet from a /// given collection.. /// Heading may be rendered differently depending on the snippet's @@ -187,7 +180,6 @@ function TSnippetDoc.Generate(const Snippet: TSnippet): TEncodedData; Assert(Assigned(Snippet), ClassName + '.Create: Snippet is nil'); // generate document InitialiseDoc; -// RenderHeading(Snippet.DisplayName, Snippet.UserDefined); RenderHeading(Snippet.DisplayName, Snippet.CollectionID); RenderDescription(Snippet.Description); RenderSourceCode(Snippet.SourceCode); @@ -210,7 +202,6 @@ function TSnippetDoc.Generate(const Snippet: TSnippet): TEncodedData; end; if Snippet.Extra.HasContent then RenderExtra(Snippet.Extra); -// if not Snippet.UserDefined then if Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then // database info written only if snippet is from main database RenderDBInfo(MainDBInfo); diff --git a/Src/USnippetIDListIOHandler.pas b/Src/USnippetIDListIOHandler.pas index ef527540e..a67a37b67 100644 --- a/Src/USnippetIDListIOHandler.pas +++ b/Src/USnippetIDListIOHandler.pas @@ -110,9 +110,6 @@ procedure TSnippetIDListFileReader.Parse; raise ESnippetIDListFileReader.CreateFmt(sMissingName, [Line]); if UserDefStr = '' then raise ESnippetIDListFileReader.CreateFmt(sMissingUserDef, [Line]); -// if not TryStrToInt(UserDefStr, UserDefInt) -// or not (UserDefInt in [0, 1]) then -// raise ESnippetIDListFileReader.CreateFmt(sBadUserDef, [Line]); if not TryStrToInt(UserDefStr, UserDefInt) then raise ESnippetIDListFileReader.CreateFmt(sBadUserDef, [Line]); case UserDefInt of @@ -121,7 +118,6 @@ procedure TSnippetIDListFileReader.Parse; else raise ESnippetIDListFileReader.CreateFmt(sBadUserDef, [Line]); end; -// fSnippetIDs.Add(TSnippetID.Create(Name, Boolean(UserDefInt))); fSnippetIDs.Add(TSnippetID.Create(Name, CollectionID)); end; end; @@ -168,9 +164,6 @@ procedure TSnippetIDListFileWriter.CreateContent( begin fBuilder.Append(SnippetID.Name); fBuilder.Append(TAB); - // NOTE: TStringBuilder.Append(Boolean) override not used here since ordinal - // value wanted instead of "True" or "False" or localised equivalent. -// fBuilder.Append(Ord(SnippetID.UserDefined)); fBuilder.Append(Ord(SnippetID.CollectionID <> TCollectionID.__TMP__MainDBCollectionID)); fBuilder.AppendLine; end; diff --git a/Src/USnippetIDs.pas b/Src/USnippetIDs.pas index 9619e6543..81b5c7bc7 100644 --- a/Src/USnippetIDs.pas +++ b/Src/USnippetIDs.pas @@ -33,28 +33,18 @@ TSnippetID = record var /// Value of Name property. fName: string; -// /// Value of UserDefined property. -// fUserDefined: Boolean; fCollectionID: TCollectionID; procedure SetCollectionID(const AValue: TCollectionID); public /// Name of snippet. property Name: string read fName write fName; - /// Whether snippet is user defined. -// property UserDefined: Boolean read fUserDefined write fUserDefined; - {TODO -cCollections: Remove above property & getter/setter} - /// ID of the collection to which a snippet with this ID belongs. /// /// ID must not be null. property CollectionID: TCollectionID read fCollectionID write SetCollectionID; -// /// Creates a record with given property values. -// constructor Create(const AName: string; const AUserDefined: Boolean); -// overload; {TODO -cCollections: remove constructor} - /// Creates a record with given property values. /// ACollectionID must not be null. constructor Create(const AName: string; const ACollectionID: TCollectionID); @@ -186,7 +176,6 @@ function TSnippetID.CompareTo(const SID: TSnippetID): Integer; if Result = 0 then // TODO -cNote: New comparison changes ordering (no problem tho!) Result := TCollectionID.Compare(CollectionID, SID.CollectionID); -// Result := Ord(UserDefined) - Ord(SID.UserDefined); end; constructor TSnippetID.Create(const AName: string; @@ -196,12 +185,6 @@ constructor TSnippetID.Create(const AName: string; SetCollectionID(ACollectionID); end; -//constructor TSnippetID.Create(const AName: string; const AUserDefined: Boolean); -//begin -// fName := AName; -// fUserDefined := AUserDefined); -//end; - class operator TSnippetID.Equal(const SID1, SID2: TSnippetID): Boolean; begin Result := SID1.CompareTo(SID2) = 0; diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index b6cf42688..d0bcd3721 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -244,7 +244,6 @@ procedure TSnippetSourceGen.Initialize(View: IView); // view is single snippet: just record that Snippet := (View as ISnippetView).Snippet; fGenerator.IncludeSnippet(Snippet); -// fContainsMainDBSnippets := not Snippet.UserDefined; fContainsMainDBSnippets := Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID; end else @@ -256,7 +255,6 @@ procedure TSnippetSourceGen.Initialize(View: IView); fGenerator.IncludeSnippets(Snips); // ignores freeform snippets for Snippet in Snips do begin -// if not Snippet.UserDefined then if Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then begin fContainsMainDBSnippets := True; diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index b5204b771..0fc8ef764 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -373,7 +373,6 @@ class function TSnippetValidator.ValidateName(const Name: string; else if not IsValidIdent(TrimmedName) then ErrorMsg := Format(sErrBadName, [TrimmedName]) else if CheckForUniqueness and -// (Database.Snippets.Find(TrimmedName, True) <> nil) then (Database.Snippets.Find(TrimmedName, TCollectionID.__TMP__UserDBCollectionID) <> nil) then ErrorMsg := Format(sErrDupName, [TrimmedName]) else diff --git a/Src/USnippetsChkListMgr.pas b/Src/USnippetsChkListMgr.pas index d1bd0c842..b8b8b708a 100644 --- a/Src/USnippetsChkListMgr.pas +++ b/Src/USnippetsChkListMgr.pas @@ -203,9 +203,6 @@ procedure TSnippetsChkListMgr.DrawItem(Control: TWinControl; Index: Integer; Assert(fCLB = Control, ClassName + '.DrawItem: Control <> fCLB'); Canvas := fCLB.Canvas; if not (odSelected in State) then -// Canvas.Font.Color := Preferences.DBHeadingColours[ -//// (fCLB.Items.Objects[Index] as TSnippet).UserDefined -// ]; Canvas.Font.Color := Preferences.GetDBHeadingColour( (fCLB.Items.Objects[Index] as TSnippet).CollectionID ); diff --git a/Src/USnippetsTVDraw.pas b/Src/USnippetsTVDraw.pas index 99f1c9950..073444c3d 100644 --- a/Src/USnippetsTVDraw.pas +++ b/Src/USnippetsTVDraw.pas @@ -41,13 +41,6 @@ TSnippetsTVDraw = class abstract(TObject) function GetCollectionID(const Node: TTreeNode): TCollectionID; virtual; abstract; -// function IsUserDefinedNode(const Node: TTreeNode): Boolean; -// virtual; abstract; -// {Checks if a node represents a user defined snippets object. -// @param Node [in] Node to be checked. -// @return True if node represents user defined object, False if not. -// } - function IsSectionHeadNode(const Node: TTreeNode): Boolean; virtual; {Checks if a node represents a section header. @@ -131,7 +124,6 @@ procedure TSnippetsTVDraw.CustomDrawItem(Sender: TCustomTreeView; TV.Canvas.Font.Color := clWarningText else TV.Canvas.Font.Color := -// Preferences.DBHeadingColours[IsUserDefinedNode(Node)]; Preferences.GetDBHeadingColour(GetCollectionID(Node)); TV.Canvas.Brush.Color := TV.Color; end; diff --git a/Src/UStatusBarMgr.pas b/Src/UStatusBarMgr.pas index 3cf6aad69..f6aa4fa1d 100644 --- a/Src/UStatusBarMgr.pas +++ b/Src/UStatusBarMgr.pas @@ -362,7 +362,6 @@ procedure TStatusBarMgr.ShowSnippetsInfo; begin // Calculate database stats TotalSnippets := Database.Snippets.Count; -// TotalUserSnippets := Database.Snippets.Count(True); TotalUserSnippets := Database.Snippets.Count( TCollectionID.__TMP__UserDBCollectionID ); diff --git a/Src/UTextSnippetDoc.pas b/Src/UTextSnippetDoc.pas index 70babef0a..4e7710b5b 100644 --- a/Src/UTextSnippetDoc.pas +++ b/Src/UTextSnippetDoc.pas @@ -46,13 +46,6 @@ TTextSnippetDoc = class(TSnippetDoc) /// Initialises plain text document. procedure InitialiseDoc; override; -// /// Adds given heading (i.e. snippet name) to document. Can be -// /// user defined or from main database. -// /// Heading is output the same whether user defined or not, so -// /// UserDefined parameter is ignored. -// procedure RenderHeading(const Heading: string; const UserDefined: Boolean); -// override; - /// Output given heading, i.e. snippet name for snippet from a /// given collection. /// Heading is output the same regardless of the snippet's @@ -179,12 +172,6 @@ procedure TTextSnippetDoc.RenderHeading(const Heading: string; fWriter.WriteLine(Heading); end; -//procedure TTextSnippetDoc.RenderHeading(const Heading: string; -// const UserDefined: Boolean); -//begin -// fWriter.WriteLine(Heading); -//end; - procedure TTextSnippetDoc.RenderNoCompilerInfo(const Heading, NoCompileTests: string); begin diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 88fda6c5c..04f11cbb2 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -294,7 +294,6 @@ class function TUserDBMgr.CanEdit(ViewItem: IView): Boolean; Assert(Assigned(ViewItem), ClassName + '.CanEdit: ViewItem is nil'); Result := Assigned(ViewItem) and Supports(ViewItem, ISnippetView, SnippetView) -// and SnippetView.Snippet.UserDefined; and (SnippetView.Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID); end; @@ -363,7 +362,6 @@ class function TUserDBMgr.CreateUserCatList( begin Result := TCategoryList.Create; for Cat in Database.Categories do -// if Cat.UserDefined and if (Cat.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) and (IncludeSpecial or not TReservedCategories.IsReserved(Cat)) then Result.Add(Cat); @@ -425,8 +423,6 @@ class procedure TUserDBMgr.DeleteSnippet(ViewItem: IView); Assert(Supports(ViewItem, ISnippetView), ClassName + '.Delete: Current view is not a snippet'); Snippet := (ViewItem as ISnippetView).Snippet; -// Assert(Snippet.UserDefined, -// ClassName + '.Delete: Snippet must be user defined'); Assert(Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, ClassName + '.Delete: Snippet must be user defined'); // Check if snippet has dependents: don't allow deletion if so @@ -469,7 +465,6 @@ class procedure TUserDBMgr.EditSnippet(const SnippetName: string); var Snippet: TSnippet; // reference to snippet to be edited begin -// Snippet := Database.Snippets.Find(SnippetName, True); Snippet := Database.Snippets.Find(SnippetName, TCollectionID.__TMP__UserDBCollectionID); if not Assigned(Snippet) then raise EBug.Create(ClassName + '.EditSnippet: Snippet not in user database'); diff --git a/Src/UView.pas b/Src/UView.pas index db192a255..36e28553d 100644 --- a/Src/UView.pas +++ b/Src/UView.pas @@ -60,8 +60,6 @@ interface /// without having have an instance of any object wrapped by the view. /// function GetKey: IViewKey; -// /// Checks if view is user-defined. -// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// A grouping is a view that groups views together. /// @@ -234,9 +232,6 @@ TKey = class(TInterfacedObject, IViewKey) /// Gets object containing view's unique key. /// Method of IView. function GetKey: IViewKey; -// /// Checks if view is user-defined. -// /// Method of IView. -// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// Method of IView. function IsGrouping: Boolean; @@ -324,8 +319,6 @@ TKey = class(TInterfacedObject, IViewKey) /// Gets object containing view's unique key. /// Method of IView. function GetKey: IViewKey; -// /// Checks if view is user-defined. -// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// Method of IView. function IsGrouping: Boolean; @@ -371,9 +364,6 @@ TKey = class(TInterfacedObject, IViewKey) /// Gets object containing view's unique key. /// Method of IView. function GetKey: IViewKey; -// /// Checks if view is user-defined. -// /// Method of IView. -// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// Method of IView. function IsGrouping: Boolean; @@ -421,9 +411,6 @@ TKey = class(TInterfacedObject, IViewKey) /// Gets object containing view's unique key. /// Method of IView. function GetKey: IViewKey; -// /// Checks if view is user-defined. -// /// Method of IView. -// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// Method of IView. function IsGrouping: Boolean; @@ -471,9 +458,6 @@ TKey = class(TInterfacedObject, IViewKey) /// Gets object containing view's unique key. /// Method of IView. function GetKey: IViewKey; -// /// Checks if view is user-defined. -// /// Method of IView. -// function IsUserDefined: Boolean; /// Checks if view is a grouping. /// Method of IView. function IsGrouping: Boolean; @@ -499,11 +483,6 @@ function TSimpleView.IsGrouping: Boolean; Result := False; end; -//function TSimpleView.IsUserDefined: Boolean; -//begin -// Result := False; -//end; - { TSimpleView.TKey } constructor TSimpleView.TKey.Create(OwnerClass: TClass); @@ -590,11 +569,6 @@ function TSnippetView.IsGrouping: Boolean; Result := False; end; -//function TSnippetView.IsUserDefined: Boolean; -//begin -// Result := GetSnippet.UserDefined; -//end; - { TSnippetView.TKey } constructor TSnippetView.TKey.Create(const ID: TSnippetID); @@ -649,11 +623,6 @@ function TCategoryView.IsGrouping: Boolean; Result := True; end; -//function TCategoryView.IsUserDefined: Boolean; -//begin -// Result := GetCategory.UserDefined; -//end; - { TCategoryView.TKey } constructor TCategoryView.TKey.Create(const ID: string); @@ -706,11 +675,6 @@ function TSnippetKindView.IsGrouping: Boolean; Result := True; end; -//function TSnippetKindView.IsUserDefined: Boolean; -//begin -// Result := False; -//end; - { TSnippetKindView.TKey } constructor TSnippetKindView.TKey.Create(const ID: TSnippetKind); @@ -763,11 +727,6 @@ function TInitialLetterView.IsGrouping: Boolean; Result := True; end; -//function TInitialLetterView.IsUserDefined: Boolean; -//begin -// Result := False; -//end; - { TInitialLetterView.TKey } constructor TInitialLetterView.TKey.Create(const ID: TInitialLetter); diff --git a/Src/UWBExternal.pas b/Src/UWBExternal.pas index e219ecb10..5e0b5ba08 100644 --- a/Src/UWBExternal.pas +++ b/Src/UWBExternal.pas @@ -57,17 +57,6 @@ TWBExternal = class(TAutoIntfObject, IWBExternal15, ISetNotifier) /// Method of IWBExternal15. procedure UpdateDbase; safecall; -// /// Displays a named snippet. -// /// WideString [in] Name of snippet to be -// /// displayed. -// /// WordBool [in] Whether the snippet is user -// /// defined. -// /// WordBool [in] Whether to display snippet in a new -// /// tab. -// /// Method of IWBExternal14. -// procedure DisplaySnippet(const SnippetName: WideString; -// UserDefined: WordBool; NewTab: WordBool); safecall; - /// Displays the Configure Compilers dialogue box. /// Displays a named snippet. /// WideString [in] Name of snippet to be @@ -184,17 +173,6 @@ procedure TWBExternal.DisplaySnippet(const SnippetName, end; end; -//procedure TWBExternal.DisplaySnippet(const SnippetName: WideString; -// UserDefined: WordBool; NewTab: WordBool); -//begin -// try -// if Assigned(fNotifier) then -// fNotifier.DisplaySnippet(SnippetName, UserDefined, NewTab); -// except -// HandleException; -// end; -//end; - procedure TWBExternal.EditSnippet(const SnippetName: WideString); begin try From 6e6d67a2d16a8cade5ccf7ba43536f7c93dcc096 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 4 Nov 2024 20:48:35 +0000 Subject: [PATCH 034/222] Revise dbase I/O to get data format from collection Revised TDatabaseIOFactory to create loader/saver object based on the data format associated with a collection. Only applied to data formats for "main" and "user" collections. Did not get database path / file information from collection, only format kind. Revised TDatabase's .Load & .Save methods to get collection associated with user and main databases and to use those to load / save the data. Added placeholder for code that can write "main" database. This code currently does nothing for compatibility with CodeSnip 4. --- Src/DB.UDatabaseIO.pas | 104 ++++++++++++++++++++++++++--------------- Src/DB.UMain.pas | 78 ++++++++++++++++++++++++++++--- 2 files changed, 137 insertions(+), 45 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index b94509019..937172c8d 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -21,7 +21,12 @@ interface uses // Project - DB.UCategory, DB.UMain, DB.USnippet, UBaseObjects, UExceptions; + DB.UCollections, + DB.UCategory, + DB.UMain, + DB.USnippet, + UBaseObjects, + UExceptions; type @@ -72,19 +77,17 @@ interface } TDatabaseIOFactory = class(TNoConstructObject) public - class function CreateMainDBLoader: IDatabaseLoader; - {Creates an object to use to load the main database. - @return Required object instance. - } - class function CreateUserDBLoader: IDatabaseLoader; - {Creates an object to use to load the user database. - @return Required object instance. - } - class function CreateWriter: IDatabaseWriter; - {Create an object that can write user defined data from the Database - object to storage. - @return Required object instance. - } + /// Creates and returns an object to be used to load the given + /// collection's data. Nil is return if no loader object is supported. + /// + class function CreateDBLoader(const Collection: TCollection): + IDatabaseLoader; + + /// Creates and returns an object to be used to save the given + /// collection's data. Nil is return if no saver object is supported. + /// + class function CreateDBWriter(const Collection: TCollection): + IDatabaseWriter; end; { @@ -101,9 +104,15 @@ implementation // Delphi SysUtils, // Project - DB.UCollections, - DBIO.UFileIOIntf, DBIO.UIniDataReader, DBIO.UNulDataReader, DBIO.UXMLDataIO, - UAppInfo, UConsts, UIStringList, UReservedCategories, USnippetIDs; + DBIO.UFileIOIntf, + DBIO.UIniDataReader, + DBIO.UNulDataReader, + DBIO.UXMLDataIO, + UAppInfo, + UConsts, + UIStringList, + UReservedCategories, + USnippetIDs; type @@ -125,6 +134,7 @@ TDatabaseLoader = class(TInterfacedObject, IDatabaseLoader) fSnipList: TSnippetList; // Receives list of snippets fCategories: TCategoryList; // Receives list of categories fFactory: IDBDataItemFactory; // Object creates new categories and snippets + fCollection: TCollection; // Collection being loaded procedure LoadSnippets(const Cat: TCategory); {Loads all snippets in a category. @param Cat [in] Category to be loaded. @@ -183,7 +193,9 @@ TDatabaseLoader = class(TInterfacedObject, IDatabaseLoader) } property Categories: TCategoryList read fCategories; {Reference to category list} + property Collection: TCollection read fCollection; public + constructor Create(const ACollection: TCollection); { IDatabaseLoader method } procedure Load(const SnipList: TSnippetList; const Categories: TCategoryList; @@ -274,6 +286,7 @@ TDatabaseWriter = class(TInterfacedObject, fSnipList: TSnippetList; // List of snippets to be written fCategories: TCategoryList; // List of categories to be written fProvider: IDBDataProvider; // Object used to get data to be written + fCollection: TCollection; // Collection being written function CreateWriter: IDataWriter; {Creates object that can write data for user-defined database to storage. @return Requied writer object. @@ -285,6 +298,7 @@ TDatabaseWriter = class(TInterfacedObject, {Writes information about all snippets to storage. } public + constructor Create(const ACollection: TCollection); { IDatabaseWriter method } procedure Write(const SnipList: TSnippetList; const Categories: TCategoryList; @@ -301,33 +315,42 @@ TDatabaseWriter = class(TInterfacedObject, { TDatabaseIOFactory } -class function TDatabaseIOFactory.CreateMainDBLoader: IDatabaseLoader; - {Creates an object to use to load the main database. - @return Required object instance. - } +class function TDatabaseIOFactory.CreateDBLoader(const Collection: TCollection): + IDatabaseLoader; begin - Result := TMainDatabaseLoader.Create; + {TODO -cCollections: Revise database loaders to get file path and other + info from collection instead of hard wiring it.} + case Collection.CollectionFormatKind of + TCollectionFormatKind.DCSC_v2: + Result := TMainDatabaseLoader.Create(Collection); + TCollectionFormatKind.Native_v4: + Result := TUserDatabaseLoader.Create(Collection); + else + Result := nil; + end; end; -class function TDatabaseIOFactory.CreateUserDBLoader: IDatabaseLoader; - {Creates an object to use to load the user database. - @return Required object instance. - } +class function TDatabaseIOFactory.CreateDBWriter( + const Collection: TCollection): IDatabaseWriter; begin - Result := TUserDatabaseLoader.Create; + case Collection.CollectionFormatKind of + TCollectionFormatKind.DCSC_v2: + Result := nil; {TODO -cVault: add writer object here} + TCollectionFormatKind.Native_v4: + Result := TDatabaseWriter.Create(Collection); + else + Result := nil; + end; end; -class function TDatabaseIOFactory.CreateWriter: IDatabaseWriter; - {Create an object that can write user defined data from the Database object to - storage. - @return Required object instance. - } +{ TDatabaseLoader } + +constructor TDatabaseLoader.Create(const ACollection: TCollection); begin - Result := TDatabaseWriter.Create; + inherited Create; + fCollection := ACollection; end; -{ TDatabaseLoader } - procedure TDatabaseLoader.CreateCategory(const CatID: string; const CatData: TCategoryData); {Creates a new category and adds it to the categories list. @@ -335,7 +358,6 @@ procedure TDatabaseLoader.CreateCategory(const CatID: string; @param CatData [in] Properties of category. } begin -// fCategories.Add(fFactory.CreateCategory(CatID, IsUserDatabase, CatData)); fCategories.Add(fFactory.CreateCategory(CatID, CollectionID, CatData)); end; @@ -509,7 +531,7 @@ function TMainDatabaseLoader.CreateReader: IDataReader; @return Reader object instance. } begin - Result := TIniDataReader.Create(TAppInfo.AppDataDir); + Result := TIniDataReader.Create(Collection.Location.Directory); if not Result.DatabaseExists then Result := TNulDataReader.Create; end; @@ -549,7 +571,7 @@ function TUserDatabaseLoader.CreateReader: IDataReader; @return Reader object instance. } begin - Result := TXMLDataReader.Create(TAppInfo.UserDataDir); + Result := TXMLDataReader.Create(Collection.Location.Directory); if not Result.DatabaseExists then Result := TNulDataReader.Create; end; @@ -601,6 +623,12 @@ procedure TUserDatabaseLoader.LoadCategories; { TDatabaseWriter } +constructor TDatabaseWriter.Create(const ACollection: TCollection); +begin + inherited Create; + fCollection := ACollection; +end; + function TDatabaseWriter.CreateWriter: IDataWriter; {Creates object that can write data for user-defined items from Database to storage. diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index f60ef54ae..f6fefca65 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -969,18 +969,47 @@ procedure TDatabase.Load; } var Factory: IDBDataItemFactory; // object reader uses to create snippets objects + MainCollectionIdx, UserCollectionIdx: Integer; + Loader: IDatabaseLoader; + Collections: TCollections; + Collection: TCollection; begin Clear; + // Create factory that reader calls into to create category and snippet // objects. This is done to keep updating of snippet and categories private // to this unit Factory := TDBDataItemFactory.Create; + + Collections := TCollections.Instance; + + {TODO: -cVault: The following code is a kludge to maintain compatibility with + CodeSnip 4. In CodeSnip Vault we should iterate over all collections + creating a loader for each one. } + try - // Load main database: MUST do this first since user database can - // reference objects in main database - TDatabaseIOFactory.CreateMainDBLoader.Load(fSnippets, fCategories, Factory); - // Load any user database - TDatabaseIOFactory.CreateUserDBLoader.Load(fSnippets, fCategories, Factory); + MainCollectionIdx := TCollections.Instance.IndexOfID( + TCollectionID.__TMP__MainDBCollectionID + ); + if MainCollectionIdx >= 0 then + begin + Collection := Collections[MainCollectionIdx]; + Loader := TDatabaseIOFactory.CreateDBLoader(Collection); + if Assigned(Loader) then + Loader.Load(fSnippets, fCategories, Factory); + end; + + UserCollectionIdx := TCollections.Instance.IndexOfID( + TCollectionID.__TMP__UserDBCollectionID + ); + if UserCollectionIdx >= 0 then + begin + Collection := Collections[UserCollectionIdx]; + Loader := TDatabaseIOFactory.CreateDBLoader(Collection); + if Assigned(Loader) then + Loader.Load(fSnippets, fCategories, Factory); + end; + fUpdated := False; except // If an exception occurs clear the database @@ -1002,11 +1031,46 @@ procedure TDatabase.Save; } var Provider: IDBDataProvider; // object that supplies info to writer + MainCollectionIdx, UserCollectionIdx: Integer; + Saver: IDatabaseWriter; + Collections: TCollections; + Collection: TCollection; begin // Create object that can provide required information about user database Provider := TUserDataProvider.Create(fSnippets, fCategories); - // Use a writer object to write out the database - TDatabaseIOFactory.CreateWriter.Write(fSnippets, fCategories, Provider); + + Collections := TCollections.Instance; + + {TODO: -cVault: The following code is a kludge to maintain compatibility with + CodeSnip 4. In CodeSnip Vault we should iterate over all collections + creating a writer for each one. } + + // *** The following code is a stub for later versions. For CodeSnip 4 + // compatibility this code does nothing because there is no writer for + // the "main" collection. TDatabaseIOFactory.CreateDBWriter will return + // nil for this format, so Saver.Write will never be called. + MainCollectionIdx := TCollections.Instance.IndexOfID( + TCollectionID.__TMP__MainDBCollectionID + ); + if MainCollectionIdx >= 0 then + begin + Collection := Collections[MainCollectionIdx]; + Saver := TDatabaseIOFactory.CreateDBWriter(Collection); + if Assigned(Saver) then + Saver.Write(fSnippets, fCategories, Provider); + end; + + UserCollectionIdx := TCollections.Instance.IndexOfID( + TCollectionID.__TMP__UserDBCollectionID + ); + if UserCollectionIdx >= 0 then + begin + Collection := Collections[UserCollectionIdx]; + Saver := TDatabaseIOFactory.CreateDBWriter(Collection); + if Assigned(Saver) then + Saver.Write(fSnippets, fCategories, Provider); + end; + fUpdated := False; end; From b8390e3b018f61d6ccec269a14327156c336886e Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 5 Nov 2024 11:19:37 +0000 Subject: [PATCH 035/222] Change method of recording user-defined db location User defined database location was originally recorded in [Database] settings section in the config file. Since collections were added it was also stored in the user-defined collection's [Collection:X] settings section, which was a source of a bug that meant that database moves were not being recorded consistently. Removed the [Database] section and revised all relevant code to both get and set the loaction from/to the [Collection:X] section. This made the [Database] section redundant. Updated database moving code in UUserDBMove to read/write database location using the singleton Collections object. Modified TAppInfo to get the user database path from the singleton Collections object instead of settings. Removed support for redundant [Database] section from settings object. --- Src/UAppInfo.pas | 40 ++++++++-------------------------------- Src/USettings.pas | 4 +--- Src/UUserDBMove.pas | 15 +++++++++++++-- 3 files changed, 22 insertions(+), 37 deletions(-) diff --git a/Src/UAppInfo.pas b/Src/UAppInfo.pas index 7bc91fd6e..67f967565 100644 --- a/Src/UAppInfo.pas +++ b/Src/UAppInfo.pas @@ -63,13 +63,6 @@ TAppInfo = class(TNoConstructObject) files. @return Full path to required directory. } - class procedure ChangeUserDataDir(const NewDir: string); - {Changes directory where CodeSnip stores the user's "database" files and - records it in the user config file. - Does nothing on portable edition since it does not permit the user - database to be moved. - @param NewDir [in] New directory. - } class function AppExeFilePath: string; {Returns fully specified name of program's executable file. @return Name of file. @@ -115,6 +108,7 @@ implementation // Delphi SysUtils, // Project + DB.UCollections, USettings, UStrUtils, USystemInfo, @@ -156,28 +150,6 @@ class function TAppInfo.AppExeFilePath: string; Result := ParamStr(0); end; -class procedure TAppInfo.ChangeUserDataDir(const NewDir: string); - {Changes directory where CodeSnip stores the user's "database" files and - records it in the user config file. - Does nothing on portable edition since it does not permit the user database - to be moved. - @param NewDir [in] New directory. - } -{$IFNDEF PORTABLE} -var - Section: ISettingsSection; -{$ENDIF} -begin - {$IFNDEF PORTABLE} - Section := Settings.ReadSection(ssDatabase); - if StrSameText(ExcludeTrailingPathDelimiter(NewDir), DefaultUserDataDir) then - Section.DeleteItem('UserDataDir') - else - Section.SetString('UserDataDir', NewDir); - Section.Save; - {$ENDIF} -end; - class function TAppInfo.CommonAppDir: string; {Gets the CodeSnip data directory stored within the common application data directory. @@ -276,12 +248,16 @@ class function TAppInfo.UserDataDir: string; } {$IFNDEF PORTABLE} var - Section: ISettingsSection; // persistent storage where code is recorded + Collections: TCollections; + Collection: TCollection; {$ENDIF} begin {$IFNDEF PORTABLE} - Section := Settings.ReadSection(ssDatabase); - Result := Section.GetString('UserDataDir', DefaultUserDataDir); + Collections := TCollections.Instance; + Collection := Collections.GetCollection(TCollectionID.__TMP__UserDBCollectionID); + Result := Collection.Location.Directory; + if Result = '' then + Result := DefaultUserDataDir; {$ELSE} Result := DefaultUserDataDir; {$ENDIF} diff --git a/Src/USettings.pas b/Src/USettings.pas index 3f1d26ee8..fe963bffc 100644 --- a/Src/USettings.pas +++ b/Src/USettings.pas @@ -177,7 +177,6 @@ interface /// -ssFavourites - persistent settings from Favourites dlg /// -ssWindowState - info about the size and state of various /// windows - /// -ssDatabase - database customisation info /// -ssCompilers - info about all compilers /// -ssCollections - info about all snippet collections /// -ssCollection - info about a specific snippet collection @@ -185,7 +184,7 @@ interface TSettingsSectionId = ( ssFindText, ssFindCompiler, ssFindXRefs, ssCompilerInfo, ssPreferences, ssUnits, ssDuplicateSnippet, - ssFavourites, ssWindowState, ssDatabase, ssCompilers, ssCollections, + ssFavourites, ssWindowState, ssCompilers, ssCollections, ssCollection ); @@ -579,7 +578,6 @@ function TIniSettings.SectionName(const Id: TSettingsSectionId; 'DuplicateSnippet', // ssDuplicateSnippet 'Favourites', // ssFavourites 'WindowState', // ssWindowState - 'Database', // ssDatabase 'Compilers', // ssCompilers 'Collections', // ssCollections 'Collection' // ssCollection diff --git a/Src/UUserDBMove.pas b/Src/UUserDBMove.pas index 2af3f4056..946062070 100644 --- a/Src/UUserDBMove.pas +++ b/Src/UUserDBMove.pas @@ -91,7 +91,9 @@ implementation // Delphi SysUtils, IOUtils, // Project - UAppInfo, UStrUtils; + DB.UCollections, + UAppInfo, + UStrUtils; { TUserDBMove } @@ -134,9 +136,18 @@ procedure TUserDBMove.ReportDeleteProgress(Sender: TObject; end; procedure TUserDBMove.SetNewDBDirectory(Sender: TObject); +var + Collection: TCollection; + Collections: TCollections; begin // record new location BEFORE deleting old directory - TAppInfo.ChangeUserDataDir(fDestDir); + Collections := TCollections.Instance; + Collection := Collections.GetCollection(TCollectionID.__TMP__UserDBCollectionID); + Collection.Location.Directory := fDestDir; + Collections.Update(Collection); + // Persist collections immediately to save new directory ASAP to prevent + // directory change being lost following a program crash. + Collections.Save; end; procedure TUserDBMove.ValidateDirectories; From 55cb8873334922fb33dec1d3496fa3bd58c4906a Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 5 Nov 2024 17:05:22 +0000 Subject: [PATCH 036/222] Rename DBIO.UIniDataReader unit as DBIO.UIniData Renamed the unit since it is going to be used for writing the Code Snippets Collection ini database format (known as the "main database" in CodeSnip 4) in addition to the existing code used to read the collection. Modified the CodeSnip .dpr and .dproj project files re the name change. Updated use clause in DB.UDatabaseIO re the name change. --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/DB.UDatabaseIO.pas | 2 +- Src/{DBIO.UIniDataReader.pas => DBIO.UIniData.pas} | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) rename Src/{DBIO.UIniDataReader.pas => DBIO.UIniData.pas} (99%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index c2c6be15d..98cb69a47 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -70,7 +70,7 @@ uses DB.USnippet in 'DB.USnippet.pas', DB.USnippetKind in 'DB.USnippetKind.pas', DBIO.UFileIOIntf in 'DBIO.UFileIOIntf.pas', - DBIO.UIniDataReader in 'DBIO.UIniDataReader.pas', + DBIO.UIniData in 'DBIO.UIniData.pas', DBIO.UNulDataReader in 'DBIO.UNulDataReader.pas', DBIO.UXMLDataIO in 'DBIO.UXMLDataIO.pas', Favourites.UManager in 'Favourites.UManager.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index f0d0f83f1..1141453ca 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -73,7 +73,7 @@ - + diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 937172c8d..208a83146 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -105,7 +105,7 @@ implementation SysUtils, // Project DBIO.UFileIOIntf, - DBIO.UIniDataReader, + DBIO.UIniData, DBIO.UNulDataReader, DBIO.UXMLDataIO, UAppInfo, diff --git a/Src/DBIO.UIniDataReader.pas b/Src/DBIO.UIniData.pas similarity index 99% rename from Src/DBIO.UIniDataReader.pas rename to Src/DBIO.UIniData.pas index 90b0c9657..7e849979c 100644 --- a/Src/DBIO.UIniDataReader.pas +++ b/Src/DBIO.UIniData.pas @@ -10,7 +10,7 @@ } -unit DBIO.UIniDataReader; +unit DBIO.UIniData; interface From 86f63ff175a7f828998a06b7de8a15369b60556b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 5 Nov 2024 19:59:20 +0000 Subject: [PATCH 037/222] Class/interface/method renamings in DB.UDatabaseIO Renamed the following classes and interfaces in DB.UDatabaseIO unit: IDatabaseLoader => IDataFormatLoader IDatabaseWriter => IDataFormatSaver TMainDatabaseLoader => TDCSCV2FormatLoader TUserDatabaseLoader => TNativeV4FormatLoader TDatabaseWriter => TNativeV4FormatSaver Also renamed the following methods: IDataFormatSaver .Write => .Save (& in implementing class) TDatabaseIOFactory .CreateDBWriter => .CreateDBSaver Updated affected code in DB.UMain unit. Updated some comments to XMLDoc format. --- Src/DB.UDatabaseIO.pas | 160 +++++++++++++++++++---------------------- Src/DB.UMain.pas | 12 ++-- 2 files changed, 79 insertions(+), 93 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 208a83146..ba8f489bd 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -31,43 +31,37 @@ interface type - { - IDatabaseLoader: - Interface to object that can load data into the Database object from - storage. - } - IDatabaseLoader = interface(IInterface) + /// Interface to objects that can load data into a collection within + /// the database from storage in a supported data format. + IDataFormatLoader = interface(IInterface) ['{C6AF94FC-F56F-44AE-9E79-3B0CD0BB21D4}'] + /// Loads data from storage into a collection within the database. + /// + /// TSnippetList [in] Receives information + /// about each snippet in the collection. + /// TCategoryList [in] Receives information + /// about each category in the collection. + /// DBDataItemFactory [in] Object + /// used to create new categories and snippets. procedure Load(const SnipList: TSnippetList; const Categories: TCategoryList; const DBDataItemFactory: IDBDataItemFactory); - {Loads data from storage and updates database object. - @param SnipList [in] Receives information about each snippet in the - database. - @param Categories [in] Receives information about each category in the - database. - @param DBDataItemFactory [in] Object used to create new categories and - snippets. - } end; - { - IDatabaseWriter: - Interface to object that can write data from the user-defined component of - the Database object to storage. - } - IDatabaseWriter = interface(IInterface) + /// Interface to objects that can save data from a collection within + /// the database into storage in a supported data format. + IDataFormatSaver = interface(IInterface) ['{F46EE2E3-68A7-4877-9E04-192D15D29BB1}'] - procedure Write(const SnipList: TSnippetList; + /// Saves data from a collection within the database to storage. + /// + /// TSnippetList [in] Contains information + /// about each snippet in the collection. + /// TCategoryList [in] Contains information + /// about each category in the collection. + /// IDBDataProvider [in] Object used to + /// obtain details of the data to storage. + procedure Save(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); - {Writes data from Database object to storage. - @param SnipList [in] Contains information about each snippet in the - database. - @param Categories [in] Contains information about each category in the - database. - @param Privider [in] Object used to obtain details of the data to be - written to the Database object - } end; { @@ -78,16 +72,16 @@ interface TDatabaseIOFactory = class(TNoConstructObject) public /// Creates and returns an object to be used to load the given - /// collection's data. Nil is return if no loader object is supported. - /// + /// collection's data in the correct format. Nil is returned if no loader + /// object is supported. class function CreateDBLoader(const Collection: TCollection): - IDatabaseLoader; + IDataFormatLoader; /// Creates and returns an object to be used to save the given - /// collection's data. Nil is return if no saver object is supported. - /// - class function CreateDBWriter(const Collection: TCollection): - IDatabaseWriter; + /// collection's data in the correct format. Nil is return if no saver + /// object is supported. + class function CreateDBSaver(const Collection: TCollection): + IDataFormatSaver; end; { @@ -128,7 +122,7 @@ TDatabaseLoaderClass = class of TDatabaseLoader; Abstract base class for objects that can load data into the Database object from storage. } - TDatabaseLoader = class(TInterfacedObject, IDatabaseLoader) + TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) strict private fReader: IDataReader; // Object used to read data from storage fSnipList: TSnippetList; // Receives list of snippets @@ -196,7 +190,7 @@ TDatabaseLoader = class(TInterfacedObject, IDatabaseLoader) property Collection: TCollection read fCollection; public constructor Create(const ACollection: TCollection); - { IDatabaseLoader method } + { IDataFormatLoader method } procedure Load(const SnipList: TSnippetList; const Categories: TCategoryList; const DBDataItemFactory: IDBDataItemFactory); @@ -211,10 +205,10 @@ TDatabaseLoader = class(TInterfacedObject, IDatabaseLoader) end; { - TMainDatabaseLoader: + TDCSCV2FormatLoader: Class that updates Database object with data read from main database. } - TMainDatabaseLoader = class(TDatabaseLoader, IDatabaseLoader) + TDCSCV2FormatLoader = class(TDatabaseLoader, IDataFormatLoader) strict protected function CreateReader: IDataReader; override; {Creates reader object. If main database doesn't exist a nul reader is @@ -241,10 +235,10 @@ TMainDatabaseLoader = class(TDatabaseLoader, IDatabaseLoader) end; { - TUserDatabaseLoader: + TNativeV4FormatLoader: Class that updates Database object with data read from user database. } - TUserDatabaseLoader = class(TDatabaseLoader, IDatabaseLoader) + TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) strict protected function CreateReader: IDataReader; override; {Creates reader object. If user database doesn't exist a nul reader is @@ -275,11 +269,11 @@ TUserDatabaseLoader = class(TDatabaseLoader, IDatabaseLoader) end; { - TDatabaseWriter: - Object used to write data from user database to storage. + TNativeV4FormatWriter: + Object used to write data from the native snippets v4 to storage. } - TDatabaseWriter = class(TInterfacedObject, - IDatabaseWriter + TNativeV4FormatSaver = class(TInterfacedObject, + IDataFormatSaver ) strict private fWriter: IDataWriter; // Object used to write to storage @@ -299,45 +293,45 @@ TDatabaseWriter = class(TInterfacedObject, } public constructor Create(const ACollection: TCollection); - { IDatabaseWriter method } - procedure Write(const SnipList: TSnippetList; + /// Saves data from a collection within the database to storage. + /// + /// TSnippetList [in] Contains information + /// about each snippet in the collection. + /// TCategoryList [in] Contains information + /// about each category in the collection. + /// IDBDataProvider [in] Object used to + /// obtain details of the data to storage. + /// Method of IDataFormatSaver. + procedure Save(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); - {Writes data from Database object to storage. - @param SnipList [in] Contains information about each snippet in the - database. - @param Categories [in] Contains information about each category in the - database. - @param Provider [in] Object used to obtain details of the data to be - written from the Database object - } end; { TDatabaseIOFactory } class function TDatabaseIOFactory.CreateDBLoader(const Collection: TCollection): - IDatabaseLoader; + IDataFormatLoader; begin {TODO -cCollections: Revise database loaders to get file path and other info from collection instead of hard wiring it.} case Collection.CollectionFormatKind of TCollectionFormatKind.DCSC_v2: - Result := TMainDatabaseLoader.Create(Collection); + Result := TDCSCV2FormatLoader.Create(Collection); TCollectionFormatKind.Native_v4: - Result := TUserDatabaseLoader.Create(Collection); + Result := TNativeV4FormatLoader.Create(Collection); else Result := nil; end; end; -class function TDatabaseIOFactory.CreateDBWriter( - const Collection: TCollection): IDatabaseWriter; +class function TDatabaseIOFactory.CreateDBSaver( + const Collection: TCollection): IDataFormatSaver; begin case Collection.CollectionFormatKind of TCollectionFormatKind.DCSC_v2: Result := nil; {TODO -cVault: add writer object here} TCollectionFormatKind.Native_v4: - Result := TDatabaseWriter.Create(Collection); + Result := TNativeV4FormatSaver.Create(Collection); else Result := nil; end; @@ -518,14 +512,14 @@ procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); end; end; -{ TMainDatabaseLoader } +{ TDCSCV2FormatLoader } -function TMainDatabaseLoader.CollectionID: TCollectionID; +function TDCSCV2FormatLoader.CollectionID: TCollectionID; begin Result := TCollectionID.__TMP__MainDBCollectionID; end; -function TMainDatabaseLoader.CreateReader: IDataReader; +function TDCSCV2FormatLoader.CreateReader: IDataReader; {Creates reader object. If main database doesn't exist a nul reader is created. @return Reader object instance. @@ -536,7 +530,7 @@ function TMainDatabaseLoader.CreateReader: IDataReader; Result := TNulDataReader.Create; end; -function TMainDatabaseLoader.ErrorMessageHeading: string; +function TDCSCV2FormatLoader.ErrorMessageHeading: string; {Returns heading to use in error messages. Identifies main database. @return Required heading. } @@ -546,7 +540,7 @@ function TMainDatabaseLoader.ErrorMessageHeading: string; Result := sError; end; -function TMainDatabaseLoader.FindSnippet(const SnippetName: string; +function TDCSCV2FormatLoader.FindSnippet(const SnippetName: string; const SnipList: TSnippetList): TSnippet; {Finds the snippet object with a specified name in the main database. @param SnippetName [in] Name of required snippet. @@ -558,14 +552,14 @@ function TMainDatabaseLoader.FindSnippet(const SnippetName: string; Result := SnipList.Find(SnippetName, CollectionID); end; -{ TUserDatabaseLoader } +{ TNativeV4FormatLoader } -function TUserDatabaseLoader.CollectionID: TCollectionID; +function TNativeV4FormatLoader.CollectionID: TCollectionID; begin Result := TCollectionID.__TMP__UserDBCollectionID; end; -function TUserDatabaseLoader.CreateReader: IDataReader; +function TNativeV4FormatLoader.CreateReader: IDataReader; {Creates reader object. If user database doesn't exist a nul reader is created. @return Reader object instance. @@ -576,7 +570,7 @@ function TUserDatabaseLoader.CreateReader: IDataReader; Result := TNulDataReader.Create; end; -function TUserDatabaseLoader.ErrorMessageHeading: string; +function TNativeV4FormatLoader.ErrorMessageHeading: string; {Returns heading to use in error messages. Identifies main database. @return Required heading. } @@ -586,7 +580,7 @@ function TUserDatabaseLoader.ErrorMessageHeading: string; Result := sError; end; -function TUserDatabaseLoader.FindSnippet(const SnippetName: string; +function TNativeV4FormatLoader.FindSnippet(const SnippetName: string; const SnipList: TSnippetList): TSnippet; {Finds the snippet object with a specified name. If snippet is not in this (user) database the main database is searched. @@ -602,7 +596,7 @@ function TUserDatabaseLoader.FindSnippet(const SnippetName: string; Result := SnipList.Find(SnippetName, TCollectionID.__TMP__MainDBCollectionID); end; -procedure TUserDatabaseLoader.LoadCategories; +procedure TNativeV4FormatLoader.LoadCategories; {Loads all categories from storage and adds user and imports categories if not present. } @@ -621,15 +615,15 @@ procedure TUserDatabaseLoader.LoadCategories; end; end; -{ TDatabaseWriter } +{ TNativeV4FormatSaver } -constructor TDatabaseWriter.Create(const ACollection: TCollection); +constructor TNativeV4FormatSaver.Create(const ACollection: TCollection); begin inherited Create; fCollection := ACollection; end; -function TDatabaseWriter.CreateWriter: IDataWriter; +function TNativeV4FormatSaver.CreateWriter: IDataWriter; {Creates object that can write data for user-defined items from Database to storage. @return Requied writer object. @@ -638,16 +632,8 @@ function TDatabaseWriter.CreateWriter: IDataWriter; Result := TXMLDataWriter.Create(TAppInfo.UserDataDir); end; -procedure TDatabaseWriter.Write(const SnipList: TSnippetList; +procedure TNativeV4FormatSaver.Save(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); - {Writes data from Database object to storage. - @param SnipList [in] Contains information about each snippet in the - database. - @param Categories [in] Contains information about each category in the - database. - @param Provider [in] Object used to obtain details of the Database data to - be written. - } begin fSnipList := SnipList; fCategories := Categories; @@ -659,7 +645,7 @@ procedure TDatabaseWriter.Write(const SnipList: TSnippetList; fWriter.Finalise; end; -procedure TDatabaseWriter.WriteCategories; +procedure TNativeV4FormatSaver.WriteCategories; {Writes information about categories to storage. } var @@ -676,7 +662,7 @@ procedure TDatabaseWriter.WriteCategories; end; end; -procedure TDatabaseWriter.WriteSnippets; +procedure TNativeV4FormatSaver.WriteSnippets; {Writes information about all snippets to storage. } diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index f6fefca65..6ef02abbd 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -970,7 +970,7 @@ procedure TDatabase.Load; var Factory: IDBDataItemFactory; // object reader uses to create snippets objects MainCollectionIdx, UserCollectionIdx: Integer; - Loader: IDatabaseLoader; + Loader: IDataFormatLoader; Collections: TCollections; Collection: TCollection; begin @@ -1032,7 +1032,7 @@ procedure TDatabase.Save; var Provider: IDBDataProvider; // object that supplies info to writer MainCollectionIdx, UserCollectionIdx: Integer; - Saver: IDatabaseWriter; + Saver: IDataFormatSaver; Collections: TCollections; Collection: TCollection; begin @@ -1055,9 +1055,9 @@ procedure TDatabase.Save; if MainCollectionIdx >= 0 then begin Collection := Collections[MainCollectionIdx]; - Saver := TDatabaseIOFactory.CreateDBWriter(Collection); + Saver := TDatabaseIOFactory.CreateDBSaver(Collection); if Assigned(Saver) then - Saver.Write(fSnippets, fCategories, Provider); + Saver.Save(fSnippets, fCategories, Provider); end; UserCollectionIdx := TCollections.Instance.IndexOfID( @@ -1066,9 +1066,9 @@ procedure TDatabase.Save; if UserCollectionIdx >= 0 then begin Collection := Collections[UserCollectionIdx]; - Saver := TDatabaseIOFactory.CreateDBWriter(Collection); + Saver := TDatabaseIOFactory.CreateDBSaver(Collection); if Assigned(Saver) then - Saver.Write(fSnippets, fCategories, Provider); + Saver.Save(fSnippets, fCategories, Provider); end; fUpdated := False; From 3fab0d3f174e9a0d7ef68246e7c099bbf7154834 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 5 Nov 2024 20:59:19 +0000 Subject: [PATCH 038/222] Replace TUserDataProvider w/ TCollectionDataProvider TUserDataProvider provided information about snippets & ctaegories from the user database / collection. TCollectionDataProvider generalises TUserDataProvider to provide information about snippets & categories from any given collection. TDatabase.Save was modified to use different TCollectionDataProvider instances for saving both the "main" and "user" collections. The previous reliance on the same TUserDataProvider instance for both user and main collections was a bug which had only not materialised because, as yet, the "main" collection does not have an associated saver object and so nothing is saved. --- Src/DB.UMain.pas | 191 ++++++++++++++++++++++++----------------------- 1 file changed, 96 insertions(+), 95 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 6ef02abbd..e732ddb2e 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -54,33 +54,39 @@ interface evCategoryChanged // a category's properties have changed ); - { - IDBDataProvider: - Interface supported by objects that provides data about the categories and - snippets in the database. - } + /// Interface supported by objects that provide information about + /// categories and snippets. IDBDataProvider = interface(IInterface) ['{D2D57A0D-DB29-4012-891E-E817E0EED8C8}'] + + /// Retrieves all the properties of a category. + /// Category [in] Category for which properties + /// are requested. + /// TCategoryData. Record containing the property data. + /// function GetCategoryProps(const Cat: TCategory): TCategoryData; - {Retrieves all the properties of a category. - @param Cat [in] Category for which data is requested. - @return Record containing property data. - } + + /// Retrieves names of all snippets that belong to a category. + /// + /// Category [in] Category for which snippet names + /// are requested. + /// IStringList. List of snippet names. function GetCategorySnippets(const Cat: TCategory): IStringList; - {Retrieves names of all snippets that belong to a category. - @param Cat [in] Category for which snippet names are requested. - @return Required list of snippet names. - } + + /// Retrieves all the properties of a snippet. + /// TSnippet [in] Snippet for which properties + /// are requested. + /// TSnippetData. Record containing the property data. + /// function GetSnippetProps(const Snippet: TSnippet): TSnippetData; - {Retrieves all the properties of a snippet. - @param Snippet [in] Snippet for which data is requested. - @return Record containing property data. - } + + /// Retrieves information about all the references of a snippet. + /// + /// TSnippet [in] Snippet for which references + /// are requested. + /// TSnippetReferences. Record containing references. + /// function GetSnippetRefs(const Snippet: TSnippet): TSnippetReferences; - {Retrieves information about all the references of a snippet. - @param Snippet [in] Snippet for which information is requested. - @return Record containing references. - } end; { @@ -106,11 +112,8 @@ interface depends on Kind. May be nil} end; - { - IDataItemFactory: - Interface to factory object that creates snippet and category objects. For - use by database loader objects. - } + /// Interface to factory object that creates snippet and category + /// objects use by collection loader objects. IDBDataItemFactory = interface(IInterface) ['{C6DD85BD-E649-4A90-961C-4011D2714B3E}'] @@ -301,12 +304,10 @@ implementation type - { - TDBDataItemFactory: - Class that can create category and snippet objects. - } + /// Class that can create category and snippet objects.. TDBDataItemFactory = class(TInterfacedObject, IDBDataItemFactory) public + /// Creates a new category object. /// string [in] ID of new category. Must be /// unique. @@ -540,44 +541,59 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) } end; - { - TUserDataProvider: - Class that provides data about the categories and snippets in the user- - defined database. - } - TUserDataProvider = class(TInterfacedObject, IDBDataProvider) + /// Class that provides data about the categories and snippets in + /// a given collection. + TCollectionDataProvider = class(TInterfacedObject, IDBDataProvider) strict private - fSnippets: TSnippetList; // All snippets in the whole database - fCategories: TCategoryList; // All categories in the whole database + var + fCollectionID: TCollectionID; // Collection on which to operate + fSnippets: TSnippetList; // All snippets in the whole database + fCategories: TCategoryList; // All categories in the whole database public - constructor Create(const SnipList: TSnippetList; + /// Object constructor. Sets up data provider. + /// TCollectionID [in] Collection for + /// which to provide data. + /// TSnippetList [in] List of all snippets + /// in the database. + /// TCategoryList [in] List of all + /// categories in the database. + constructor Create(const ACollectionID: TCollectionID; + const SnipList: TSnippetList; const Categories: TCategoryList); - {Constructor. Records list of all snippets and categories in both - databases. - @param SnipList [in] List of all snippets in whole database. - @param Categories [in] List of all categories in whole database. - } - { IDBDataProvider methods } + + /// Retrieves all the properties of a category. + /// Category [in] Category for which properties + /// are requested. + /// TCategoryData. Record containing the property data. + /// + /// Method of IDBDataProvider function GetCategoryProps(const Cat: TCategory): TCategoryData; - {Retrieves all the properties of a category. - @param Cat [in] Category for which data is requested. - @return Record containing property data. - } + + /// Retrieves names of all snippets from the collection that + /// belong to a category. + /// Category [in] Category for which snippet names + /// are requested. + /// IStringList. List of snippet names. + /// Method of IDBDataProvider function GetCategorySnippets(const Cat: TCategory): IStringList; - {Retrieves names of all user-defined snippets that belong to a category. - @param Cat [in] Category for which snippet names are requested. - @return Required list of snippet names. - } + + /// Retrieves all the properties of a snippet. + /// TSnippet [in] Snippet for which properties + /// are requested. + /// TSnippetData. Record containing the property data. + /// + /// Method of IDBDataProvider function GetSnippetProps(const Snippet: TSnippet): TSnippetData; - {Retrieves all the properties of a snippet. - @param Snippet [in] Snippet for which data is requested. - @return Record containing property data. - } + + /// Retrieves information about all the references of a snippet. + /// + /// TSnippet [in] Snippet for which references + /// are requested. + /// TSnippetReferences. Record containing references. + /// + /// Method of IDBDataProvider function GetSnippetRefs(const Snippet: TSnippet): TSnippetReferences; - {Retrieves information about all the references of a snippet. - @param Snippet [in] Snippet for which information is requested. - @return Record containing references. - } + end; function Database: IDatabase; @@ -1030,15 +1046,12 @@ procedure TDatabase.Save; {Saves user defined snippets and all categories to user database. } var - Provider: IDBDataProvider; // object that supplies info to writer + MainProvider, UserProvider: IDBDataProvider; // object that supplies info to writer MainCollectionIdx, UserCollectionIdx: Integer; Saver: IDataFormatSaver; Collections: TCollections; Collection: TCollection; begin - // Create object that can provide required information about user database - Provider := TUserDataProvider.Create(fSnippets, fCategories); - Collections := TCollections.Instance; {TODO: -cVault: The following code is a kludge to maintain compatibility with @@ -1055,9 +1068,12 @@ procedure TDatabase.Save; if MainCollectionIdx >= 0 then begin Collection := Collections[MainCollectionIdx]; + MainProvider := TCollectionDataProvider.Create( + TCollectionID.__TMP__MainDBCollectionID, fSnippets, fCategories + ); Saver := TDatabaseIOFactory.CreateDBSaver(Collection); if Assigned(Saver) then - Saver.Save(fSnippets, fCategories, Provider); + Saver.Save(fSnippets, fCategories, MainProvider); end; UserCollectionIdx := TCollections.Instance.IndexOfID( @@ -1066,9 +1082,12 @@ procedure TDatabase.Save; if UserCollectionIdx >= 0 then begin Collection := Collections[UserCollectionIdx]; + UserProvider := TCollectionDataProvider.Create( + TCollectionID.__TMP__UserDBCollectionID, fSnippets, fCategories + ); Saver := TDatabaseIOFactory.CreateDBSaver(Collection); if Assigned(Saver) then - Saver.Save(fSnippets, fCategories, Provider); + Saver.Save(fSnippets, fCategories, UserProvider); end; fUpdated := False; @@ -1243,65 +1262,47 @@ function TDBDataItemFactory.CreateSnippet(const Name: string; Result := TSnippetEx.Create(Name, ACollectionID, Props); end; -{ TUserDataProvider } +{ TCollectionDataProvider } -constructor TUserDataProvider.Create(const SnipList: TSnippetList; - const Categories: TCategoryList); - {Constructor. Records list of all snippets and categories in both databases. - @param SnipList [in] List of all snippets in whole database. - @param Categories [in] List of all categories in whole database. - } +constructor TCollectionDataProvider.Create(const ACollectionID: TCollectionID; + const SnipList: TSnippetList; const Categories: TCategoryList); begin inherited Create; + fCollectionID := ACollectionID; fSnippets := SnipList; fCategories := Categories; end; -function TUserDataProvider.GetCategoryProps( +function TCollectionDataProvider.GetCategoryProps( const Cat: TCategory): TCategoryData; - {Retrieves all the properties of a category. - @param Cat [in] Category for which data is requested. - @return Record containing property data. - } begin Result.Desc := Cat.Description; end; -function TUserDataProvider.GetCategorySnippets( +function TCollectionDataProvider.GetCategorySnippets( const Cat: TCategory): IStringList; - {Retrieves names of all user-defined snippets that belong to a category. - @param Cat [in] Category for which snippet names are requested. - @return Required list of snippet names. - } var Snippet: TSnippet; // references each snippet in category begin Result := TIStringList.Create; for Snippet in Cat.Snippets do - if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then + if Snippet.CollectionID = fCollectionID then Result.Add(Snippet.Name); end; -function TUserDataProvider.GetSnippetProps( +function TCollectionDataProvider.GetSnippetProps( const Snippet: TSnippet): TSnippetData; - {Retrieves all the properties of a snippet. - @param Snippet [in] Snippet for which data is requested. - @return Record containing property data. - } begin Result := (Snippet as TSnippetEx).GetProps; end; -function TUserDataProvider.GetSnippetRefs( +function TCollectionDataProvider.GetSnippetRefs( const Snippet: TSnippet): TSnippetReferences; - {Retrieves information about all the references of a snippet. - @param Snippet [in] Snippet for which information is requested. - @return Record containing references. - } begin Result := (Snippet as TSnippetEx).GetReferences; end; + initialization From a7959cfb4f67efbf4eebf1fe623cc5f9c8fd4254 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 6 Nov 2024 16:07:37 +0000 Subject: [PATCH 039/222] Add option to TREMLWriter to render one-line REML Added optional "Formatted" paramter to TREMLWriter.Render method to given option to render REML all on one line with no indentation suitable for inclusion in .ini files. Default behaviour remains to render multi- line, indented REML. Some private methods received similar new parameters and changes. --- Src/UREMLDataIO.pas | 111 +++++++++++++++++++++++++------------------- 1 file changed, 62 insertions(+), 49 deletions(-) diff --git a/Src/UREMLDataIO.pas b/Src/UREMLDataIO.pas index 76974afc8..a6d73004e 100644 --- a/Src/UREMLDataIO.pas +++ b/Src/UREMLDataIO.pas @@ -132,28 +132,45 @@ TREMLWriter = class(TNoPublicConstructObject) @param Text [in] Plain text to be converted. @return Converted text. } - function RenderTag(const TagElem: IActiveTextActionElem): string; - {Renders an active text action element as a REML tag. - @param TagElem [in] Active text action element to be rendered. - @return Required REML tag. - } - function RenderText(const TextElem: IActiveTextTextElem): string; - {Renders an active text text element. Illegal characters are converted to - REML character entities. - @param TextElem [in] Active text text element. - @return REML-safe text containing necessary character entities. - } + /// Renders an active text action element as a REML tag. + /// IActiveTextActionElem [in] Active text + /// action element to be rendered. + /// Boolean [in] Optional flag that + /// determines if tag is to be rendered formatted as multiple, indented + /// lines of REML code (True) or with no formatting (False). + /// string. Required REML tag. + function RenderTag(const TagElem: IActiveTextActionElem; + const Formatted: Boolean): string; + + /// Renders an active text text element. Illegal characters are + /// converted to REML character entities. + /// IActiveTextTextElem [in] Active text text + /// element to be rendered. + /// Boolean [in] Optional flag that + /// determines if text is to be rendered indented (True) or not (False). + /// + /// string. REML-safe text containing necessary character + /// entities. + function RenderText(const TextElem: IActiveTextTextElem; + const Indented: Boolean): string; + strict protected constructor InternalCreate; - {Internal class constructor. Sets up object to render active text document + {Internal constructor. Sets up object to render active text document as REML. } public - class function Render(const ActiveText: IActiveText): string; - {Renders REML representation of an active text object. - @param ActiveText [in] Active text to be rendered. - @return String containing REML markup. - } + /// Renders REML representation of an active text object. + /// + /// IActiveText [in] Active text to be + /// rendered. + /// Boolean [in] Optional flag that + /// determines if REML is to be rendered formatted as multiple lines of + /// indented text (True: the default) or as a single line of text with no + /// formatting (False). + /// string containing REML markup. + class function Render(const ActiveText: IActiveText; + const Formatted: Boolean = True): string; end; @@ -719,11 +736,8 @@ constructor TREMLWriter.InternalCreate; inherited InternalCreate; end; -class function TREMLWriter.Render(const ActiveText: IActiveText): string; - {Renders REML representation of an active text object. - @param ActiveText [in] Active text to be rendered. - @return String containing REML markup. - } +class function TREMLWriter.Render(const ActiveText: IActiveText; + const Formatted: Boolean): string; var Elem: IActiveTextElem; // each element in active text object TextElem: IActiveTextTextElem; // an active text text element @@ -744,30 +758,31 @@ class function TREMLWriter.Render(const ActiveText: IActiveText): string; for Elem in ActiveText do begin if Supports(Elem, IActiveTextTextElem, TextElem) then - Text := Text + RW.RenderText(TextElem) + Text := Text + RW.RenderText(TextElem, Formatted) else if Supports(Elem, IActiveTextActionElem, TagElem) then - Text := Text + RW.RenderTag(TagElem); + Text := Text + RW.RenderTag(TagElem, Formatted); end; - SrcLines := TIStringList.Create(Text, EOL, False); - DestLines := TIStringList.Create; - for SrcLine in SrcLines do + if Formatted then begin - DestLine := StrTrimRight(SrcLine); - if not StrIsEmpty(DestLine) then - DestLines.Add(DestLine); - end; - Result := DestLines.GetText(EOL, False); + SrcLines := TIStringList.Create(Text, EOL, False); + DestLines := TIStringList.Create; + for SrcLine in SrcLines do + begin + DestLine := StrTrimRight(SrcLine); + if not StrIsEmpty(DestLine) then + DestLines.Add(DestLine); + end; + Result := DestLines.GetText(EOL, False); + end + else + Result := StrTrim(Text); finally RW.Free; end; end; -function TREMLWriter.RenderTag( - const TagElem: IActiveTextActionElem): string; - {Renders an active text action element as a REML tag. - @param TagElem [in] Active text action element to be rendered. - @return Required REML tag. - } +function TREMLWriter.RenderTag(const TagElem: IActiveTextActionElem; + const Formatted: Boolean): string; var TagName: string; // name of tag ParamName: string; // name of any parameter @@ -785,7 +800,8 @@ function TREMLWriter.RenderTag( if TActiveTextElemCaps.DisplayStyleOf(TagElem.Kind) = dsBlock then begin Dec(fLevel); - Result := EOL + StrOfSpaces(IndentMult * fLevel) + Result + EOL; + if Formatted then + Result := EOL + StrOfSpaces(IndentMult * fLevel) + Result + EOL; fIsStartOfTextLine := True; end; end @@ -815,7 +831,8 @@ function TREMLWriter.RenderTag( ); if TActiveTextElemCaps.DisplayStyleOf(TagElem.Kind) = dsBlock then begin - Result := EOL + StrOfSpaces(IndentMult * fLevel) + Result + EOL; + if Formatted then + Result := EOL + StrOfSpaces(IndentMult * fLevel) + Result + EOL; Inc(fLevel); fIsStartOfTextLine := True; end @@ -823,7 +840,8 @@ function TREMLWriter.RenderTag( begin if fIsStartOfTextLine then begin - Result := StrOfSpaces(IndentMult * fLevel) + Result; + if Formatted then + Result := StrOfSpaces(IndentMult * fLevel) + Result; fIsStartOfTextLine := False; end; end; @@ -839,15 +857,10 @@ function TREMLWriter.RenderTag( end; end; -function TREMLWriter.RenderText( - const TextElem: IActiveTextTextElem): string; - {Renders an active text text element. Illegal characters are converted to - REML character entities. - @param TextElem [in] Active text text element. - @return REML-safe text containing necessary character entities. - } +function TREMLWriter.RenderText(const TextElem: IActiveTextTextElem; + const Indented: Boolean): string; begin - if fIsStartOfTextLine then + if fIsStartOfTextLine and Indented then begin Result := StrOfSpaces(IndentMult * fLevel); fIsStartOfTextLine := False; From 60574fd812f749a85e70c4c64f942f1c43f8d42b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 7 Nov 2024 01:41:05 +0000 Subject: [PATCH 040/222] Fix TCollectionLocation.IsValid This method was checking whether the location directory and any meta data files exist. This was causing exceptions at program startup if the directories didn't exist. Such checks are actually made in the collection loading code, which fail gracefully when the checks fail. --- Src/DB.UCollections.pas | 4 ---- 1 file changed, 4 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 3793168f0..3e321aa42 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -267,14 +267,10 @@ function TCollectionLocation.IsValid: Boolean; Exit(False); if not TPath.HasValidPathChars(fDirectory, False) then Exit(False); - if not TDirectory.Exists(fDirectory) then - Exit(False); if (fMetaDataFile <> '') then begin if not TPath.IsRelativePath(fMetaDataFile) then Exit(False); - if not TFile.Exists(TPath.Combine(fDirectory, fMetaDataFile)) then - Exit(False); end; end; From 6e2c26cf37d453ccb9a5019bc023f0fa298791c5 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 7 Nov 2024 02:03:38 +0000 Subject: [PATCH 041/222] Add facility to save "main" collection A new TDCSCV2FormatSaver class to save "main" collection in DelphiDabbler Code Snippets Collection v2 format. The format version is actually v2.1.x at present, which could loose extended testing information. Updated other code necessary to create and use TDCSCV2FormatSaver where necessary. --- Src/DB.UDatabaseIO.pas | 201 +++++++++++++++-- Src/DBIO.UIniData.pas | 480 ++++++++++++++++++++++++++++++++++++++++- 2 files changed, 663 insertions(+), 18 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index ba8f489bd..d2ae7d542 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -52,14 +52,14 @@ interface /// the database into storage in a supported data format. IDataFormatSaver = interface(IInterface) ['{F46EE2E3-68A7-4877-9E04-192D15D29BB1}'] - /// Saves data from a collection within the database to storage. - /// + /// Saves data to storage. /// TSnippetList [in] Contains information - /// about each snippet in the collection. + /// about each snippet to be saved. /// TCategoryList [in] Contains information - /// about each category in the collection. + /// about each category to be saved. /// IDBDataProvider [in] Object used to - /// obtain details of the data to storage. + /// obtain details of the data to be stored. + /// Method of IDataFormatSaver. procedure Save(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); end; @@ -97,6 +97,7 @@ implementation uses // Delphi SysUtils, + IOUtils, // Project DBIO.UFileIOIntf, DBIO.UIniData, @@ -104,6 +105,7 @@ implementation DBIO.UXMLDataIO, UAppInfo, UConsts, + UFolderBackup, UIStringList, UReservedCategories, USnippetIDs; @@ -268,10 +270,56 @@ TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) } end; - { - TNativeV4FormatWriter: - Object used to write data from the native snippets v4 to storage. - } + {TODO -cVault: Extract common code in TNativeV4FormatSaver and + TDCSCV2FormatSaver into a common base class. } + + /// Class used to write data from a collection to storage in the + /// DelphiDabbler Code Snippets v2 data format. + TDCSCV2FormatSaver = class(TInterfacedObject, + IDataFormatSaver + ) + strict private + const + BakFileID = SmallInt($DC52); + var + fWriter: IDataWriter; // Object used to write to storage + fSnipList: TSnippetList; // List of snippets to be written + fCategories: TCategoryList; // List of categories to be written + fProvider: IDBDataProvider; // Object used to get data to be written + fCollection: TCollection; // Collection being written + fBakFile: string; // Backup file used in case of failure + function CreateWriter: IDataWriter; + {Creates object that can write data for user-defined database to storage. + @return Requied writer object. + } + procedure WriteCategories; + {Writes information about categories to storage. + } + procedure WriteSnippets; + {Writes information about all snippets to storage. + } + /// Backup current data. + procedure Backup; + /// Restore current data. + procedure Restore; + public + constructor Create(const ACollection: TCollection); + + /// Saves data to storage. + /// TSnippetList [in] Contains information + /// about each snippet to be saved. + /// TCategoryList [in] Contains information + /// about each category to be saved. + /// IDBDataProvider [in] Object used to + /// obtain details of the data to be stored. + /// Method of IDataFormatSaver. + procedure Save(const SnipList: TSnippetList; + const Categories: TCategoryList; + const Provider: IDBDataProvider); + end; + + /// Class used to write data from a collection to storage in + /// CodeSnip's native v4 data format. TNativeV4FormatSaver = class(TInterfacedObject, IDataFormatSaver ) @@ -293,8 +341,7 @@ TNativeV4FormatSaver = class(TInterfacedObject, } public constructor Create(const ACollection: TCollection); - /// Saves data from a collection within the database to storage. - /// + /// Saves data to storage. /// TSnippetList [in] Contains information /// about each snippet in the collection. /// TCategoryList [in] Contains information @@ -312,7 +359,7 @@ TNativeV4FormatSaver = class(TInterfacedObject, class function TDatabaseIOFactory.CreateDBLoader(const Collection: TCollection): IDataFormatLoader; begin - {TODO -cCollections: Revise database loaders to get file path and other + {TODO -cUDatabaseIO: Revise database loaders to get file path and other info from collection instead of hard wiring it.} case Collection.CollectionFormatKind of TCollectionFormatKind.DCSC_v2: @@ -329,7 +376,7 @@ class function TDatabaseIOFactory.CreateDBSaver( begin case Collection.CollectionFormatKind of TCollectionFormatKind.DCSC_v2: - Result := nil; {TODO -cVault: add writer object here} + Result := TDCSCV2FormatSaver.Create(Collection); TCollectionFormatKind.Native_v4: Result := TNativeV4FormatSaver.Create(Collection); else @@ -588,6 +635,8 @@ function TNativeV4FormatLoader.FindSnippet(const SnippetName: string; @param SnipList [in] List of snippets to search. @return Reference to required snippet object or nil if snippet is not found. } + + begin // Search in user database Result := SnipList.Find(SnippetName, CollectionID); @@ -615,6 +664,129 @@ procedure TNativeV4FormatLoader.LoadCategories; end; end; +{ TDCSCV2FormatSaver } + +procedure TDCSCV2FormatSaver.Backup; +var + FB: TFolderBackup; +begin + FB := TFolderBackup.Create( + fCollection.Location.Directory, fBakFile, BakFileID + ); + try + FB.Backup; + finally + FB.Free; + end; +end; + +constructor TDCSCV2FormatSaver.Create(const ACollection: TCollection); +begin + inherited Create; + fCollection := ACollection; + // Find an used temp file name in system temp directory + repeat + fBakFile := TPath.Combine( + TPath.GetTempPath, '~codesnip-' + TPath.GetGUIDFileName + ); + until not TFile.Exists(fBakFile); +end; + +function TDCSCV2FormatSaver.CreateWriter: IDataWriter; +begin + Result := TIniDataWriter.Create(fCollection.Location.Directory); +end; + +procedure TDCSCV2FormatSaver.Restore; +var + FB: TFolderBackup; +begin + FB := TFolderBackup.Create( + fCollection.Location.Directory, fBakFile, BakFileID + ); + try + FB.Restore; + finally + FB.Free; + end; +end; + +procedure TDCSCV2FormatSaver.Save(const SnipList: TSnippetList; + const Categories: TCategoryList; const Provider: IDBDataProvider); +begin + Backup; + try + try + fSnipList := SnipList; + fCategories := Categories; + fProvider := Provider; + fWriter := CreateWriter; + fWriter.Initialise; + WriteCategories; + WriteSnippets; + fWriter.Finalise; + except + Restore; + raise ExceptObject; + end; + finally + TFile.Delete(fBakFile); + end; +end; + +procedure TDCSCV2FormatSaver.WriteCategories; +var + Cat: TCategory; // loops through each category + Props: TCategoryData; // category properties + SnipList: IStringList; // list of names of snippets in a category +begin + for Cat in fCategories do + begin + SnipList := fProvider.GetCategorySnippets(Cat); + if SnipList.Count > 0 then + begin + // Only write categories containing snippets + Props := fProvider.GetCategoryProps(Cat); + fWriter.WriteCatProps(Cat.ID, Props); + fWriter.WriteCatSnippets(Cat.ID, SnipList); + end; + end; +end; + +procedure TDCSCV2FormatSaver.WriteSnippets; + + // Adds names of snippets from IDList to a string list + function IDListToStrings(const IDList: ISnippetIDList): IStringList; + var + ID: TSnippetID; // each id in snippet id list + begin + Result := TIStringList.Create; + for ID in IDList do + Result.Add(ID.Name); + end; + +var + Snippet: TSnippet; // loops through each snippet in list + Props: TSnippetData; // snippet properties + Refs: TSnippetReferences; // snippet references +begin + for Snippet in fSnipList do + begin + // Only write user-defined snippets + if Snippet.CollectionID = fCollection.UID then + begin + // Get and write a snippet's properties + Props := fProvider.GetSnippetProps(Snippet); + fWriter.WriteSnippetProps(Snippet.Name, Props); + // Get and write a snippet's references + Refs := fProvider.GetSnippetRefs(Snippet); + fWriter.WriteSnippetUnits(Snippet.Name, Refs.Units); + fWriter.WriteSnippetDepends(Snippet.Name, IDListToStrings(Refs.Depends)); + fWriter.WriteSnippetXRefs(Snippet.Name, IDListToStrings(Refs.XRef)); + end; + end; +end; + { TNativeV4FormatSaver } constructor TNativeV4FormatSaver.Create(const ACollection: TCollection); @@ -629,6 +801,7 @@ function TNativeV4FormatSaver.CreateWriter: IDataWriter; @return Requied writer object. } begin + {TODO -cUDatabaseIO: Use Collection.Location.Directory instead} Result := TXMLDataWriter.Create(TAppInfo.UserDataDir); end; @@ -689,7 +862,7 @@ procedure TNativeV4FormatSaver.WriteSnippets; for Snippet in fSnipList do begin // Only write user-defined snippets - if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then + if Snippet.CollectionID = fCollection.UID then begin // Get and write a snippet's properties Props := fProvider.GetSnippetProps(Snippet); diff --git a/Src/DBIO.UIniData.pas b/Src/DBIO.UIniData.pas index 7e849979c..04ab602a8 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DBIO.UIniData.pas @@ -9,6 +9,8 @@ * files. } +{TODO -cVault: rename INI term to DCSCv2 - this isn't a general .ini data + IO unit, the .ini format only part of a wider collection format.} unit DBIO.UIniData; @@ -18,9 +20,17 @@ interface uses // Delphi - Classes, Generics.Collections, IniFiles, + Classes, + Generics.Collections, + Generics.Defaults, + IniFiles, // Project - DB.UCategory, DB.USnippet, DBIO.UFileIOIntf, UIStringList, UMainDBFileReader; + ActiveText.UMain, + DB.UCategory, + DB.USnippet, + DBIO.UFileIOIntf, + UIStringList, + UMainDBFileReader; type @@ -196,6 +206,182 @@ TIniFileCache = class(TObject) function GetSnippetUnits(const Snippet: string): IStringList; end; + /// Write a collection to disk in the DelphiDabbler Code Snippets + /// collection format. + TIniDataWriter = class sealed(TInterfacedObject, IDataWriter) + strict private + type + + /// Encapsulates an INI file stored in UTF8 format. + TUTF8IniFile = class(TMemIniFile) + public + /// Saves the ini data to a file in UTF8 format. + procedure Save; + end; + + /// Implements a cache of UTF8 format ini file objects, indexed + /// by ini file name. + TUTF8IniFileCache = class(TObject) + strict private + type + /// Maps ini file names to related ini file objects. + /// + TIniFileMap = TObjectDictionary; + var + /// Maps file names to related ini file objects. + fCache: TIniFileMap; + + /// Adds an ini file to the cache and returns it. + /// Performs no checks on whether the ini file is already in + /// the cache. + /// string [in] Fully specified path + /// to ini file. + /// TUTF8IniFile instance. + function InternalAddIniFile(const APathToFile: string): TUTF8IniFile; + + public + + /// Object constructor. Sets up empty cache. + constructor Create; + + /// Object destructor. Frees cache. + destructor Destroy; override; + + /// Gets reference to ini file object. Creates it if i + /// doesn't extist. + /// string [in] Fully specified path + /// to ini file. + /// TUTF8IniFile instance. + /// Caller must not free the returned TCustomIniFile + /// instance. + function GetIniFile(const APathToFile: string): TUTF8IniFile; + + /// Creates and adds an ini file object to the cache if not + /// already present. + /// string [in] Fully specified path + /// to ini file. + procedure AddIniFile(const APathToFile: string); + + /// Enumerator for cached ini files. + function GetEnumerator: + TObjectDictionary.TPairEnumerator; + end; + + var + /// Cache of ini files. + fCache: TUTF8IniFileCache; + /// Output directory. + fOutDir: string; + /// Path to master ini file. + fMasterIniPath: string; + /// Ini file containing currently processed category. + fCurrentCatIni: TUTF8IniFile; + /// Number of next available unused data file. + fFileNumber: Integer; + + /// Handles exceptions raised by converting expected exceptions + /// into ECodeSnip derived exceptions. + /// TObject [in] Reference to exception to be + /// handled. + /// Always raise an exception. + /// Unexpected exceptions are re-raised as is. + procedure HandleException(const EObj: TObject); + + /// Returns full path to AFileName rooted at + /// fOutDir. + function MakePath(const AFileName: string): string; + + /// Returns the name of the ini file associated with + /// ACatID. + function MakeCatIniName(const ACatID: string): string; + + /// Returns the full path to the ini file associated with + /// ACatID rooted at fOutDir. + function MakeCatIniPath(const ACatID: string): string; + + /// Converts the given active text AActiveText to an + /// unformatted, single line, REML string. + function ActiveTextToREML(AActiveText: IActiveText): string; + + public + + /// Object constructor. + /// string [in] Directory containing the + /// output. + constructor Create(const AOutDir: string); + + /// Object destructor. + destructor Destroy; override; + + /// Initialise the output. Always called before any other methods. + /// + /// Method of IDataWriter. + procedure Initialise; + + /// Write the properties of a category. Always called before + /// WriteCatSnippets for a given category, so can be used to perform + /// any per-category initialisation. + /// string [in] ID of category. + /// TCategoryData [in] Properties of category. + /// + /// Method of IDataWriter. + procedure WriteCatProps(const CatID: string; const Props: TCategoryData); + + /// Write the list of snippets belonging to a category. Always + /// called after WriteCatProps for any given category. + /// string [in] ID of category. + /// IStringList [in] List of names of + /// snippets. + /// Method of IDataWriter. + procedure WriteCatSnippets(const CatID: string; + const SnipList: IStringList); + + /// Write the properties of a snippet. Always called after all + /// categories are written and before WriteSnippetUnits, so can be + /// used to perform any per-snippet intialisation. + /// string [in] Name of snippet. + /// TSnippetData [in] Properties of snippet. + /// + /// + /// NOTE: This method conforms to DelphiDabbler Code Snippets + /// collection format v2.1.x. + /// Method of IDataWriter. + /// + procedure WriteSnippetProps(const SnippetName: string; + const Props: TSnippetData); + + /// Write the list of units required by a snippet. + /// string [in] Name of snippet. + /// IStringList [in] List of names of required + /// units. + /// Method of IDataWriter. + procedure WriteSnippetUnits(const SnippetName: string; + const Units: IStringList); + + /// Write the list of snippets on which a snippet depends. + /// + /// string [in] Name of snippet. + /// IStringList [in] List of snippet names. + /// + /// Method of IDataWriter. + procedure WriteSnippetDepends(const SnippetName: string; + const Depends: IStringList); + + /// Write the list of snippets that a snippet cross-references. + /// + /// string [in] Name of snippet. + /// IStringList [in] List of snippet names. + /// + /// Method of IDataWriter. + procedure WriteSnippetXRefs(const SnippetName: string; + const XRefs: IStringList); + + /// Finalises the output. Always called after all other methods. + /// + /// Method of IDataWriter. + procedure Finalise; + + end; implementation @@ -203,9 +389,20 @@ implementation uses // Delphi SysUtils, + IOUtils, // Project - ActiveText.UMain, Compilers.UGlobals, DB.USnippetKind, UComparers, UConsts, - UIniDataLoader, USnippetExtraHelper, UStrUtils, UUtils; + Compilers.UGlobals, + DB.USnippetKind, + UComparers, + UConsts, + UExceptions, + UIniDataLoader, + UIOUtils, + UREMLDataIO, + USnippetExtraHelper, + USystemInfo, + UStrUtils, + UUtils; const @@ -614,5 +811,280 @@ function TIniDataReader.TIniFileCache.GetIniFile( Result := fCache[PathToFile]; end; +{ TIniDataWriter } + +function TIniDataWriter.ActiveTextToREML(AActiveText: IActiveText): string; +begin + Result := TREMLWriter.Render(AActiveText, False); +end; + +constructor TIniDataWriter.Create(const AOutDir: string); +begin + inherited Create; + fOutDir := AOutDir; + fCache := TUTF8IniFileCache.Create; +end; + +destructor TIniDataWriter.Destroy; +begin + fCache.Free; // frees owned ini file objects + inherited; +end; + +procedure TIniDataWriter.Finalise; +var + IniInfo: TPair; +begin + try + for IniInfo in fCache do + IniInfo.Value.Save; + except + HandleException(ExceptObject); + end; +end; + +procedure TIniDataWriter.HandleException(const EObj: TObject); +begin + if (EObj is EFileStreamError) or (EObj is ECodeSnip) + or (EObj is EDirectoryNotFoundException) then + raise EDataIO.Create(EObj as Exception); + raise EObj; +end; + +procedure TIniDataWriter.Initialise; +begin + try + // Make sure database folder exists + TDirectory.CreateDirectory(fOutDir); + + // Delete current ini and data files + // (don't delete special files: CONTRIBUTORS, LICENSE, LICENSE-INFO, + // TESTERS, VERSION). + DeleteFiles(fOutDir, '*.dat'); + DeleteFiles(fOutDir, '*.ini'); + + // Initialise file count + fFileNumber := 0; + + // Record path to master meta data file. + fMasterIniPath := MakePath(cMasterFileName); + + except + HandleException(ExceptObject); + end; +end; + +function TIniDataWriter.MakeCatIniName(const ACatID: string): string; +begin + Result := ACatID + '.ini'; +end; + +function TIniDataWriter.MakeCatIniPath(const ACatID: string): string; +begin + Result := MakePath(MakeCatIniName(ACatID)); +end; + +function TIniDataWriter.MakePath(const AFileName: string): string; +begin + Result := TPath.Combine(fOutDir, AFileName); +end; + +procedure TIniDataWriter.WriteCatProps(const CatID: string; + const Props: TCategoryData); +var + Master: TUTF8IniFile; +begin + // Add entry to master ini file + Master := fCache.GetIniFile(fMasterIniPath); + Master.WriteString(CatId, cMasterDescName, Props.Desc); + Master.WriteString(CatId, cMasterIniName, MakeCatIniName(CatID)); +end; + +procedure TIniDataWriter.WriteCatSnippets(const CatID: string; + const SnipList: IStringList); +begin + // Do nothing +end; + +procedure TIniDataWriter.WriteSnippetDepends(const SnippetName: string; + const Depends: IStringList); +begin + fCurrentCatIni.WriteString( + SnippetName, cDependsName, Depends.GetText(',', False) + ); +end; + +procedure TIniDataWriter.WriteSnippetProps(const SnippetName: string; + const Props: TSnippetData); +const + Kinds: array[TSnippetKind] of string = ( + 'freeform', // skFreeform + 'routine', // skRoutine + 'const', // skConstant + 'type', // skTypeDef + 'unit', // skUnit + 'class' // skClass + ); + CompileResults: array[TCompileResult] of Char = ( + 'Y', // crSuccess + 'Y', // crWarning + 'N', // crError + 'Q' // crQuery + ); + TestInfo: array[TSnippetTestInfo] of string = ( + 'none', // stiNone + 'basic', // stiBasic + 'advanced' // stiAdvanced + ); +var + SourceFileName: string; + SourceFilePath: string; + CompilerID: TCompilerID; + CompileResult: Char; +begin + + fCurrentCatIni := fCache.GetIniFile(MakeCatIniPath(Props.Cat)); + + try + // Write source code file + Inc(fFileNumber); + SourceFileName := IntToStr(fFileNumber) + '.dat'; + SourceFilePath := MakePath(SourceFileName); + TFileIO.WriteAllText(SourceFilePath, Props.SourceCode, TEncoding.UTF8, True); + + // snippet kind + fCurrentCatIni.WriteString(SnippetName, cKindName, Kinds[Props.Kind]); + + // display name, if set + if (Props.DisplayName <> '') then + {TODO -cVault: strictly, for v2 format, this name must be <=64 chars} + fCurrentCatIni.WriteString(SnippetName, cDisplayName, Props.DisplayName); + + // description (must be set for v2) + fCurrentCatIni.WriteString( + SnippetName, + cDescExName, + DOUBLEQUOTE + ActiveTextToREML(Props.Desc) + DOUBLEQUOTE + ); + + // extra info, if set + if Props.Extra.HasContent then + fCurrentCatIni.WriteString( + SnippetName, + cExtraName, + DOUBLEQUOTE + ActiveTextToREML(Props.Extra) + DOUBLEQUOTE + ); + + // snippet file reference + fCurrentCatIni.WriteString(SnippetName, cSnipFileName, SourceFileName); + + // compiler info + for CompilerID := Low(TCompilerID) to High(TCompilerID) do + begin + CompileResult := CompileResults[Props.CompilerResults[CompilerID]]; + if CompileResult <> 'Q' then + fCurrentCatIni.WriteString( + SnippetName, cCompilerIDNames[CompilerID], CompileResult + ); + end; + + // test info: only write if not basic + {TODO -cVault: Add support for AdvancedTest .Level & .URL} + if Props.TestInfo <> stiBasic then + fCurrentCatIni.WriteString(SnippetName, cTestInfoName, TestInfo[Props.TestInfo]); + + except + + HandleException(ExceptObject); + + end; + // NOTE: + // The following deprecated keys are not written: alternatives are always + // used: + // * StandardFormat - Kind is used instead + // * Credits - Extra is used instead + // * Credits_URL - Extra is used instead + // * Comments - Extra is used instead + // * Desc - DescEx is used instead + +end; + +procedure TIniDataWriter.WriteSnippetUnits(const SnippetName: string; + const Units: IStringList); +begin + fCurrentCatIni.WriteString( + SnippetName, cUnitsName, Units.GetText(',', False) + ); +end; + +procedure TIniDataWriter.WriteSnippetXRefs(const SnippetName: string; + const XRefs: IStringList); +begin + fCurrentCatIni.WriteString( + SnippetName, cXRefName, XRefs.GetText(',', False) + ); +end; + +{ TIniDataWriter.TUTF8IniFile } + +procedure TIniDataWriter.TUTF8IniFile.Save; +var + Data: TStringList; +begin + Data := TStringList.Create; + try + GetStrings(Data); + TFileIO.WriteAllLines(FileName, Data.ToStringArray, Encoding, True); + finally + Data.Free; + end; +end; + +{ TIniDataWriter.TUTF8IniFileCache } + +procedure TIniDataWriter.TUTF8IniFileCache.AddIniFile( + const APathToFile: string); +begin + if not fCache.ContainsKey(APathToFile) then + InternalAddIniFile(APathToFile); +end; + +constructor TIniDataWriter.TUTF8IniFileCache.Create; +begin + inherited Create; + // fCache owns and frees the ini file objects + fCache := TIniFileMap.Create( + [doOwnsValues], TTextEqualityComparer.Create + ); +end; + +destructor TIniDataWriter.TUTF8IniFileCache.Destroy; +begin + fCache.Free; // frees all owned ini file objects in .Values[] + inherited; +end; + +function TIniDataWriter.TUTF8IniFileCache.GetEnumerator: + TObjectDictionary.TPairEnumerator; +begin + Result := fCache.GetEnumerator; +end; + +function TIniDataWriter.TUTF8IniFileCache.GetIniFile( + const APathToFile: string): TUTF8IniFile; +begin + if not fCache.ContainsKey(APathToFile) then + Result := InternalAddIniFile(APathToFile) + else + Result := fCache[APathToFile]; +end; + +function TIniDataWriter.TUTF8IniFileCache.InternalAddIniFile( + const APathToFile: string): TUTF8IniFile; +begin + Result := TUTF8IniFile.Create(APathToFile, TEncoding.UTF8); + fCache.Add(APathToFile, Result); +end; + end. From d71df6629896967f3c92296f7bdfbd6dda6ebbff Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 7 Nov 2024 02:22:35 +0000 Subject: [PATCH 042/222] Refactor DB.UDatabaseIO unit Removed the unused TDatabaseLoader.IsUserDatabase method. Changed explicit references to __TMP__ TCollectionID methods to get the collection ID in TDatabaseLoader and descendant classes with references to the UID of the collection passed to the class' constructors. Removed TDatabaseLoader.CollectionID method: replaced calls to it with references to TDatabaseLoader.Collection.UID property. Created TFormatSaver as abstract base class for saver classes and refactored TDCSCV2FormatSaver and TNativeV4FormatSaver as sub classes of TFormatSaver. Changed TNativeV4FormatSaver.CreateWriter to get storage location from Collection.Location.Directory instead of TAppInfo.UserDataDir. --- Src/DB.UDatabaseIO.pas | 429 ++++++++++++++++++++--------------------- 1 file changed, 210 insertions(+), 219 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index d2ae7d542..6baf3193b 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -165,15 +165,6 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) @param Snippet [in] Snippet to test. @return True if snippet is native, False if not. } - function IsUserDatabase: Boolean; virtual; - {Checks if the database is the user database. - @return True if the database is the user database, False if not. - } - - /// Returns the ID of the collection being loaded into the - /// database. - function CollectionID: TCollectionID; virtual; abstract; - function ErrorMessageHeading: string; virtual; abstract; {Returns heading to use in error messages. Should identify the database. @return Required heading. @@ -226,10 +217,6 @@ TDCSCV2FormatLoader = class(TDatabaseLoader, IDataFormatLoader) found. } - /// Returns the ID of the collection being loaded into the - /// database. - function CollectionID: TCollectionID; override; - function ErrorMessageHeading: string; override; {Returns heading to use in error messages. Identifies main database. @return Required heading. @@ -257,10 +244,6 @@ TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) found. } - /// Returns the ID of the collection being loaded into the - /// database. - function CollectionID: TCollectionID; override; - function ErrorMessageHeading: string; override; {Returns heading to use in error messages. Identifies main database. @return Required heading. @@ -270,88 +253,162 @@ TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) } end; - {TODO -cVault: Extract common code in TNativeV4FormatSaver and - TDCSCV2FormatSaver into a common base class. } - - /// Class used to write data from a collection to storage in the - /// DelphiDabbler Code Snippets v2 data format. - TDCSCV2FormatSaver = class(TInterfacedObject, + /// Base for classes that save a collection to storage. + TFormatSaver = class abstract (TInterfacedObject, IDataFormatSaver ) strict private - const - BakFileID = SmallInt($DC52); var fWriter: IDataWriter; // Object used to write to storage fSnipList: TSnippetList; // List of snippets to be written fCategories: TCategoryList; // List of categories to be written fProvider: IDBDataProvider; // Object used to get data to be written fCollection: TCollection; // Collection being written - fBakFile: string; // Backup file used in case of failure - function CreateWriter: IDataWriter; - {Creates object that can write data for user-defined database to storage. - @return Requied writer object. - } - procedure WriteCategories; - {Writes information about categories to storage. - } + + /// Writes information about all snippets belonging to the + /// collection. procedure WriteSnippets; - {Writes information about all snippets to storage. - } + + /// Writes information about categories relevant to the + /// collection. + procedure WriteCategories; + + strict protected + + /// Saves collection to storage. + /// TSnippetList [in] List of all snippets + /// in the database. + /// TCategoryList [in] List of all + /// categories in the database. + /// IDBDataProvider [in] Object used to + /// obtain details of the data to be stored. + procedure DoSave(const SnipList: TSnippetList; + const Categories: TCategoryList; + const Provider: IDBDataProvider + ); + + /// Creates an object that can write data to storage in the + /// required format. + /// IDataWriter. Required writer object. + function CreateWriter: IDataWriter; virtual; abstract; + + /// Checks if a category can be written to storage. + /// TCategory [in] The category being + /// queried. + /// IStringList [in] List of the + /// names of all snippets in the category. + /// Boolean. True if category can be written, False + /// otherwise. + function CanWriteCategory(const ACategory: TCategory; + const ASnippetsInCategory: IStringList): Boolean; virtual; abstract; + + /// Collection being saved. + property Collection: TCollection read fCollection; + + public + /// Creates object that can save the given collection. + constructor Create(const ACollection: TCollection); + + /// Saves data to storage. + /// TSnippetList [in] List of all snippets + /// in the database. + /// TCategoryList [in] List of all + /// categories in the database. + /// IDBDataProvider [in] Object used to + /// obtain details of the data to be stored. + /// Method of IDataFormatSaver. + procedure Save(const SnipList: TSnippetList; + const Categories: TCategoryList; + const Provider: IDBDataProvider); virtual; abstract; + end; + + /// Class used to write data from a collection to storage in the + /// DelphiDabbler Code Snippets v2 data format. + TDCSCV2FormatSaver = class(TFormatSaver, + IDataFormatSaver + ) + strict private + const + BakFileID = SmallInt($DC52); + var + fBakFile: string; // Backup file used in case of failure + /// Backup current data. procedure Backup; + /// Restore current data. procedure Restore; + + strict protected + + /// Creates an object that can write data to storage in + /// DelphiDabbler Code Snippets v2 data format. + /// IDataWriter. Required writer object. + function CreateWriter: IDataWriter; override; + + /// Checks if a category can be written to storage. + /// TCategory [in] The category being + /// queried. + /// IStringList [in] List of the + /// names of all snippets in the category. + /// Boolean. True if category contains snippets, False + /// otherwise. + function CanWriteCategory(const ACategory: TCategory; + const ASnippetsInCategory: IStringList): Boolean; override; + public + + /// Creates object that can save the given collection. constructor Create(const ACollection: TCollection); /// Saves data to storage. - /// TSnippetList [in] Contains information - /// about each snippet to be saved. - /// TCategoryList [in] Contains information - /// about each category to be saved. + /// TSnippetList [in] List of all snippets + /// in the database. + /// TCategoryList [in] List of all + /// categories in the database. /// IDBDataProvider [in] Object used to /// obtain details of the data to be stored. /// Method of IDataFormatSaver. procedure Save(const SnipList: TSnippetList; const Categories: TCategoryList; - const Provider: IDBDataProvider); + const Provider: IDBDataProvider); override; end; /// Class used to write data from a collection to storage in /// CodeSnip's native v4 data format. - TNativeV4FormatSaver = class(TInterfacedObject, + TNativeV4FormatSaver = class(TFormatSaver, IDataFormatSaver ) - strict private - fWriter: IDataWriter; // Object used to write to storage - fSnipList: TSnippetList; // List of snippets to be written - fCategories: TCategoryList; // List of categories to be written - fProvider: IDBDataProvider; // Object used to get data to be written - fCollection: TCollection; // Collection being written - function CreateWriter: IDataWriter; - {Creates object that can write data for user-defined database to storage. - @return Requied writer object. - } - procedure WriteCategories; - {Writes information about categories to storage. - } - procedure WriteSnippets; - {Writes information about all snippets to storage. - } + strict protected + + /// Creates an object that can write data to storage in + /// CodeSnip's native v4 data format. + /// IDataWriter. Required writer object. + function CreateWriter: IDataWriter; override; + + /// Checks if a category can be written to storage. + /// TCategory [in] The category being + /// queried. + /// IStringList [in] List of the + /// names of all snippets in the category. + /// Boolean. Always True: all categories are written. + /// + function CanWriteCategory(const ACategory: TCategory; + const ASnippetsInCategory: IStringList): Boolean; override; + public - constructor Create(const ACollection: TCollection); + /// Saves data to storage. - /// TSnippetList [in] Contains information - /// about each snippet in the collection. - /// TCategoryList [in] Contains information - /// about each category in the collection. + /// TSnippetList [in] List of all snippets + /// in the database. + /// TCategoryList [in] List of all + /// categories in the database. /// IDBDataProvider [in] Object used to - /// obtain details of the data to storage. + /// obtain details of the data to be stored. /// Method of IDataFormatSaver. procedure Save(const SnipList: TSnippetList; const Categories: TCategoryList; - const Provider: IDBDataProvider); + const Provider: IDBDataProvider); override; end; { TDatabaseIOFactory } @@ -399,7 +456,7 @@ procedure TDatabaseLoader.CreateCategory(const CatID: string; @param CatData [in] Properties of category. } begin - fCategories.Add(fFactory.CreateCategory(CatID, CollectionID, CatData)); + fCategories.Add(fFactory.CreateCategory(CatID, Collection.UID, CatData)); end; procedure TDatabaseLoader.HandleException(const E: Exception); @@ -418,12 +475,7 @@ procedure TDatabaseLoader.HandleException(const E: Exception); function TDatabaseLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; begin - Result := Snippet.CollectionID = CollectionID; -end; - -function TDatabaseLoader.IsUserDatabase: Boolean; -begin - Result := CollectionID <> TCollectionID.__TMP__MainDBCollectionID; + Result := Snippet.CollectionID = Collection.UID; end; procedure TDatabaseLoader.Load(const SnipList: TSnippetList; @@ -544,12 +596,12 @@ procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); for SnippetName in SnippetNames do begin // Check if snippet exists in current database and add it to list if not - Snippet := fSnipList.Find(SnippetName, CollectionID); + Snippet := fSnipList.Find(SnippetName, Collection.UID); if not Assigned(Snippet) then begin fReader.GetSnippetProps(SnippetName, SnippetProps); Snippet := fFactory.CreateSnippet( - SnippetName, CollectionID, SnippetProps + SnippetName, Collection.UID, SnippetProps ); fSnipList.Add(Snippet); end; @@ -561,11 +613,6 @@ procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); { TDCSCV2FormatLoader } -function TDCSCV2FormatLoader.CollectionID: TCollectionID; -begin - Result := TCollectionID.__TMP__MainDBCollectionID; -end; - function TDCSCV2FormatLoader.CreateReader: IDataReader; {Creates reader object. If main database doesn't exist a nul reader is created. @@ -596,16 +643,11 @@ function TDCSCV2FormatLoader.FindSnippet(const SnippetName: string; } begin // We only search main database - Result := SnipList.Find(SnippetName, CollectionID); + Result := SnipList.Find(SnippetName, Collection.UID); end; { TNativeV4FormatLoader } -function TNativeV4FormatLoader.CollectionID: TCollectionID; -begin - Result := TCollectionID.__TMP__UserDBCollectionID; -end; - function TNativeV4FormatLoader.CreateReader: IDataReader; {Creates reader object. If user database doesn't exist a nul reader is created. @@ -639,7 +681,9 @@ function TNativeV4FormatLoader.FindSnippet(const SnippetName: string; begin // Search in user database - Result := SnipList.Find(SnippetName, CollectionID); + Result := SnipList.Find(SnippetName, Collection.UID); + {TODO -cVault: Delete the following - only allow references in same collection + } if not Assigned(Result) then // Not in user database: try main database Result := SnipList.Find(SnippetName, TCollectionID.__TMP__MainDBCollectionID); @@ -664,77 +708,28 @@ procedure TNativeV4FormatLoader.LoadCategories; end; end; -{ TDCSCV2FormatSaver } +{ TFormatSaver } -procedure TDCSCV2FormatSaver.Backup; -var - FB: TFolderBackup; -begin - FB := TFolderBackup.Create( - fCollection.Location.Directory, fBakFile, BakFileID - ); - try - FB.Backup; - finally - FB.Free; - end; -end; - -constructor TDCSCV2FormatSaver.Create(const ACollection: TCollection); +constructor TFormatSaver.Create(const ACollection: TCollection); begin inherited Create; fCollection := ACollection; - // Find an used temp file name in system temp directory - repeat - fBakFile := TPath.Combine( - TPath.GetTempPath, '~codesnip-' + TPath.GetGUIDFileName - ); - until not TFile.Exists(fBakFile); -end; - -function TDCSCV2FormatSaver.CreateWriter: IDataWriter; -begin - Result := TIniDataWriter.Create(fCollection.Location.Directory); end; -procedure TDCSCV2FormatSaver.Restore; -var - FB: TFolderBackup; -begin - FB := TFolderBackup.Create( - fCollection.Location.Directory, fBakFile, BakFileID - ); - try - FB.Restore; - finally - FB.Free; - end; -end; - -procedure TDCSCV2FormatSaver.Save(const SnipList: TSnippetList; +procedure TFormatSaver.DoSave(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); begin - Backup; - try - try - fSnipList := SnipList; - fCategories := Categories; - fProvider := Provider; - fWriter := CreateWriter; - fWriter.Initialise; - WriteCategories; - WriteSnippets; - fWriter.Finalise; - except - Restore; - raise ExceptObject; - end; - finally - TFile.Delete(fBakFile); - end; + fSnipList := SnipList; + fCategories := Categories; + fProvider := Provider; + fWriter := CreateWriter; + fWriter.Initialise; + WriteCategories; + WriteSnippets; + fWriter.Finalise; end; -procedure TDCSCV2FormatSaver.WriteCategories; +procedure TFormatSaver.WriteCategories; var Cat: TCategory; // loops through each category Props: TCategoryData; // category properties @@ -743,9 +738,8 @@ procedure TDCSCV2FormatSaver.WriteCategories; for Cat in fCategories do begin SnipList := fProvider.GetCategorySnippets(Cat); - if SnipList.Count > 0 then + if CanWriteCategory(Cat, SnipList) then begin - // Only write categories containing snippets Props := fProvider.GetCategoryProps(Cat); fWriter.WriteCatProps(Cat.ID, Props); fWriter.WriteCatSnippets(Cat.ID, SnipList); @@ -753,7 +747,7 @@ procedure TDCSCV2FormatSaver.WriteCategories; end; end; -procedure TDCSCV2FormatSaver.WriteSnippets; +procedure TFormatSaver.WriteSnippets; // Adds names of snippets from IDList to a string list function IDListToStrings(const IDList: ISnippetIDList): IStringList; @@ -772,7 +766,6 @@ procedure TDCSCV2FormatSaver.WriteSnippets; begin for Snippet in fSnipList do begin - // Only write user-defined snippets if Snippet.CollectionID = fCollection.UID then begin // Get and write a snippet's properties @@ -787,94 +780,92 @@ procedure TDCSCV2FormatSaver.WriteSnippets; end; end; -{ TNativeV4FormatSaver } +{ TDCSCV2FormatSaver } -constructor TNativeV4FormatSaver.Create(const ACollection: TCollection); +procedure TDCSCV2FormatSaver.Backup; +var + FB: TFolderBackup; begin - inherited Create; - fCollection := ACollection; + FB := TFolderBackup.Create( + Collection.Location.Directory, fBakFile, BakFileID + ); + try + FB.Backup; + finally + FB.Free; + end; end; -function TNativeV4FormatSaver.CreateWriter: IDataWriter; - {Creates object that can write data for user-defined items from Database to - storage. - @return Requied writer object. - } +function TDCSCV2FormatSaver.CanWriteCategory(const ACategory: TCategory; + const ASnippetsInCategory: IStringList): Boolean; begin - {TODO -cUDatabaseIO: Use Collection.Location.Directory instead} - Result := TXMLDataWriter.Create(TAppInfo.UserDataDir); + Result := ASnippetsInCategory.Count > 0 end; -procedure TNativeV4FormatSaver.Save(const SnipList: TSnippetList; - const Categories: TCategoryList; const Provider: IDBDataProvider); +constructor TDCSCV2FormatSaver.Create(const ACollection: TCollection); begin - fSnipList := SnipList; - fCategories := Categories; - fProvider := Provider; - fWriter := CreateWriter; - fWriter.Initialise; - WriteCategories; - WriteSnippets; - fWriter.Finalise; + inherited Create(ACollection); + // Find a temp file name in system temp directory that doesn't yet exist + repeat + fBakFile := TPath.Combine( + TPath.GetTempPath, '~codesnip-' + TPath.GetGUIDFileName + ); + until not TFile.Exists(fBakFile); end; -procedure TNativeV4FormatSaver.WriteCategories; - {Writes information about categories to storage. - } -var - Cat: TCategory; // loops through each category - Props: TCategoryData; // category properties - SnipList: IStringList; // list of names of snippets in a category +function TDCSCV2FormatSaver.CreateWriter: IDataWriter; begin - for Cat in fCategories do - begin - Props := fProvider.GetCategoryProps(Cat); - fWriter.WriteCatProps(Cat.ID, Props); - SnipList := fProvider.GetCategorySnippets(Cat); - fWriter.WriteCatSnippets(Cat.ID, SnipList); - end; + Result := TIniDataWriter.Create(Collection.Location.Directory); end; -procedure TNativeV4FormatSaver.WriteSnippets; - {Writes information about all snippets to storage. - } - - // --------------------------------------------------------------------------- - function IDListToStrings(const IDList: ISnippetIDList): IStringList; - {Copies snippet names from a snippet ID list to a string list. - @param IDList [in] Snippet ID List to be copied. - @return String list containing names. - } - var - ID: TSnippetID; // each id in snippet id list - begin - Result := TIStringList.Create; - for ID in IDList do - Result.Add(ID.Name); +procedure TDCSCV2FormatSaver.Restore; +var + FB: TFolderBackup; +begin + FB := TFolderBackup.Create( + Collection.Location.Directory, fBakFile, BakFileID + ); + try + FB.Restore; + finally + FB.Free; end; - // --------------------------------------------------------------------------- +end; -var - Snippet: TSnippet; // loops through each snippet in list - Props: TSnippetData; // snippet properties - Refs: TSnippetReferences; // snippet references +procedure TDCSCV2FormatSaver.Save(const SnipList: TSnippetList; + const Categories: TCategoryList; const Provider: IDBDataProvider); begin - for Snippet in fSnipList do - begin - // Only write user-defined snippets - if Snippet.CollectionID = fCollection.UID then - begin - // Get and write a snippet's properties - Props := fProvider.GetSnippetProps(Snippet); - fWriter.WriteSnippetProps(Snippet.Name, Props); - // Get and write a snippet's references - Refs := fProvider.GetSnippetRefs(Snippet); - fWriter.WriteSnippetUnits(Snippet.Name, Refs.Units); - fWriter.WriteSnippetDepends(Snippet.Name, IDListToStrings(Refs.Depends)); - fWriter.WriteSnippetXRefs(Snippet.Name, IDListToStrings(Refs.XRef)); + Backup; + try + try + DoSave(SnipList, Categories, Provider); + except + Restore; + raise ExceptObject; end; + finally + TFile.Delete(fBakFile); end; end; +{ TNativeV4FormatSaver } + +function TNativeV4FormatSaver.CanWriteCategory(const ACategory: TCategory; + const ASnippetsInCategory: IStringList): Boolean; +begin + Result := True; +end; + +function TNativeV4FormatSaver.CreateWriter: IDataWriter; +begin + Result := TXMLDataWriter.Create(Collection.Location.Directory); +end; + +procedure TNativeV4FormatSaver.Save(const SnipList: TSnippetList; + const Categories: TCategoryList; const Provider: IDBDataProvider); +begin + DoSave(SnipList, Categories, Provider); +end; + end. From 3bf7361ce068ccd286c325119268e947230ee089 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 7 Nov 2024 08:58:04 +0000 Subject: [PATCH 043/222] Rename TSnippetID & TSnippet Name props as Key Also renamed methods and parameters of TSnippetID and TSnippet that refer to "Name" to refer to "Key". Made minimal changes to calling code needed to compile. --- Src/DB.UDatabaseIO.pas | 18 ++++++++--------- Src/DB.UMain.pas | 14 ++++++------- Src/DB.USnippet.pas | 35 +++++++++++++++------------------ Src/Favourites.UPersist.pas | 2 +- Src/FmDependenciesDlg.pas | 4 ++-- Src/FmDuplicateSnippetDlg.pas | 6 +++--- Src/FmFavouritesDlg.pas | 4 ++-- Src/FmMain.pas | 2 +- Src/FmSnippetsEditorDlg.pas | 10 +++++----- Src/UCodeImportExport.pas | 10 +++++----- Src/UCodeImportMgr.pas | 6 +++--- Src/UDetailPageHTML.pas | 2 +- Src/USnippetHTML.pas | 4 ++-- Src/USnippetIDListIOHandler.pas | 2 +- Src/USnippetIDs.pas | 34 ++++++++++++++++---------------- Src/USnippetValidator.pas | 10 +++++----- Src/UTestUnit.pas | 5 +++-- 17 files changed, 83 insertions(+), 85 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 6baf3193b..29d6315f9 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -571,12 +571,12 @@ procedure TDatabaseLoader.LoadReferences(const Snippet: TSnippet); begin LoadSnippetReferences( - Snippet.Depends, fReader.GetSnippetDepends(Snippet.Name) + Snippet.Depends, fReader.GetSnippetDepends(Snippet.Key) ); LoadSnippetReferences( - Snippet.XRef, fReader.GetSnippetXRefs(Snippet.Name) + Snippet.XRef, fReader.GetSnippetXRefs(Snippet.Key) ); - fReader.GetSnippetUnits(Snippet.Name).CopyTo(Snippet.Units); + fReader.GetSnippetUnits(Snippet.Key).CopyTo(Snippet.Units); end; procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); @@ -749,14 +749,14 @@ procedure TFormatSaver.WriteCategories; procedure TFormatSaver.WriteSnippets; - // Adds names of snippets from IDList to a string list + // Adds snippet keys from IDList to a string list function IDListToStrings(const IDList: ISnippetIDList): IStringList; var ID: TSnippetID; // each id in snippet id list begin Result := TIStringList.Create; for ID in IDList do - Result.Add(ID.Name); + Result.Add(ID.Key); end; var @@ -770,12 +770,12 @@ procedure TFormatSaver.WriteSnippets; begin // Get and write a snippet's properties Props := fProvider.GetSnippetProps(Snippet); - fWriter.WriteSnippetProps(Snippet.Name, Props); + fWriter.WriteSnippetProps(Snippet.Key, Props); // Get and write a snippet's references Refs := fProvider.GetSnippetRefs(Snippet); - fWriter.WriteSnippetUnits(Snippet.Name, Refs.Units); - fWriter.WriteSnippetDepends(Snippet.Name, IDListToStrings(Refs.Depends)); - fWriter.WriteSnippetXRefs(Snippet.Name, IDListToStrings(Refs.XRef)); + fWriter.WriteSnippetUnits(Snippet.Key, Refs.Units); + fWriter.WriteSnippetDepends(Snippet.Key, IDListToStrings(Refs.Depends)); + fWriter.WriteSnippetXRefs(Snippet.Key, IDListToStrings(Refs.XRef)); end; end; end; diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index e732ddb2e..301da2d70 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -702,7 +702,7 @@ function TDatabase.CreateTempSnippet(const Snippet: TSnippet): TSnippet; ClassName + '.CreateTempSnippet: Snippet is a TSnippetEx'); Data := (Snippet as TSnippetEx).GetEditData; Result := TTempSnippet.Create( - Snippet.Name, Snippet.CollectionID, (Snippet as TSnippetEx).GetProps); + Snippet.Key, Snippet.CollectionID, (Snippet as TSnippetEx).GetProps); (Result as TTempSnippet).UpdateRefs( (Snippet as TSnippetEx).GetReferences, fSnippets ); @@ -952,7 +952,7 @@ function TDatabase.InternalAddSnippet(const SnippetName: string; (Result as TSnippetEx).UpdateRefs(Data.Refs, fSnippets); Cat := fCategories.Find(Result.Category); if not Assigned(Cat) then - raise ECodeSnip.CreateFmt(sCatNotFound, [Result.Category, Result.Name]); + raise ECodeSnip.CreateFmt(sCatNotFound, [Result.Category, Result.Key]); Cat.Snippets.Add(Result); fSnippets.Add(Result); end; @@ -1182,11 +1182,11 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; if NewName <> '' then SnippetName := NewName else - SnippetName := Snippet.Name; - // If name has changed then new name musn't exist in user database - if not StrSameText(SnippetName, Snippet.Name) then + SnippetName := Snippet.Key; + // If key has changed then new key musn't exist in user database + if not StrSameText(SnippetName, Snippet.Key) then if fSnippets.Find(SnippetName, TCollectionID.__TMP__UserDBCollectionID) <> nil then - raise ECodeSnip.CreateFmt(sCantRename, [Snippet.Name, SnippetName]); + raise ECodeSnip.CreateFmt(sCantRename, [Snippet.Key, SnippetName]); // We update by deleting old snippet and inserting new one // get lists of snippets that cross reference or depend on this snippet Dependents := TSnippetList.Create; @@ -1287,7 +1287,7 @@ function TCollectionDataProvider.GetCategorySnippets( Result := TIStringList.Create; for Snippet in Cat.Snippets do if Snippet.CollectionID = fCollectionID then - Result.Add(Snippet.Name); + Result.Add(Snippet.Key); end; function TCollectionDataProvider.GetSnippetProps( diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 7032f436d..fcfe0ef00 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -118,8 +118,8 @@ type TDisplayNameComparer = class(TComparer) fKind: TSnippetKind; // Kind of snippet this is fCategory: string; // Name of snippet's category fDescription: IActiveText; // Description of snippet - fSourceCode: string; // Snippet's source code - fName: string; // Name of snippet + fSourceCode: string; // Snippet source code + fKey: string; // Snippet key: unique in collection fDisplayName: string; // Display name of snippet fUnits: TStringList; // List of required units fDepends: TSnippetList; // List of required snippets @@ -138,9 +138,9 @@ type TDisplayNameComparer = class(TComparer) @return Required display name. } strict protected - procedure SetName(const Name: string); - {Sets Name property. - @param Name [in] New name. + procedure SetKey(const AKey: string); + {Sets Key property. + @param AKey [in] New key. } procedure SetProps(const Data: TSnippetData); {Sets snippet's properties. @@ -154,12 +154,12 @@ type TDisplayNameComparer = class(TComparer) /// Object constructor. Sets up snippet object with given property /// values belonging to a specified collection. - /// string [in] Name of snippet. + /// string [in] Snippet's key. /// TCollectionID [in] ID of collection /// to which the snippet belongs. ID must not be null. /// TSnippetData [in] Values of snippet /// properties. - constructor Create(const Name: string; const ACollectionID: TCollectionID; + constructor Create(const AKey: string; const ACollectionID: TCollectionID; const Props: TSnippetData); destructor Destroy; override; @@ -179,8 +179,8 @@ type TDisplayNameComparer = class(TComparer) {Kind of snippet represented by this object} property ID: TSnippetID read GetID; {Snippet's unique ID} - property Name: string read fName; - {Name of snippet} + property Key: string read fKey; + {Snippet key} property DisplayName: string read GetDisplayName; {Displat name of snippet} property Category: string read fCategory; @@ -414,7 +414,7 @@ function TSnippet.CanCompile: Boolean; Result := Kind <> skFreeform; end; -constructor TSnippet.Create(const Name: string; +constructor TSnippet.Create(const AKey: string; const ACollectionID: TCollectionID; const Props: TSnippetData); begin Assert(ClassType <> TSnippet, @@ -423,7 +423,7 @@ constructor TSnippet.Create(const Name: string; ClassName + '.Create: ACollectionID is null'); inherited Create; // Record simple property values - SetName(Name); + SetKey(AKey); SetProps(Props); // Create string list to store required units fUnits := TStringList.Create; @@ -451,7 +451,7 @@ function TSnippet.GetDisplayName: string; if GetDisplayNameValue <> '' then Result := GetDisplayNameValue else - Result := fName; + Result := fKey; end; function TSnippet.GetDisplayNameValue: string; @@ -464,7 +464,7 @@ function TSnippet.GetID: TSnippetID; @return Required ID. } begin - Result := TSnippetID.Create(fName, fCollectionID); + Result := TSnippetID.Create(fKey, fCollectionID); end; function TSnippet.IsEqual(const Snippet: TSnippet): Boolean; @@ -477,12 +477,9 @@ function TSnippet.IsEqual(const Snippet: TSnippet): Boolean; Result := Snippet.ID = Self.ID; end; -procedure TSnippet.SetName(const Name: string); - {Sets Name property. - @param Name [in] New name. - } +procedure TSnippet.SetKey(const AKey: string); begin - fName := Name; + fKey := AKey; end; procedure TSnippet.SetProps(const Data: TSnippetData); @@ -740,7 +737,7 @@ function TSnippetList.Find(const SnippetID: TSnippetID): TSnippet; @return Reference to required snippet or nil if not found. } begin - Result := Find(SnippetID.Name, SnippetID.CollectionID); + Result := Find(SnippetID.Key, SnippetID.CollectionID); end; function TSnippetList.GetEnumerator: TEnumerator; diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index 9fb4937dc..4d914bf08 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -134,7 +134,7 @@ class procedure TFavouritesPersist.Save(Favourites: TFavourites); SB.AppendLine(Watermark); for Fav in Favourites do begin - SB.Append(Fav.SnippetID.Name); + SB.Append(Fav.SnippetID.Key); SB.Append(TAB); SB.Append(BoolToStr(Fav.SnippetID.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, True)); SB.Append(TAB); diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index 00742823a..5a7c32bb4 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -399,8 +399,8 @@ function TDependenciesDlg.GetDisplayName: string; begin if fDisplayName <> '' then Exit(fDisplayName); - if fSnippetID.Name <> '' then - Exit(fSnippetID.Name); + if fSnippetID.Key <> '' then + Exit(fSnippetID.Key); Result := sUntitled; end; diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index f3a9831e3..48e1bfdbf 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -133,7 +133,7 @@ function TDuplicateSnippetDlg.DisallowedNames: IStringList; Result.CaseSensitive := False; for Snippet in Database.Snippets do if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then - Result.Add(Snippet.Name); + Result.Add(Snippet.Key); end; class function TDuplicateSnippetDlg.Execute(const AOwner: TComponent; @@ -179,9 +179,9 @@ procedure TDuplicateSnippetDlg.InitForm; SnippetCat: TCategory; begin inherited; - edUniqueName.Text := UniqueSnippetName(fSnippet.Name); + edUniqueName.Text := UniqueSnippetName(fSnippet.Key); edDisplayName.Text := StrIf( - StrSameStr(fSnippet.Name, fSnippet.DisplayName), '', fSnippet.DisplayName + StrSameStr(fSnippet.Key, fSnippet.DisplayName), '', fSnippet.DisplayName ); fCatList.ToStrings(cbCategory.Items); SnippetCat := Database.Categories.Find(fSnippet.Category); diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index 02fca4a25..06f92d52f 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -344,7 +344,7 @@ procedure TFavouritesDlg.actDisplayExecute(Sender: TObject); LI := fLVFavs.Selected as TFavouriteListItem; SelectedSnippet := LI.Favourite.SnippetID; fNotifier.DisplaySnippet( - SelectedSnippet.Name, + SelectedSnippet.Key, SelectedSnippet.CollectionID, chkNewTab.Checked ); @@ -367,7 +367,7 @@ procedure TFavouritesDlg.AddLVItem(const Favourite: TFavourite); if Assigned(Snippet) then LI.Caption := Snippet.DisplayName else - LI.Caption := Favourite.SnippetID.Name; + LI.Caption := Favourite.SnippetID.Key; if IsToday(Favourite.LastAccessed) then LI.SubItems.Add(TimeToStr(Favourite.LastAccessed)) else diff --git a/Src/FmMain.pas b/Src/FmMain.pas index 5b06ad27a..6b04f8107 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -770,7 +770,7 @@ procedure TMainForm.actEditSnippetExecute(Sender: TObject); Assert(TUserDBMgr.CanEdit(fMainDisplayMgr.CurrentView), ClassName + '.actEditSnippetExecute: Can''t edit current view item'); fNotifier.EditSnippet( - (fMainDisplayMgr.CurrentView as ISnippetView).Snippet.Name + (fMainDisplayMgr.CurrentView as ISnippetView).Snippet.Key ); // display of updated snippet is handled by snippets change event handler end; diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 6e1c15192..be21eced6 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -822,8 +822,8 @@ procedure TSnippetsEditorDlg.InitControls; chkUseHiliter.Checked := fSnippet.HiliteSource; frmDescription.DefaultEditMode := emAuto; frmDescription.ActiveText := fSnippet.Description; - edName.Text := fSnippet.Name; - if fSnippet.Name <> fSnippet.DisplayName then + edName.Text := fSnippet.Key; + if fSnippet.Key <> fSnippet.DisplayName then edDisplayName.Text := fSnippet.DisplayName else edDisplayName.Text := ''; @@ -876,7 +876,7 @@ procedure TSnippetsEditorDlg.InitForm; fEditData := (Database as IDatabaseEdit).GetEditableSnippetInfo(fSnippet); // Record snippet's original name, if any if Assigned(fSnippet) then - fOrigName := fSnippet.Name + fOrigName := fSnippet.Key else fOrigName := ''; // Populate controls with dynamic data @@ -985,11 +985,11 @@ procedure TSnippetsEditorDlg.UpdateReferences; for Snippet in Database.Snippets do begin // We ignore snippet being edited and main database snippets if there is - // a user-defined one with same name + // a user-defined one with same key if (Snippet.ID <> EditSnippetID) and ( (Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) or - not Assigned(Database.Snippets.Find(Snippet.Name, TCollectionID.__TMP__UserDBCollectionID)) + not Assigned(Database.Snippets.Find(Snippet.Key, TCollectionID.__TMP__UserDBCollectionID)) ) then begin // Decide if snippet can be added to depends list: must be correct kind diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index d190fc852..600e47990 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -256,7 +256,7 @@ function TCodeExporter.SnippetNames( begin Result := TIStringList.Create; for Snippet in SnipList do - Result.Add(Snippet.Name); + Result.Add(Snippet.Key); end; procedure TCodeExporter.WriteProgInfo(const ParentNode: IXMLNode); @@ -283,9 +283,9 @@ procedure TCodeExporter.WriteSnippet(const ParentNode: IXMLNode; var SnippetNode: IXMLNode; // new snippet node begin - // Create snippet node with attribute that specifies snippet name + // Create snippet node with attribute that specifies snippet key SnippetNode := fXMLDoc.CreateElement(ParentNode, cSnippetNode); - SnippetNode.Attributes[cSnippetNameAttr] := Snippet.Name; + SnippetNode.Attributes[cSnippetNameAttr] := Snippet.Key; // Add nodes for properties: (ignore category and xrefs) // description node is written even if empty (which it shouldn't be) fXMLDoc.CreateElement( @@ -293,8 +293,8 @@ procedure TCodeExporter.WriteSnippet(const ParentNode: IXMLNode; cDescriptionNode, TSnippetExtraHelper.BuildREMLMarkup(Snippet.Description) ); - // Snippet's display name is only written if different to Snippet's name - if Snippet.Name <> Snippet.DisplayName then + // Snippet's display name is only written if different to Snippet's key + if Snippet.Key <> Snippet.DisplayName then fXMLDoc.CreateElement(SnippetNode, cDisplayNameNode, Snippet.DisplayName); // source code is stored directly in XML, not in external file fXMLDoc.CreateElement(SnippetNode, cSourceCodeTextNode, Snippet.SourceCode); diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index a347b21d3..f2ae236d2 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -186,7 +186,7 @@ function TCodeImportMgr.DisallowedNames(const ExcludedName: string): Result.CaseSensitive := False; for Snippet in Database.Snippets do if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then - Result.Add(Snippet.Name); + Result.Add(Snippet.Key); for SnippetInfo in fSnippetInfoList do if not StrSameText(SnippetInfo.Name, ExcludedName) then Result.Add(SnippetInfo.Name); @@ -257,7 +257,7 @@ procedure TCodeImportMgr.UpdateDatabase; begin SnippetID := Depends[Idx]; CollectionID := TCollectionID.__TMP__UserDBCollectionID; - if Database.Snippets.Find(SnippetID.Name, CollectionID) = nil then + if Database.Snippets.Find(SnippetID.Key, CollectionID) = nil then CollectionID := TCollectionID.__TMP__MainDBCollectionID; SnippetID.CollectionID := CollectionID; Depends[Idx] := SnippetID; @@ -308,7 +308,7 @@ constructor TImportInfo.Create(const AOrigName, AImportAsName: string; function TImportInfoComparer.Compare(const Left, Right: TImportInfo): Integer; begin - Result := TSnippetID.CompareNames(Left.OrigName, Right.OrigName); + Result := TSnippetID.CompareKeys(Left.OrigName, Right.OrigName); end; { TImportInfoList } diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index d34ec1f5b..e231822f6 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -538,7 +538,7 @@ procedure TSnippetInfoPageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); ); Tplt.ResolvePlaceholderText( 'EditEventHandler', - TJavaScript.LiteralFunc('editSnippet', [GetSnippet.Name]) + TJavaScript.LiteralFunc('editSnippet', [GetSnippet.Key]) ); SnippetHTML := TSnippetHTML.Create(GetSnippet); try diff --git a/Src/USnippetHTML.pas b/Src/USnippetHTML.pas index caaca05a7..3d4a6fbc5 100644 --- a/Src/USnippetHTML.pas +++ b/Src/USnippetHTML.pas @@ -204,10 +204,10 @@ function TSnippetHTML.SnippetName: string; class function TSnippetHTML.SnippetALink(const Snippet: TSnippet): string; begin - // Create javascript link enclosing snippet name + // Create javascript link enclosing snippet key Result := JSALink( TJavaScript.LiteralFunc( - 'displaySnippet', [Snippet.Name, Snippet.CollectionID.ToHexString] + 'displaySnippet', [Snippet.Key, Snippet.CollectionID.ToHexString] ), 'snippet-link', Snippet.DisplayName diff --git a/Src/USnippetIDListIOHandler.pas b/Src/USnippetIDListIOHandler.pas index a67a37b67..64c47eeb9 100644 --- a/Src/USnippetIDListIOHandler.pas +++ b/Src/USnippetIDListIOHandler.pas @@ -162,7 +162,7 @@ procedure TSnippetIDListFileWriter.CreateContent( fBuilder.AppendLine(fWatermark); for SnippetID in SnippetIDs do begin - fBuilder.Append(SnippetID.Name); + fBuilder.Append(SnippetID.Key); fBuilder.Append(TAB); fBuilder.Append(Ord(SnippetID.CollectionID <> TCollectionID.__TMP__MainDBCollectionID)); fBuilder.AppendLine; diff --git a/Src/USnippetIDs.pas b/Src/USnippetIDs.pas index 81b5c7bc7..8b4ee35dd 100644 --- a/Src/USnippetIDs.pas +++ b/Src/USnippetIDs.pas @@ -26,18 +26,18 @@ interface type - /// Record that uniquely identifies a code snippet. Specifies name - /// and flag indicating whether snippet is user-defined. + /// Record that uniquely identifies a code snippet. + /// Comprises the snippet's key and collection. TSnippetID = record strict private var - /// Value of Name property. - fName: string; + /// Value of Key property. + fKey: string; fCollectionID: TCollectionID; procedure SetCollectionID(const AValue: TCollectionID); public - /// Name of snippet. - property Name: string read fName write fName; + /// Snippet's key. + property Key: string read fKey write fKey; /// ID of the collection to which a snippet with this ID belongs. /// @@ -47,7 +47,7 @@ TSnippetID = record /// Creates a record with given property values. /// ACollectionID must not be null. - constructor Create(const AName: string; const ACollectionID: TCollectionID); + constructor Create(const AKey: string; const ACollectionID: TCollectionID); /// Creates copy of given snippet ID constructor Clone(const Src: TSnippetID); @@ -58,12 +58,12 @@ TSnippetID = record /// SID or +ve if this record greater than SID. function CompareTo(const SID: TSnippetID): Integer; - /// Compares two snippet names. - /// string [in] First name. - /// string [in] Second name. - /// Integer. 0 if names are same, -ve if Left is less than Right or + /// Compares two snippet keys. + /// string [in] First key. + /// string [in] Second key. + /// Integer. 0 if keys are same, -ve if Left is less than Right or /// +ve Left is greater than Right. - class function CompareNames(const Left, Right: string): Integer; static; + class function CompareKeys(const Left, Right: string): Integer; static; /// Overload of equality operator for two TSnippetIDs. class operator Equal(const SID1, SID2: TSnippetID): Boolean; @@ -162,26 +162,26 @@ implementation constructor TSnippetID.Clone(const Src: TSnippetID); begin - Create(Src.Name, Src.CollectionID); + Create(Src.Key, Src.CollectionID); end; -class function TSnippetID.CompareNames(const Left, Right: string): Integer; +class function TSnippetID.CompareKeys(const Left, Right: string): Integer; begin Result := StrCompareText(Left, Right); end; function TSnippetID.CompareTo(const SID: TSnippetID): Integer; begin - Result := CompareNames(Name, SID.Name); + Result := CompareKeys(Key, SID.Key); if Result = 0 then // TODO -cNote: New comparison changes ordering (no problem tho!) Result := TCollectionID.Compare(CollectionID, SID.CollectionID); end; -constructor TSnippetID.Create(const AName: string; +constructor TSnippetID.Create(const AKey: string; const ACollectionID: TCollectionID); begin - fName := AName; + fKey := AKey; SetCollectionID(ACollectionID); end; diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index 0fc8ef764..1e8988921 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -172,7 +172,7 @@ class function TSnippetValidator.Validate(const Snippet: TSnippet; @return True if snippet valid or False if not. } begin - Result := ValidateName(Snippet.Name, False, ErrorMsg, ErrorSel) + Result := ValidateName(Snippet.Key, False, ErrorMsg, ErrorSel) and ValidateDescription(Snippet.Description.ToString, ErrorMsg, ErrorSel) and ValidateSourceCode(Snippet.SourceCode, ErrorMsg, ErrorSel) and ValidateDependsList(Snippet, ErrorMsg) @@ -241,8 +241,8 @@ class function TSnippetValidator.ValidateDependsList(const Snippet: TSnippet; resourcestring // Error messages sInvalidKind = 'Invalid snippet kind "%0:s" in depends list for snippet ' - + 'named "%1:s"'; - sCircular = '%0:s Snippet named "%1:s" cannot depend on itself.'; + + 'with key "%1:s"'; + sCircular = '%0:s snippet with key "%1:s" cannot depend on itself.'; var DeniedDepends: TSnippetKinds; // snippet kinds that can't be in depends list begin @@ -255,7 +255,7 @@ class function TSnippetValidator.ValidateDependsList(const Snippet: TSnippet; ErrorMsg := Format( sCircular, [ TSnippetKindInfoList.Items[Snippet.Kind].DisplayName, - Snippet.Name + Snippet.Key ] ); Exit; @@ -270,7 +270,7 @@ class function TSnippetValidator.ValidateDependsList(const Snippet: TSnippet; sInvalidKind, [ TSnippetKindInfoList.Items[Snippet.Kind].DisplayName, - Snippet.Name + Snippet.Key ] ); end; diff --git a/Src/UTestUnit.pas b/Src/UTestUnit.pas index eef7d44c5..d0b3f7a92 100644 --- a/Src/UTestUnit.pas +++ b/Src/UTestUnit.pas @@ -136,8 +136,9 @@ function TTestUnit.UnitName: string; begin if fSnippet.Kind = skUnit then Exit(TUnitAnalyser.UnitName(fSnippet.SourceCode)); - // Unit name is same as Snippet being tested, but with prefix to make unique - Result := cUnitPrefix + fSnippet.Name; + // Unit name is same as key of Snippet being tested, but with prefix to make + // unique + Result := cUnitPrefix + fSnippet.Key; // We ensure only ASCII characters are used in unit name. Any unsuitable // characters are replaced by underscore. // This is done because unit name is also used as unit file name. If we took From 4a59735c1819c823c0b56940ea7cd7379b2ddb74 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 7 Nov 2024 10:27:41 +0000 Subject: [PATCH 044/222] Rename params & vars to refer to snippet keys Several method parameter and local variable names that refer to snippet or snippet ID "names" were renamed to refer to keys. External object type library had similar renaming & Pascal code that interfaces with was changed accordingly. Some error messages were changed to refer to keys instead of snippet names. No method signatures (i.e. method names and / or parameter types) were changed. --- Src/DB.UDatabaseIO.pas | 78 +++++++++--------- Src/DB.UMain.pas | 122 +++++++++++++-------------- Src/DB.USnippet.pas | 29 +++---- Src/DBIO.UFileIOIntf.pas | 48 +++++------ Src/DBIO.UIniData.pas | 158 +++++++++++++++++------------------ Src/DBIO.UNulDataReader.pas | 54 ++++++------ Src/DBIO.UXMLDataIO.pas | 159 ++++++++++++++++++------------------ Src/ExternalObj.ridl | 12 +-- Src/IntfNotifier.pas | 10 ++- Src/UNotifier.pas | 16 ++-- Src/USnippetValidator.pas | 98 +++++++++++----------- Src/UUserDBMgr.pas | 16 ++-- Src/UWBExternal.pas | 37 ++++----- 13 files changed, 423 insertions(+), 414 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 29d6315f9..16a02c42c 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -151,10 +151,10 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) reader must be created. @return Reader object instance. } - function FindSnippet(const SnippetName: string; + function FindSnippet(const SnippetKey: string; const SnipList: TSnippetList): TSnippet; virtual; abstract; - {Finds the snippet object with a specified name. - @param SnippetName [in] Name of required snippet. + {Finds the snippet object with a specified key. + @param SnippetKey [in] Key of required snippet. @param SnipList [in] List of snippets to search. @return Reference to required snippet object or nil if snippet is not found. @@ -208,10 +208,10 @@ TDCSCV2FormatLoader = class(TDatabaseLoader, IDataFormatLoader) created. @return Reader object instance. } - function FindSnippet(const SnippetName: string; + function FindSnippet(const SnippetKey: string; const SnipList: TSnippetList): TSnippet; override; - {Finds the snippet object with a specified name in the main database. - @param SnippetName [in] Name of required snippet. + {Finds the snippet object with a specified key in the main database. + @param SnippetKey [in] Key of required snippet. @param SnipList [in] List of snippets to search. @return Reference to required snippet object or nil if snippet is not found. @@ -234,11 +234,11 @@ TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) created. @return Reader object instance. } - function FindSnippet(const SnippetName: string; + function FindSnippet(const SnippetKey: string; const SnipList: TSnippetList): TSnippet; override; - {Finds the snippet object with a specified name. If snippet is not in this + {Finds the snippet object with a specified key. If snippet is not in this (user) database the main database is searched. - @param SnippetName [in] Name of required snippet. + @param SnippetKey [in] Key of required snippet. @param SnipList [in] List of snippets to search. @return Reference to required snippet object or nil if snippet is not found. @@ -296,7 +296,7 @@ TFormatSaver = class abstract (TInterfacedObject, /// TCategory [in] The category being /// queried. /// IStringList [in] List of the - /// names of all snippets in the category. + /// keys of all snippets in the category. /// Boolean. True if category can be written, False /// otherwise. function CanWriteCategory(const ACategory: TCategory; @@ -350,7 +350,7 @@ TDCSCV2FormatSaver = class(TFormatSaver, /// TCategory [in] The category being /// queried. /// IStringList [in] List of the - /// names of all snippets in the category. + /// keys of all snippets in the category. /// Boolean. True if category contains snippets, False /// otherwise. function CanWriteCategory(const ACategory: TCategory; @@ -390,7 +390,7 @@ TNativeV4FormatSaver = class(TFormatSaver, /// TCategory [in] The category being /// queried. /// IStringList [in] List of the - /// names of all snippets in the category. + /// keys of all snippets in the category. /// Boolean. Always True: all categories are written. /// function CanWriteCategory(const ACategory: TCategory; @@ -549,20 +549,20 @@ procedure TDatabaseLoader.LoadReferences(const Snippet: TSnippet); // --------------------------------------------------------------------------- procedure LoadSnippetReferences(const RefList: TSnippetList; - const RefNames: IStringList); - {Creates a snippet list from names of snippets in a string list. If no - snippet with a given name is found no matching entry is added to snippet + const RefKeys: IStringList); + {Creates a snippet list from keys of snippets in a string list. If no + snippet with a given key is found no matching entry is added to snippet list. @param RefList [in] List to receive referenced snippets. - @param RefNames [in] List of snippet names. + @param RefKeys [in] List of snippet keys. } var - RefName: string; // referenced snippet name + RefKey: string; // referenced snippet key Reference: TSnippet; // referenced snippet object begin - for RefName in RefNames do + for RefKey in RefKeys do begin - Reference := FindSnippet(RefName, fSnipList); + Reference := FindSnippet(RefKey, fSnipList); if Assigned(Reference) then RefList.Add(Reference); end; @@ -584,24 +584,24 @@ procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); @param Cat [in] Category to be loaded. } var - SnippetNames: IStringList; // list of names of snippets in category + SnippetKeys: IStringList; // list of keys of snippets in category SnippetProps: TSnippetData; // properties of a snippet - SnippetName: string; // each name in name list + SnippetKey: string; // each key in key list Snippet: TSnippet; // references a snippet object begin FillChar(SnippetProps, SizeOf(SnippetProps), 0); - // Get names of all snippets in category - SnippetNames := fReader.GetCatSnippets(Cat.ID); - // Process each snippet name in list - for SnippetName in SnippetNames do + // Get keys of all snippets in category + SnippetKeys := fReader.GetCatSnippets(Cat.ID); + // Process each snippet key in list + for SnippetKey in SnippetKeys do begin // Check if snippet exists in current database and add it to list if not - Snippet := fSnipList.Find(SnippetName, Collection.UID); + Snippet := fSnipList.Find(SnippetKey, Collection.UID); if not Assigned(Snippet) then begin - fReader.GetSnippetProps(SnippetName, SnippetProps); + fReader.GetSnippetProps(SnippetKey, SnippetProps); Snippet := fFactory.CreateSnippet( - SnippetName, Collection.UID, SnippetProps + SnippetKey, Collection.UID, SnippetProps ); fSnipList.Add(Snippet); end; @@ -634,16 +634,16 @@ function TDCSCV2FormatLoader.ErrorMessageHeading: string; Result := sError; end; -function TDCSCV2FormatLoader.FindSnippet(const SnippetName: string; +function TDCSCV2FormatLoader.FindSnippet(const SnippetKey: string; const SnipList: TSnippetList): TSnippet; - {Finds the snippet object with a specified name in the main database. - @param SnippetName [in] Name of required snippet. + {Finds the snippet object with a specified key in the main database. + @param SnippetKey [in] Key of required snippet. @param SnipList [in] List of snippets to search. @return Reference to required snippet object or nil if snippet is not found. } begin // We only search main database - Result := SnipList.Find(SnippetName, Collection.UID); + Result := SnipList.Find(SnippetKey, Collection.UID); end; { TNativeV4FormatLoader } @@ -669,24 +669,22 @@ function TNativeV4FormatLoader.ErrorMessageHeading: string; Result := sError; end; -function TNativeV4FormatLoader.FindSnippet(const SnippetName: string; +function TNativeV4FormatLoader.FindSnippet(const SnippetKey: string; const SnipList: TSnippetList): TSnippet; - {Finds the snippet object with a specified name. If snippet is not in this + {Finds the snippet object with a specified key. If snippet is not in this (user) database the main database is searched. - @param SnippetName [in] Name of required snippet. + @param SnippetKey [in] Key of required snippet. @param SnipList [in] List of snippets to search. @return Reference to required snippet object or nil if snippet is not found. } - - begin // Search in user database - Result := SnipList.Find(SnippetName, Collection.UID); + Result := SnipList.Find(SnippetKey, Collection.UID); {TODO -cVault: Delete the following - only allow references in same collection } if not Assigned(Result) then // Not in user database: try main database - Result := SnipList.Find(SnippetName, TCollectionID.__TMP__MainDBCollectionID); + Result := SnipList.Find(SnippetKey, TCollectionID.__TMP__MainDBCollectionID); end; procedure TNativeV4FormatLoader.LoadCategories; @@ -733,7 +731,7 @@ procedure TFormatSaver.WriteCategories; var Cat: TCategory; // loops through each category Props: TCategoryData; // category properties - SnipList: IStringList; // list of names of snippets in a category + SnipList: IStringList; // list of keys of snippets in a category begin for Cat in fCategories do begin diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 301da2d70..f37e8dbdb 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -66,11 +66,11 @@ interface /// function GetCategoryProps(const Cat: TCategory): TCategoryData; - /// Retrieves names of all snippets that belong to a category. + /// Retrieves keys of all snippets that belong to a category. /// - /// Category [in] Category for which snippet names + /// Category [in] Category for which snippet keys /// are requested. - /// IStringList. List of snippet names. + /// IStringList. List of snippet keys. function GetCategorySnippets(const Cat: TCategory): IStringList; /// Retrieves all the properties of a snippet. @@ -129,14 +129,14 @@ interface const ACollectionID: TCollectionID; const Data: TCategoryData): TCategory; /// Creates a new snippet object. - /// string [in] Name of new snippet. Must not + /// string [in] New snippet's key. Must not /// exist in database /// TCollectionID [in] Collection /// containing the snippet. /// TSnippetData [in] Record describing /// snippet's properties. /// Instance of new snippet with no references. - function CreateSnippet(const Name: string; + function CreateSnippet(const Key: string; const ACollectionID: TCollectionID; const Props: TSnippetData): TSnippet; end; @@ -202,30 +202,30 @@ interface @return List of IDs of referring snippets. } function UpdateSnippet(const Snippet: TSnippet; - const Data: TSnippetEditData; const NewName: string = ''): TSnippet; + const Data: TSnippetEditData; const NewKey: string = ''): TSnippet; {Updates a user defined snippet's properties and references using provided data. @param Snippet [in] Snippet to be updated. Must be user-defined. @param Data [in] Record containing revised data. - @param NewName [in] New name of snippet. Set to '' or Snippet.Name if - name is not to change. + @param NewKey [in] New snippet's key. Set to '' or Snippet.Key if + key is not to change. @return Reference to updated snippet. Will have changed. } - function AddSnippet(const SnippetName: string; + function AddSnippet(const SnippetKey: string; const Data: TSnippetEditData): TSnippet; {Adds a new snippet to the user database. - @param SnippetName [in] Name of new snippet. + @param SnippetKey [in] New snippet's key. @param Data [in] Record storing new snippet's properties and references. @return Reference to new snippet. } function DuplicateSnippet(const Snippet: TSnippet; - const UniqueName, DisplayName: string; const CatID: string): TSnippet; - function CreateTempSnippet(const SnippetName: string; + const UniqueKey, DisplayName: string; const CatID: string): TSnippet; + function CreateTempSnippet(const SnippetKey: string; const Data: TSnippetEditData): TSnippet; overload; {Creates a new temporary snippet without adding it to the Snippets object's snippets list. The new instance may not be added to the Snippets object. - @param SnippetName [in] Name of new snippet. + @param SnippetKey [in] New snippet's key. @param Data [in] Record storing new snippet's properties and references. @return Reference to new snippet. } @@ -320,14 +320,14 @@ TDBDataItemFactory = class(TInterfacedObject, IDBDataItemFactory) const ACollectionID: TCollectionID; const Data: TCategoryData): TCategory; /// Creates a new snippet object. - /// string [in] Name of new snippet. Must not + /// string [in] New snippet's key. Must not /// exist in database /// TCollectionID [in] Collection /// containing the snippet. /// TSnippetData [in] Record describing /// snippet's properties. /// Instance of new snippet with no references. - function CreateSnippet(const Name: string; + function CreateSnippet(const Key: string; const ACollectionID: TCollectionID; const Props: TSnippetData): TSnippet; end; @@ -381,11 +381,11 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) @param Info [in] Reference to any further information for event. May be nil. } - function InternalAddSnippet(const SnippetName: string; + function InternalAddSnippet(const SnippetKey: string; const Data: TSnippetEditData): TSnippet; {Adds a new snippet to the user database. Assumes snippet not already in user database. - @param SnippetName [in] Name of new snippet. + @param SnippetKey [in] New snippet's key. @param Data [in] Properties and references of new snippet. @return Reference to new snippet object. @except Exception raised if snippet's category does not exist. @@ -469,30 +469,30 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) @return List of IDs of referring snippets. } function UpdateSnippet(const Snippet: TSnippet; - const Data: TSnippetEditData; const NewName: string = ''): TSnippet; + const Data: TSnippetEditData; const NewKey: string = ''): TSnippet; {Updates a user defined snippet's properties and references using provided data. @param Snippet [in] Snippet to be updated. Must be user-defined. @param Data [in] Record containing revised data. - @param NewName [in] New name of snippet. Set to '' or Snippet.Name if - name is not to change. + @param NewKey [in] New snippet's key. Set to '' or Snippet.Key if + key is not to change. @return Reference to updated snippet. Will have changed. } - function AddSnippet(const SnippetName: string; + function AddSnippet(const SnippetKey: string; const Data: TSnippetEditData): TSnippet; {Adds a new snippet to the user database. - @param SnippetName [in] Name of new snippet. + @param SnippetKey [in] New snippet's key. @param Data [in] Record storing new snippet's properties and references. @return Reference to new snippet. } function DuplicateSnippet(const Snippet: TSnippet; - const UniqueName, DisplayName: string; const CatID: string): TSnippet; - function CreateTempSnippet(const SnippetName: string; + const UniqueKey, DisplayName: string; const CatID: string): TSnippet; + function CreateTempSnippet(const SnippetKey: string; const Data: TSnippetEditData): TSnippet; overload; {Creates a new temporary user defined snippet without adding it to the Snippets object's snippets list. The new instance may not be added to the Snippets object. - @param SnippetName [in] Name of new snippet. + @param SnippetKey [in] New snippet's key. @param Data [in] Record storing new snippet's properties and references. @return Reference to new snippet. } @@ -569,11 +569,11 @@ TCollectionDataProvider = class(TInterfacedObject, IDBDataProvider) /// Method of IDBDataProvider function GetCategoryProps(const Cat: TCategory): TCategoryData; - /// Retrieves names of all snippets from the collection that - /// belong to a category. - /// Category [in] Category for which snippet names + /// Retrieves keys of all snippets from the collection that belong + /// to a category. + /// Category [in] Category for which snippet keys /// are requested. - /// IStringList. List of snippet names. + /// IStringList. List of snippet keys. /// Method of IDBDataProvider function GetCategorySnippets(const Cat: TCategory): IStringList; @@ -643,24 +643,24 @@ procedure TDatabase.AddChangeEventHandler(const Handler: TNotifyEventInfo); fChangeEvents.AddHandler(Handler); end; -function TDatabase.AddSnippet(const SnippetName: string; +function TDatabase.AddSnippet(const SnippetKey: string; const Data: TSnippetEditData): TSnippet; {Adds a new snippet to the user database. - @param SnippetName [in] Name of new snippet. + @param SnippetKey [in] New snippet's key. @param Data [in] Record storing new snippet's properties and references. @return Reference to new snippet. } resourcestring // Error message - sNameExists = 'Snippet "%s" already exists in user database'; + sKeyExists = 'Snippet with key "%s" already exists in user database'; begin Result := nil; // keeps compiler happy TriggerEvent(evChangeBegin); try - // Check if snippet with same name exists in user database: error if so - if fSnippets.Find(SnippetName, TCollectionID.__TMP__UserDBCollectionID) <> nil then - raise ECodeSnip.CreateFmt(sNameExists, [SnippetName]); - Result := InternalAddSnippet(SnippetName, Data); + // Check if snippet with same key exists in user database: error if so + if fSnippets.Find(SnippetKey, TCollectionID.__TMP__UserDBCollectionID) <> nil then + raise ECodeSnip.CreateFmt(sKeyExists, [SnippetKey]); + Result := InternalAddSnippet(SnippetKey, Data); Query.Update; TriggerEvent(evSnippetAdded, Result); finally @@ -708,17 +708,17 @@ function TDatabase.CreateTempSnippet(const Snippet: TSnippet): TSnippet; ); end; -function TDatabase.CreateTempSnippet(const SnippetName: string; +function TDatabase.CreateTempSnippet(const SnippetKey: string; const Data: TSnippetEditData): TSnippet; {Creates a new temporary user defined snippet without adding it to the Snippets object's snippets list. The new instance may not be added to the Snippets object. - @param SnippetName [in] Name of new snippet. + @param SnippetKey [in] New snippet's key. @param Data [in] Record storing new snippet's properties and references. @return Reference to new snippet. } begin - Result := TTempSnippet.Create(SnippetName, TCollectionID.__TMP__UserDBCollectionID, Data.Props); + Result := TTempSnippet.Create(SnippetKey, TCollectionID.__TMP__UserDBCollectionID, Data.Props); (Result as TTempSnippet).UpdateRefs(Data.Refs, fSnippets); end; @@ -795,14 +795,14 @@ destructor TDatabase.Destroy; end; function TDatabase.DuplicateSnippet(const Snippet: TSnippet; - const UniqueName, DisplayName: string; const CatID: string): TSnippet; + const UniqueKey, DisplayName: string; const CatID: string): TSnippet; var Data: TSnippetEditData; begin Data := (Snippet as TSnippetEx).GetEditData; Data.Props.Cat := CatID; Data.Props.DisplayName := DisplayName; - Result := AddSnippet(UniqueName, Data); + Result := AddSnippet(UniqueKey, Data); end; function TDatabase.GetCategories: TCategoryList; @@ -932,11 +932,11 @@ function TDatabase.InternalAddCategory(const CatID: string; fCategories.Add(Result); end; -function TDatabase.InternalAddSnippet(const SnippetName: string; +function TDatabase.InternalAddSnippet(const SnippetKey: string; const Data: TSnippetEditData): TSnippet; {Adds a new snippet to the user database. Assumes snippet not already in user database. - @param SnippetName [in] Name of new snippet. + @param SnippetKey [in] New snippet's key. @param Data [in] Properties and references of new snippet. @return Reference to new snippet object. @except Exception raised if snippet's category does not exist. @@ -945,10 +945,10 @@ function TDatabase.InternalAddSnippet(const SnippetName: string; Cat: TCategory; // category object containing new snippet resourcestring // Error message - sCatNotFound = 'Category "%0:s" referenced by new snippet named "%1:s" does ' - + 'not exist'; + sCatNotFound = 'Category "%0:s" referenced by new snippet with key "%1:s" ' + + 'does not exist'; begin - Result := TSnippetEx.Create(SnippetName, TCollectionID.__TMP__UserDBCollectionID, Data.Props); + Result := TSnippetEx.Create(SnippetKey, TCollectionID.__TMP__UserDBCollectionID, Data.Props); (Result as TSnippetEx).UpdateRefs(Data.Refs, fSnippets); Cat := fCategories.Find(Result.Category); if not Assigned(Cat) then @@ -1150,25 +1150,25 @@ function TDatabase.Updated: Boolean; end; function TDatabase.UpdateSnippet(const Snippet: TSnippet; - const Data: TSnippetEditData; const NewName: string): TSnippet; + const Data: TSnippetEditData; const NewKey: string): TSnippet; {Updates a user defined snippet's properties and references using provided data. @param Snippet [in] Snippet to be updated. Must be user-defined. @param Data [in] Record containing revised data. - @param NewName [in] New name of snippet. Set to '' or Snippet.Name if name + @param NewKey [in] New snippet's key. Set to '' or Snippet.Key if key is not to change. @return Reference to updated snippet. Will have changed. } var - SnippetName: string; // name of snippet + SnippetKey: string; // snippet key Dependent: TSnippet; // loops thru each snippetthat depends on Snippet Dependents: TSnippetList; // list of dependent snippets Referrer: TSnippet; // loops thru snippets that cross references Snippet Referrers: TSnippetList; // list of referencing snippets resourcestring // Error message - sCantRename = 'Can''t rename snippet named %0:s to %1:s: Snippet with name ' - + '%1:s already exists in user database'; + sCantChangeKey = 'Can''t change key of snippet with key %0:s to %1:s: ' + + 'Snippet with key %1:s already exists in user database'; begin Result := Snippet; // keeps compiler happy Assert(Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, @@ -1178,15 +1178,15 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; TriggerEvent(evChangeBegin); TriggerEvent(evBeforeSnippetChange, Snippet); try - // Calculate new name - if NewName <> '' then - SnippetName := NewName + // Calculate new key + if NewKey <> '' then + SnippetKey := NewKey else - SnippetName := Snippet.Key; + SnippetKey := Snippet.Key; // If key has changed then new key musn't exist in user database - if not StrSameText(SnippetName, Snippet.Key) then - if fSnippets.Find(SnippetName, TCollectionID.__TMP__UserDBCollectionID) <> nil then - raise ECodeSnip.CreateFmt(sCantRename, [Snippet.Key, SnippetName]); + if not StrSameText(SnippetKey, Snippet.Key) then + if fSnippets.Find(SnippetKey, TCollectionID.__TMP__UserDBCollectionID) <> nil then + raise ECodeSnip.CreateFmt(sCantChangeKey, [Snippet.Key, SnippetKey]); // We update by deleting old snippet and inserting new one // get lists of snippets that cross reference or depend on this snippet Dependents := TSnippetList.Create; @@ -1201,7 +1201,7 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; // delete the snippet InternalDeleteSnippet(Snippet); // add new snippet - Result := InternalAddSnippet(SnippetName, Data); + Result := InternalAddSnippet(SnippetKey, Data); // add new snippet to referrer list of referring snippets for Referrer in Referrers do Referrer.XRef.Add(Result); @@ -1256,10 +1256,10 @@ function TDBDataItemFactory.CreateCategory(const CatID: string; Result := TCategoryEx.Create(CatID, ACollectionID, Data); end; -function TDBDataItemFactory.CreateSnippet(const Name: string; +function TDBDataItemFactory.CreateSnippet(const Key: string; const ACollectionID: TCollectionID; const Props: TSnippetData): TSnippet; begin - Result := TSnippetEx.Create(Name, ACollectionID, Props); + Result := TSnippetEx.Create(Key, ACollectionID, Props); end; { TCollectionDataProvider } diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index fcfe0ef00..483ffe928 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -167,7 +167,8 @@ type TDisplayNameComparer = class(TComparer) } function IsEqual(const Snippet: TSnippet): Boolean; {Checks if this snippet is same as another snippet. Snippets are - considered equal if they have the same name and come from same database. + considered equal if they have the same key and come from the same + collection. @param Snippet [in] Snippet being compared. @return True if snippets are equal, False if not. } @@ -261,16 +262,16 @@ TSnippetList = class(TObject) @return Snippet at specified index in list. } - /// Finds a snippet in the list with whose name and collection ID + /// Finds a snippet in the list with whose key and collection ID /// match. - /// string [in] Name of snippet. + /// string [in] Snippet's key. /// TCollectionID [in] ID of collection /// to which the snippet belongs. /// Integer. [out] Set to the index of the /// required snippet in the list. Valid only if the snippet was found. /// /// Boolean. True if snippet found, False if not. - function Find(const SnippetName: string; const ACollectionID: TCollectionID; + function Find(const SnippetKey: string; const ACollectionID: TCollectionID; out Index: Integer): Boolean; overload; strict protected @@ -306,14 +307,14 @@ TSnippetList = class(TObject) @return Reference to required snippet or nil if not found. } - /// Finds a snippet in the list with whose name and collection ID + /// Finds a snippet in the list with whose key and collection ID /// match. - /// string [in] Name of snippet. + /// string [in] Snippet's key. /// TCollectionID [in] ID of collection /// to which the snippet belongs. /// TSnippet. Reference to the required snippet or nil if /// not found. - function Find(const SnippetName: string; + function Find(const SnippetKey: string; const ACollectionID: TCollectionID): TSnippet; overload; function Contains(const Snippet: TSnippet): Boolean; @@ -469,7 +470,7 @@ function TSnippet.GetID: TSnippetID; function TSnippet.IsEqual(const Snippet: TSnippet): Boolean; {Checks if this snippet is same as another snippet. Snippets are considered - equal if they have the same name and come from same database. + equal if they have the same key and come from the same collection. @param Snippet [in] Snippet being compared. @return True if snippets are equal, False if not. } @@ -703,7 +704,7 @@ destructor TSnippetList.Destroy; inherited; end; -function TSnippetList.Find(const SnippetName: string; +function TSnippetList.Find(const SnippetKey: string; const ACollectionID: TCollectionID; out Index: Integer): Boolean; var TempSnippet: TSnippet; // temp snippet used to perform search @@ -712,7 +713,7 @@ function TSnippetList.Find(const SnippetName: string; // We need a temporary snippet object in order to perform binary search using // object list's built in search NullData.Init; - TempSnippet := TTempSnippet.Create(SnippetName, ACollectionID, NullData); + TempSnippet := TTempSnippet.Create(SnippetKey, ACollectionID, NullData); try Result := fList.Find(TempSnippet, Index); finally @@ -720,12 +721,12 @@ function TSnippetList.Find(const SnippetName: string; end; end; -function TSnippetList.Find(const SnippetName: string; +function TSnippetList.Find(const SnippetKey: string; const ACollectionID: TCollectionID): TSnippet; var - Idx: Integer; // index of snippet name in list + Idx: Integer; // index of snippet key in list begin - if Find(SnippetName, ACollectionID, Idx) then + if Find(SnippetKey, ACollectionID, Idx) then Result := Items[Idx] else Result := nil; @@ -782,7 +783,7 @@ function TSnippetList.IsEqual(const AList: TSnippetList): Boolean; Result := Assigned(AList) and (Self.Count = AList.Count); if Result then begin - // Same number of snippets: scan list checking snippet names same. We can + // Same number of snippets: scan list checking snippet keys are same. We can // rely on items being in same order since lists are sorted for Idx := 0 to Pred(Self.Count) do begin diff --git a/Src/DBIO.UFileIOIntf.pas b/Src/DBIO.UFileIOIntf.pas index f9c88923e..d032816b5 100644 --- a/Src/DBIO.UFileIOIntf.pas +++ b/Src/DBIO.UFileIOIntf.pas @@ -38,7 +38,7 @@ interface @return True if database exists, False if not. } function GetAllCatIDs: IStringList; - {Get names of all categories in database. + {Get ids of all categories in database. @return List of category ids. } procedure GetCatProps(const CatID: string; var Props: TCategoryData); @@ -48,30 +48,30 @@ interface values of category properties by implementor. } function GetCatSnippets(const CatID: string): IStringList; - {Get names of all snippets in a category. + {Get keys of all snippets in a category. @param CatID [in] Id of category containing snippets. - @return List of snippet names. + @return List of snippet IDs. } - procedure GetSnippetProps(const Snippet: string; var Props: TSnippetData); + procedure GetSnippetProps(const SnippetKey: string; var Props: TSnippetData); {Get properties of a snippet. These are the fields of the snippet's record in the snippets "table". - @param Snippet [in] Name of snippet. + @param SnippetKey [in] Snippet's key. @param Props [in/out] Empty properties passed in. Record fields set to values of snippet's properties by implementor. } - function GetSnippetXRefs(const Snippet: string): IStringList; + function GetSnippetXRefs(const SnippetKey: string): IStringList; {Get list of all snippets that are cross referenced by a snippet. - @param Snippet [in] Name of snippet we need cross references for. - @return List of snippet names. + @param SnippetKey [in] Keyof snippet we need cross references for. + @return List of snippet keys. } - function GetSnippetDepends(const Snippet: string): IStringList; + function GetSnippetDepends(const SnippetKey: string): IStringList; {Get list of all snippet on which a given snippet depends. - @param Snippet [in] Name of snippet. - @return List of snippet names. + @param SnippetKey [in] Snippet's key. + @return List of snippet keys. } - function GetSnippetUnits(const Snippet: string): IStringList; + function GetSnippetUnits(const SnippetKey: string): IStringList; {Get list of all units referenced by a snippet. - @param Snippet [in] Name of snippet. + @param SnippetKey [in] Snippet's key. @return List of unit names. } end; @@ -100,33 +100,33 @@ interface {Write the list of snippets belonging to a category. Always called after WriteCatProps for any given category. @param CatID [in] ID of category. - @param SnipList [in] List of names of snippets. + @param SnipList [in] List of IDs of snippets. } - procedure WriteSnippetProps(const SnippetName: string; + procedure WriteSnippetProps(const SnippetKey: string; const Props: TSnippetData); {Write the properties of a snippet. Always called after all categories are written and before WriteSnippetUnits, so can be used to perform any per- snippet intialisation. - @param SnippetName [in] Name of snippet. + @param SnippetKey [in] Snippet's key. @param Props [in] Properties of snippet. } - procedure WriteSnippetUnits(const SnippetName: string; + procedure WriteSnippetUnits(const SnippetKey: string; const Units: IStringList); {Write the list of units required by a snippet. - @param SnippetName [in] Name of snippet. + @param SnippetKey [in] Snippet's key. @param Units [in] List of names of required units. } - procedure WriteSnippetDepends(const SnippetName: string; + procedure WriteSnippetDepends(const SnippetKey: string; const Depends: IStringList); {Write the list of snippets on which a snippet depends. - @param SnippetName [in] Name of snippet. - @param Depends [in] List of snippet names. + @param SnippetKey [in] Snippet's key. + @param Depends [in] List of snippet keys. } - procedure WriteSnippetXRefs(const SnippetName: string; + procedure WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); {Write the list of snippets that a snippet cross-references. - @param SnippetName [in] Name of snippet. - @param XRefs [in] List of snippet names. + @param SnippetKey [in] Snippet's key. + @param XRefs [in] List of snippet keys. } procedure Finalise; {Finalises the database. Always called after all other methods. diff --git a/Src/DBIO.UIniData.pas b/Src/DBIO.UIniData.pas index 04ab602a8..d314f8a61 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DBIO.UIniData.pas @@ -95,14 +95,14 @@ TIniFileCache = class(TObject) /// /// Returns ID of category associated with a snippet. /// - /// string [in] Name of snippet. + /// string [in] Snippet's key. /// string containing category ID - function SnippetToCat(const Snippet: string): string; + function SnippetToCat(const SnippetKey: string): string; /// /// Returns name of ini file containing details of a category. /// /// string [in] Id of category. - /// string containing bame of category's ini file + /// string containing name of category's ini file function CatToCatIni(const CatID: string): string; /// /// Loads indices of all names of categories and snippets in database. @@ -129,11 +129,11 @@ TIniFileCache = class(TObject) /// Gets a list from ini file of all of items of a specified kind that are /// referenced by a snippet. /// - /// string [in] Name of snippet. - /// string [in] Name of a key in ini file storing + /// string [in] Snippet's key. + /// string [in] Name of a key in ini file storing /// comma separated list of references. /// IStringList containing names of referenced items. - function GetSnippetReferences(const Snippet, RefName: string): IStringList; + function GetSnippetReferences(const SnippetKey, KeyName: string): IStringList; strict protected /// /// Extracts comma delimited text fields into a string list. @@ -173,37 +173,38 @@ TIniFileCache = class(TObject) /// record and updates relevant property fields. procedure GetCatProps(const CatID: string; var Props: TCategoryData); /// - /// Gets names of all snippets in a category. + /// Gets keys of all snippets in a category. /// /// string [in] Id of category. - /// IStringList containing names of snippets. + /// IStringList containing keys of snippets. function GetCatSnippets(const CatID: string): IStringList; /// /// Gets properties of a snippet. /// - /// string [in] Name of snippet. + /// string [in] Snippet's key. /// TSnippetData [in/out] Receives empty property /// record and updates relevant property fields. - procedure GetSnippetProps(const Snippet: string; var Props: TSnippetData); + procedure GetSnippetProps(const SnippetKey: string; + var Props: TSnippetData); /// /// Gets list of all snippets that are cross referenced by a specified /// snippet. /// - /// string [in] Name of snippet. - /// IStringList containing snippet names. - function GetSnippetXRefs(const Snippet: string): IStringList; + /// string [in] Snippet's key. + /// IStringList containing snippet keys. + function GetSnippetXRefs(const SnippetKey: string): IStringList; /// /// Gets list of all snippets on which a specified snippet depends. /// - /// string [in] Name of snippet. - /// IStringList containing snippet names. - function GetSnippetDepends(const Snippet: string): IStringList; + /// string [in] Snippet's key. + /// IStringList containing snippet keys. + function GetSnippetDepends(const SnippetKey: string): IStringList; /// /// Gets list of all units referenced by a snippet. /// - /// string [in] Name of snippet. + /// string [in] Snippet's key. /// IStringList containing unit names. - function GetSnippetUnits(const Snippet: string): IStringList; + function GetSnippetUnits(const SnippetKey: string): IStringList; end; /// Write a collection to disk in the DelphiDabbler Code Snippets @@ -327,11 +328,11 @@ TUTF8IniFileCache = class(TObject) /// Method of IDataWriter. procedure WriteCatProps(const CatID: string; const Props: TCategoryData); - /// Write the list of snippets belonging to a category. Always + /// Write the list of snippet keys belonging to a category. Always /// called after WriteCatProps for any given category. /// string [in] ID of category. - /// IStringList [in] List of names of - /// snippets. + /// IStringList [in] List of snippet keys. + /// /// Method of IDataWriter. procedure WriteCatSnippets(const CatID: string; const SnipList: IStringList); @@ -339,7 +340,7 @@ TUTF8IniFileCache = class(TObject) /// Write the properties of a snippet. Always called after all /// categories are written and before WriteSnippetUnits, so can be /// used to perform any per-snippet intialisation. - /// string [in] Name of snippet. + /// string [in] Snippet's key. /// TSnippetData [in] Properties of snippet. /// /// @@ -347,33 +348,33 @@ TUTF8IniFileCache = class(TObject) /// collection format v2.1.x. /// Method of IDataWriter. /// - procedure WriteSnippetProps(const SnippetName: string; + procedure WriteSnippetProps(const SnippetKey: string; const Props: TSnippetData); /// Write the list of units required by a snippet. - /// string [in] Name of snippet. + /// string [in] Snippet's key. /// IStringList [in] List of names of required /// units. /// Method of IDataWriter. - procedure WriteSnippetUnits(const SnippetName: string; + procedure WriteSnippetUnits(const SnippetKey: string; const Units: IStringList); /// Write the list of snippets on which a snippet depends. /// - /// string [in] Name of snippet. - /// IStringList [in] List of snippet names. + /// string [in] Snippet's key. + /// IStringList [in] List of snippet keys. /// /// Method of IDataWriter. - procedure WriteSnippetDepends(const SnippetName: string; + procedure WriteSnippetDepends(const SnippetKey: string; const Depends: IStringList); /// Write the list of snippets that a snippet cross-references. /// - /// string [in] Name of snippet. - /// IStringList [in] List of snippet names. + /// string [in] Snippet's keys. + /// IStringList [in] List of snippet keys. /// /// Method of IDataWriter. - procedure WriteSnippetXRefs(const SnippetName: string; + procedure WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); /// Finalises the output. Always called after all other methods. @@ -401,7 +402,7 @@ implementation UREMLDataIO, USnippetExtraHelper, USystemInfo, - UStrUtils, + UStrUtils, UUtils; @@ -531,12 +532,13 @@ function TIniDataReader.GetCatSnippets(const CatID: string): IStringList; end; end; -function TIniDataReader.GetSnippetDepends(const Snippet: string): IStringList; +function TIniDataReader.GetSnippetDepends(const SnippetKey: string): + IStringList; begin - Result := GetSnippetReferences(Snippet, cDependsName); + Result := GetSnippetReferences(SnippetKey, cDependsName); end; -procedure TIniDataReader.GetSnippetProps(const Snippet: string; +procedure TIniDataReader.GetSnippetProps(const SnippetKey: string; var Props: TSnippetData); var CatIni: TCustomIniFile; // .ini file associated with snippet's category @@ -546,7 +548,7 @@ procedure TIniDataReader.GetSnippetProps(const Snippet: string; /// Reads "StandardFormat" value from ini file. function GetStdFormatProperty: Boolean; begin - Result := CatIni.ReadBool(Snippet, cStdFormatName, True); + Result := CatIni.ReadBool(SnippetKey, cStdFormatName, True); end; /// Reads "Kind" value from ini file. @@ -554,7 +556,7 @@ procedure TIniDataReader.GetSnippetProps(const Snippet: string; var KindStr: string; // string value read from ini file begin - KindStr := CatIni.ReadString(Snippet, cKindName, ''); + KindStr := CatIni.ReadString(SnippetKey, cKindName, ''); if StrSameText(KindStr, 'freeform') then Result := skFreeform else if StrSameText(KindStr, 'routine') then @@ -581,7 +583,7 @@ procedure TIniDataReader.GetSnippetProps(const Snippet: string; Extra: string; // extra value from ini file if present begin try - Extra := CatIni.ReadString(Snippet, cExtraName, ''); + Extra := CatIni.ReadString(SnippetKey, cExtraName, ''); if Extra <> '' then // There is an "extra" value: use it to set Extra property. We ignore // any credits, credits url and comments values in this case @@ -590,9 +592,9 @@ procedure TIniDataReader.GetSnippetProps(const Snippet: string; // There is no "extra" value: use any comments, credits and credits URL // values to set Extra property Result := TSnippetExtraHelper.BuildActiveText( - CatIni.ReadString(Snippet, cCommentsName, ''), - CatIni.ReadString(Snippet, cCreditsName, ''), - CatIni.ReadString(Snippet, cCreditsURLName, '') + CatIni.ReadString(SnippetKey, cCommentsName, ''), + CatIni.ReadString(SnippetKey, cCreditsName, ''), + CatIni.ReadString(SnippetKey, cCreditsURLName, '') ); except // There was an error: use an empty property value @@ -606,7 +608,7 @@ procedure TIniDataReader.GetSnippetProps(const Snippet: string; var SnipFileName: string; // name of file containing source code begin - SnipFileName := CatIni.ReadString(Snippet, cSnipFileName, ''); + SnipFileName := CatIni.ReadString(SnippetKey, cSnipFileName, ''); try Result := fFileReader.ReadAllText(DataFile(SnipFileName)); except @@ -627,7 +629,7 @@ procedure TIniDataReader.GetSnippetProps(const Snippet: string; begin for CompID := Low(TCompilerID) to High(TCompilerID) do begin - CompRes := CatIni.ReadString(Snippet, cCompilerIDNames[CompID], '?'); + CompRes := CatIni.ReadString(SnippetKey, cCompilerIDNames[CompID], '?'); if CompRes = '' then CompRes := '?'; case CompRes[1] of @@ -648,12 +650,12 @@ procedure TIniDataReader.GetSnippetProps(const Snippet: string; REML: string; // REML code from DescEx field PlainText: string; // plain text from Desc field begin - REML := CatIni.ReadString(Snippet, cDescExName, ''); + REML := CatIni.ReadString(SnippetKey, cDescExName, ''); if REML <> '' then Result := TSnippetExtraHelper.BuildActiveText(REML) else begin - PlainText := CatIni.ReadString(Snippet, cDescName, ''); + PlainText := CatIni.ReadString(SnippetKey, cDescName, ''); if PlainText <> '' then Result := TSnippetExtraHelper.PlainTextToActiveText(PlainText) else @@ -664,7 +666,7 @@ procedure TIniDataReader.GetSnippetProps(const Snippet: string; /// Gets snippet's display name from ini file. function GetDisplayNameProperty: string; begin - Result := CatIni.ReadString(Snippet, cDisplayName, ''); + Result := CatIni.ReadString(SnippetKey, cDisplayName, ''); end; /// Get's snippet's test info from ini file. @@ -672,7 +674,7 @@ procedure TIniDataReader.GetSnippetProps(const Snippet: string; var Str: string; // string value read from ini file begin - Str := CatIni.ReadString(Snippet, cTestInfoName, 'basic'); + Str := CatIni.ReadString(SnippetKey, cTestInfoName, 'basic'); if StrSameText(Str, 'basic') then Result := stiBasic else if StrSameText(Str, 'advanced') then @@ -685,7 +687,7 @@ procedure TIniDataReader.GetSnippetProps(const Snippet: string; begin try // Get name of category associated with this snippet - CatID := SnippetToCat(Snippet); + CatID := SnippetToCat(SnippetKey); // Get snippet properties from values listed under snippet's section in // category's .ini file CatIni := fIniCache.GetIniFile(CatToCatIni(CatID)); @@ -705,29 +707,29 @@ procedure TIniDataReader.GetSnippetProps(const Snippet: string; end; end; -function TIniDataReader.GetSnippetReferences(const Snippet, - RefName: string): IStringList; +function TIniDataReader.GetSnippetReferences(const SnippetKey, + KeyName: string): IStringList; var CatIni: TCustomIniFile; // accesses snippet's category's .ini begin try // References are contained in comma separated value in category's ini file // under snippet's section - CatIni := fIniCache.GetIniFile(CatToCatIni(SnippetToCat(Snippet))); - Result := CommaStrToStrings(CatIni.ReadString(Snippet, RefName, '')); + CatIni := fIniCache.GetIniFile(CatToCatIni(SnippetToCat(SnippetKey))); + Result := CommaStrToStrings(CatIni.ReadString(SnippetKey, KeyName, '')); except HandleCorruptDatabase(ExceptObject); end; end; -function TIniDataReader.GetSnippetUnits(const Snippet: string): IStringList; +function TIniDataReader.GetSnippetUnits(const SnippetKey: string): IStringList; begin - Result := GetSnippetReferences(Snippet, cUnitsName); + Result := GetSnippetReferences(SnippetKey, cUnitsName); end; -function TIniDataReader.GetSnippetXRefs(const Snippet: string): IStringList; +function TIniDataReader.GetSnippetXRefs(const SnippetKey: string): IStringList; begin - Result := GetSnippetReferences(Snippet, cXRefName); + Result := GetSnippetReferences(SnippetKey, cXRefName); end; procedure TIniDataReader.HandleCorruptDatabase(const EObj: TObject); @@ -748,7 +750,7 @@ procedure TIniDataReader.HandleCorruptDatabase(const EObj: TObject); procedure TIniDataReader.LoadIndices; var - SnippetName: string; // each snippet name in a category + SnippetKey: string; // key of each snippet in a category CatIdx: Integer; // loops thru all categories CatSnippets: IStringList; // list of snippets in a single category begin @@ -761,8 +763,8 @@ procedure TIniDataReader.LoadIndices; begin // Get list of snippets in category ... CatSnippets := GetCatSnippets(fCatIDs[CatIdx]); - for SnippetName in CatSnippets do - fSnippetCatMap.Add(SnippetName, CatIdx); + for SnippetKey in CatSnippets do + fSnippetCatMap.Add(SnippetKey, CatIdx); end; end; @@ -771,16 +773,16 @@ function TIniDataReader.MasterFileName: string; Result := DataFile(cMasterFileName); end; -function TIniDataReader.SnippetToCat(const Snippet: string): string; +function TIniDataReader.SnippetToCat(const SnippetKey: string): string; var CatIdx: Integer; // index of category in category list for this snippet resourcestring // Error message - sMissingSnippet = 'Snippet "%s" not found in database.'; + sMissingSnippet = 'Snippet key "%s" not found in database.'; begin - if not fSnippetCatMap.ContainsKey(Snippet) then - raise EDataIO.CreateFmt(sMissingSnippet, [Snippet]); - CatIdx := fSnippetCatMap[Snippet]; + if not fSnippetCatMap.ContainsKey(SnippetKey) then + raise EDataIO.CreateFmt(sMissingSnippet, [SnippetKey]); + CatIdx := fSnippetCatMap[SnippetKey]; Result := fCatIDs[CatIdx]; end; @@ -906,15 +908,15 @@ procedure TIniDataWriter.WriteCatSnippets(const CatID: string; // Do nothing end; -procedure TIniDataWriter.WriteSnippetDepends(const SnippetName: string; +procedure TIniDataWriter.WriteSnippetDepends(const SnippetKey: string; const Depends: IStringList); begin fCurrentCatIni.WriteString( - SnippetName, cDependsName, Depends.GetText(',', False) + SnippetKey, cDependsName, Depends.GetText(',', False) ); end; -procedure TIniDataWriter.WriteSnippetProps(const SnippetName: string; +procedure TIniDataWriter.WriteSnippetProps(const SnippetKey: string; const Props: TSnippetData); const Kinds: array[TSnippetKind] of string = ( @@ -953,16 +955,16 @@ procedure TIniDataWriter.WriteSnippetProps(const SnippetName: string; TFileIO.WriteAllText(SourceFilePath, Props.SourceCode, TEncoding.UTF8, True); // snippet kind - fCurrentCatIni.WriteString(SnippetName, cKindName, Kinds[Props.Kind]); + fCurrentCatIni.WriteString(SnippetKey, cKindName, Kinds[Props.Kind]); // display name, if set if (Props.DisplayName <> '') then {TODO -cVault: strictly, for v2 format, this name must be <=64 chars} - fCurrentCatIni.WriteString(SnippetName, cDisplayName, Props.DisplayName); + fCurrentCatIni.WriteString(SnippetKey, cDisplayName, Props.DisplayName); // description (must be set for v2) fCurrentCatIni.WriteString( - SnippetName, + SnippetKey, cDescExName, DOUBLEQUOTE + ActiveTextToREML(Props.Desc) + DOUBLEQUOTE ); @@ -970,13 +972,13 @@ procedure TIniDataWriter.WriteSnippetProps(const SnippetName: string; // extra info, if set if Props.Extra.HasContent then fCurrentCatIni.WriteString( - SnippetName, + SnippetKey, cExtraName, DOUBLEQUOTE + ActiveTextToREML(Props.Extra) + DOUBLEQUOTE ); // snippet file reference - fCurrentCatIni.WriteString(SnippetName, cSnipFileName, SourceFileName); + fCurrentCatIni.WriteString(SnippetKey, cSnipFileName, SourceFileName); // compiler info for CompilerID := Low(TCompilerID) to High(TCompilerID) do @@ -984,14 +986,14 @@ procedure TIniDataWriter.WriteSnippetProps(const SnippetName: string; CompileResult := CompileResults[Props.CompilerResults[CompilerID]]; if CompileResult <> 'Q' then fCurrentCatIni.WriteString( - SnippetName, cCompilerIDNames[CompilerID], CompileResult + SnippetKey, cCompilerIDNames[CompilerID], CompileResult ); end; // test info: only write if not basic {TODO -cVault: Add support for AdvancedTest .Level & .URL} if Props.TestInfo <> stiBasic then - fCurrentCatIni.WriteString(SnippetName, cTestInfoName, TestInfo[Props.TestInfo]); + fCurrentCatIni.WriteString(SnippetKey, cTestInfoName, TestInfo[Props.TestInfo]); except @@ -1009,19 +1011,19 @@ procedure TIniDataWriter.WriteSnippetProps(const SnippetName: string; end; -procedure TIniDataWriter.WriteSnippetUnits(const SnippetName: string; +procedure TIniDataWriter.WriteSnippetUnits(const SnippetKey: string; const Units: IStringList); begin fCurrentCatIni.WriteString( - SnippetName, cUnitsName, Units.GetText(',', False) + SnippetKey, cUnitsName, Units.GetText(',', False) ); end; -procedure TIniDataWriter.WriteSnippetXRefs(const SnippetName: string; +procedure TIniDataWriter.WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); begin fCurrentCatIni.WriteString( - SnippetName, cXRefName, XRefs.GetText(',', False) + SnippetKey, cXRefName, XRefs.GetText(',', False) ); end; diff --git a/Src/DBIO.UNulDataReader.pas b/Src/DBIO.UNulDataReader.pas index ab6e8ecf2..fff3aedf5 100644 --- a/Src/DBIO.UNulDataReader.pas +++ b/Src/DBIO.UNulDataReader.pas @@ -46,30 +46,31 @@ TNulDataReader = class(TInterfacedObject, @param Props [in/out] Empty properties passed in. Unchanged. } function GetCatSnippets(const CatID: string): IStringList; - {Gets names of all snippets in a category. + {Gets keys of all snippets in a category. @param CatID [in] Id of category containing snippets. - @return Empty list. + @return Empty snippet key list. } - procedure GetSnippetProps(const Snippet: string; var Props: TSnippetData); + procedure GetSnippetProps(const SnippetKey: string; + var Props: TSnippetData); {Gets properties of a snippet. These are the fields of the snippet's record in the snippets "table". - @param Snippet [in] Name of required snippet. + @param SnippetKey [in] Keys of required snippet. @param Props [in/out] Empty properties passed in. Unchanged. } - function GetSnippetXRefs(const Snippet: string): IStringList; + function GetSnippetXRefs(const SnippetKey: string): IStringList; {Gets list of all snippets that are cross referenced by a snippet. - @param Snippet [in] Name of snippet we need cross references for. - @return Empty list. + @param SnippetKey [in] Key of snippet we need cross references for. + @return Empty snippet key list. } - function GetSnippetDepends(const Snippet: string): IStringList; + function GetSnippetDepends(const SnippetKey: string): IStringList; {Gets list of all snippets on which a given snippet depends. - @param Snippet [in] Name of required snippet. - @return Empty list. + @param SnippetKey [in] Key of required snippet. + @return Empty snippet key list. } - function GetSnippetUnits(const Snippet: string): IStringList; + function GetSnippetUnits(const SnippetKey: string): IStringList; {Gets list of all units referenced by a snippet. - @param Snippet [in] Name of required snippet. - @return Empty list. + @param SnippetKey [in] Key of required snippet. + @return Empty unit name list. } end; @@ -107,47 +108,48 @@ procedure TNulDataReader.GetCatProps(const CatID: string; end; function TNulDataReader.GetCatSnippets(const CatID: string): IStringList; - {Gets names of all snippets in a category. + {Gets keys of all snippets in a category. @param CatID [in] Id of category containing snippets. - @return Empty list. + @return Empty snippey key list. } begin Result := TIStringList.Create; end; -function TNulDataReader.GetSnippetDepends(const Snippet: string): IStringList; +function TNulDataReader.GetSnippetDepends(const SnippetKey: string): + IStringList; {Gets list of all snippets on which a given snippet depends. - @param Snippet [in] Name of required snippet. - @return Empty list. + @param SnippetKey [in] Key of required snippet. + @return Empty snippet key list. } begin Result := TIStringList.Create; end; -procedure TNulDataReader.GetSnippetProps(const Snippet: string; +procedure TNulDataReader.GetSnippetProps(const SnippetKey: string; var Props: TSnippetData); {Gets properties of a snippet. These are the fields of the snippet's record in the snippets "table". - @param Snippet [in] Name of required snippet. + @param SnippetKey [in] Key of required snippet. @param Props [in/out] Empty properties passed in. Unchanged. } begin // Do nothing end; -function TNulDataReader.GetSnippetUnits(const Snippet: string): IStringList; +function TNulDataReader.GetSnippetUnits(const SnippetKey: string): IStringList; {Gets list of all units referenced by a snippet. - @param Snippet [in] Name of required snippet. - @return Empty list. + @param SnippetKey [in] Key of required snippet. + @return Empty unit name list. } begin Result := TIStringList.Create; end; -function TNulDataReader.GetSnippetXRefs(const Snippet: string): IStringList; +function TNulDataReader.GetSnippetXRefs(const SnippetKey: string): IStringList; {Gets list of all snippets that are cross referenced by a snippet. - @param Snippet [in] Name of snippet we need cross references for. - @return Empty list. + @param SnippetKey [in] Key of snippet we need cross references for. + @return Empty snippet key list. } begin Result := TIStringList.Create; diff --git a/Src/DBIO.UXMLDataIO.pas b/Src/DBIO.UXMLDataIO.pas index 0d1c0c0fc..eb0ec1db5 100644 --- a/Src/DBIO.UXMLDataIO.pas +++ b/Src/DBIO.UXMLDataIO.pas @@ -56,9 +56,9 @@ TXMLDataIO = class(TInterfacedObject) @param CatID [in] Id of required category. @return Required node or nil if node doesn't exist. } - function FindSnippetNode(const SnippetName: string): IXMLNode; + function FindSnippetNode(const SnippetKey: string): IXMLNode; {Finds a specified snippet node for a snippet in the file. - @param SnippetName [in] Name of required snippet. + @param SnippetKey [in] Key of required snippet. @return Required node or nil if node doesn't exist. } public @@ -94,11 +94,12 @@ TXMLDataReader = class(TXMLDataIO, called. @except Exception always raised. } - function GetSnippetReferences(const Snippet, RefName: string): IStringList; + function GetSnippetReferences(const SnippetKey, RefName: string): + IStringList; {Get list of all specified references made by a snippet. - @param Snippet [in] Name of required snippet. + @param SnippetKey [in] Key of required snippet. @param RefName [in] Name of node containing snippet's references. - @return List of names of references. + @return List of references. } public constructor Create(const DBDir: string); @@ -123,29 +124,30 @@ TXMLDataReader = class(TXMLDataIO, values of category properties by implementor. } function GetCatSnippets(const CatID: string): IStringList; - {Get names of all snippets in a category. + {Get keys of all snippets in a category. @param CatID [in] Id of category containing snippets. - @return List of snippet names. + @return List of snippet keys. } - procedure GetSnippetProps(const Snippet: string; var Props: TSnippetData); + procedure GetSnippetProps(const SnippetKey: string; + var Props: TSnippetData); {Get properties of a snippet. - @param Snippet [in] Name of required snippet. + @param SnippetKey [in] Key of required snippet. @param Props [in/out] Empty properties passed in. Record fields set to values of snippet properties. } - function GetSnippetXRefs(const Snippet: string): IStringList; + function GetSnippetXRefs(const SnippetKey: string): IStringList; {Get list of all snippets that are cross referenced by a snippet. - @param Snippet [in] Name of snippet we need cross references for. - @return List of snippet names. + @param SnippetKey [in] Key of snippet we need cross references for. + @return List of snippet keys. } - function GetSnippetDepends(const Snippet: string): IStringList; + function GetSnippetDepends(const SnippetKey: string): IStringList; {Get list of all snippets on which a given snippet depends. - @param Snippet [in] Name of required snippet. - @return List of snippet names. + @param SnippetKey [in] Key of required snippet. + @return List of snippet keys. } - function GetSnippetUnits(const Snippet: string): IStringList; + function GetSnippetUnits(const SnippetKey: string): IStringList; {Get list of all units referenced by a snippet. - @param Snippet [in] Name of required snippet. + @param SnippetKey [in] Key of required snippet. @return List of unit names. } end; @@ -170,10 +172,10 @@ TXMLDataWriter = class(TXMLDataIO, @param ItemName [in] Name of each list item tag. @param Items [in] List of names in list. One ItemName node per name. } - procedure WriteReferenceList(const SnippetName, ListName: string; + procedure WriteReferenceList(const SnippetKey, ListName: string; const Items: IStringList); {Writes a snippet's reference list to XML. - @param SnippetName [in] Name of snippet whose reference list is to be + @param SnippetKey [in] Key of snippet whose reference list is to be written. @param ListName [in] Name of tag that encloses list entry. @param Items [in] List of items in reference list. @@ -198,36 +200,36 @@ TXMLDataWriter = class(TXMLDataIO, } procedure WriteCatSnippets(const CatID: string; const SnipList: IStringList); - {Write the list of snippets belonging to a category. Always called after - WriteCatProps for any given category. + {Write the list of snippets keys belonging to a category. Always called + after WriteCatProps for any given category. @param CatID [in] ID of category. - @param SnipList [in] List of names of snippets. + @param SnipList [in] List of snippet keys. } - procedure WriteSnippetProps(const SnippetName: string; + procedure WriteSnippetProps(const SnippetKey: string; const Props: TSnippetData); {Write the properties of a snippet. Always called after all categories are written and before WriteSnippetUnits, so can be used to perform any per- snippet intialisation. - @param SnippetName [in] Name of snippet. + @param SnippetKey [in] Snippet's key. @param Props [in] Properties of snippet. } - procedure WriteSnippetUnits(const SnippetName: string; + procedure WriteSnippetUnits(const SnippetKey: string; const Units: IStringList); {Write the list of units required by a snippet. - @param SnippetName [in] Name of snippet. + @param SnippetKey [in] Snippet's key. @param Units [in] List of names of required units. } - procedure WriteSnippetDepends(const SnippetName: string; + procedure WriteSnippetDepends(const SnippetKey: string; const Depends: IStringList); {Write the list of snippets on which a snippet depends. - @param SnippetName [in] Name of snippet. - @param Depends [in] List of snippet names. + @param SnippetKey [in] Snippet's key. + @param Depends [in] List of snippet keys. } - procedure WriteSnippetXRefs(const SnippetName: string; + procedure WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); {Write the list of snippets that a snippet cross-references. - @param SnippetName [in] Name of snippet. - @param XRefs [in] List of cross references snippets. + @param SnippetKey [in] Snippet's key. + @param XRefs [in] List of snippet keys. } procedure Finalise; {Finalises the database. Always called after all other methods. @@ -345,9 +347,9 @@ function TXMLDataIO.FindCategoryNode(const CatID: string): IXMLNode; ) end; -function TXMLDataIO.FindSnippetNode(const SnippetName: string): IXMLNode; +function TXMLDataIO.FindSnippetNode(const SnippetKey: string): IXMLNode; {Finds a specified snippet node for a snippet in the file. - @param SnippetName [in] Name of required snippet. + @param SnippetKey [in] Key of required snippet. @return Required node or nil if node doesn't exist. } var @@ -360,7 +362,7 @@ function TXMLDataIO.FindSnippetNode(const SnippetName: string): IXMLNode; Error(sMissingNode, [cSnippetsNode]); // Find required snippet node Result := fXMLDoc.FindFirstChildNode( - SnippetListNode, cSnippetNode, cSnippetNameAttr, SnippetName + SnippetListNode, cSnippetNode, cSnippetNameAttr, SnippetKey ); end; @@ -379,7 +381,7 @@ function TXMLDataIO.PathToXMLFile: string; // Error messages sNoCategoriesNode = 'No categories node in XML file'; sCatNotFound = 'Can''t find reference to category "%s" in XML file'; - sSnippetNotFound = 'Can''t find reference to snippet "%s" in XML file'; + sSnippetNotFound = 'Can''t find reference to snippet key "%s" in XML file'; sMissingSource = 'Source code file name missing for snippet "%s"'; sDBError = 'The database is corrupt and had been deleted.' + EOL2 + '%s'; @@ -472,9 +474,9 @@ procedure TXMLDataReader.GetCatProps(const CatID: string; end; function TXMLDataReader.GetCatSnippets(const CatID: string): IStringList; - {Get names of all snippets in a category. + {Get keys of all snippets in a category. @param CatID [in] Id of category containing snippets. - @return List of snippet names. + @return List of snippet keys. } var CatNode: IXMLNode; // reference to required category node @@ -494,19 +496,20 @@ function TXMLDataReader.GetCatSnippets(const CatID: string): IStringList; end; end; -function TXMLDataReader.GetSnippetDepends(const Snippet: string): IStringList; +function TXMLDataReader.GetSnippetDepends(const SnippetKey: string): + IStringList; {Get list of all snippets on which a given snippet depends. - @param Snippet [in] Name of required snippet. - @return List of snippet names. + @param SnippetKey [in] Key of required snippet. + @return List of snippet keys. } begin - Result := GetSnippetReferences(Snippet, cDependsNode); + Result := GetSnippetReferences(SnippetKey, cDependsNode); end; -procedure TXMLDataReader.GetSnippetProps(const Snippet: string; +procedure TXMLDataReader.GetSnippetProps(const SnippetKey: string; var Props: TSnippetData); {Get properties of a snippet. - @param Snippet [in] Name of required snippet. + @param SnippetKey [in] Key of required snippet. @param Props [in/out] Empty properties passed in. Record fields set to values of snippet's properties. } @@ -532,7 +535,7 @@ procedure TXMLDataReader.GetSnippetProps(const Snippet: string; begin DataFileName := GetPropertyText(cSourceCodeFileNode); if DataFileName = '' then - Error(sMissingSource, [Snippet]); + Error(sMissingSource, [SnippetKey]); try // load the file: before file v5 files used default encoding, from v5 // UTF-8 with no BOM was used @@ -628,9 +631,9 @@ procedure TXMLDataReader.GetSnippetProps(const Snippet: string; begin try // Find snippet node - SnippetNode := FindSnippetNode(Snippet); + SnippetNode := FindSnippetNode(SnippetKey); if not Assigned(SnippetNode) then - Error(sSnippetNotFound, [Snippet]); + Error(sSnippetNotFound, [SnippetKey]); // Snippet found: read properties Props.Cat := GetPropertyText(cCatIdNode); Props.DisplayName := GetPropertyText(cDisplayNameNode); @@ -649,21 +652,21 @@ procedure TXMLDataReader.GetSnippetProps(const Snippet: string; end; end; -function TXMLDataReader.GetSnippetReferences(const Snippet, - RefName: string): IStringList; +function TXMLDataReader.GetSnippetReferences(const SnippetKey, RefName: string): + IStringList; {Get list of all specified references made by a snippet. - @param Snippet [in] Name of required snippet. + @param SnippetKey [in] Key of required snippet. @param RefName [in] Name of node containing snippet's references. - @return List of names of references. + @return List of references. } var SnippetNode: IXMLNode; // node for required snippet begin try Result := TIStringList.Create; - SnippetNode := FindSnippetNode(Snippet); + SnippetNode := FindSnippetNode(SnippetKey); if not Assigned(SnippetNode) then - Error(sSnippetNotFound, [Snippet]); + Error(sSnippetNotFound, [SnippetKey]); // References are contained in a list of contained nodes TXMLDocHelper.GetPascalNameList( fXMLDoc, fXMLDoc.FindFirstChildNode(SnippetNode, RefName), Result @@ -673,22 +676,22 @@ function TXMLDataReader.GetSnippetReferences(const Snippet, end; end; -function TXMLDataReader.GetSnippetUnits(const Snippet: string): IStringList; +function TXMLDataReader.GetSnippetUnits(const SnippetKey: string): IStringList; {Get list of all units referenced by a snippet. - @param Snippet [in] Name of required snippet. - @return List of unit names. + @param SnippetKey [in] Key of required snippet. + @return List of unit keys. } begin - Result := GetSnippetReferences(Snippet, cUnitsNode); + Result := GetSnippetReferences(SnippetKey, cUnitsNode); end; -function TXMLDataReader.GetSnippetXRefs(const Snippet: string): IStringList; +function TXMLDataReader.GetSnippetXRefs(const SnippetKey: string): IStringList; {Get list of all snippets that are cross referenced by a snippet. - @param Snippet [in] Name of snippet we need cross references for. - @return List of snippet names. + @param SnippetKey [in] Key of snippet we need cross references for. + @return List of snippet keys. } begin - Result := GetSnippetReferences(Snippet, cXRefNode); + Result := GetSnippetReferences(SnippetKey, cXRefNode); end; procedure TXMLDataReader.HandleCorruptDatabase(const EObj: TObject); @@ -835,7 +838,7 @@ procedure TXMLDataWriter.WriteCatSnippets(const CatID: string; {Write the list of snippets belonging to a category. Always called after WriteCatProps for any given category. @param CatID [in] ID of category. - @param SnipList [in] List of names of snippets. + @param SnipList [in] List of snippet keyss. } var CatNode: IXMLNode; // reference to required category node @@ -872,10 +875,10 @@ procedure TXMLDataWriter.WriteNameList(const Parent: IXMLNode; const ListName, fXMLDoc.CreateElement(ListNode, ItemName, Item); end; -procedure TXMLDataWriter.WriteReferenceList(const SnippetName, ListName: string; +procedure TXMLDataWriter.WriteReferenceList(const SnippetKey, ListName: string; const Items: IStringList); {Writes a snippet's reference list to XML. - @param SnippetName [in] Name of snippet whose reference list is to be + @param SnippetKey [in] Key of snippet whose reference list is to be written. @param ListName [in] Name of tag that encloses list entry. @param Items [in] List of items in reference list. @@ -888,7 +891,7 @@ procedure TXMLDataWriter.WriteReferenceList(const SnippetName, ListName: string; if Items.Count = 0 then Exit; // Find snippet node - SnippetNode := FindSnippetNode(SnippetName); + SnippetNode := FindSnippetNode(SnippetKey); Assert(Assigned(SnippetNode), ClassName + '.WriteReferenceList: Can''t find snippet node'); // Write the list @@ -900,22 +903,22 @@ procedure TXMLDataWriter.WriteReferenceList(const SnippetName, ListName: string; end; end; -procedure TXMLDataWriter.WriteSnippetDepends(const SnippetName: string; +procedure TXMLDataWriter.WriteSnippetDepends(const SnippetKey: string; const Depends: IStringList); {Write the list of snippets on which a snippet depends. - @param SnippetName [in] Name of snippet. - @param Depends [in] List of snippet names. + @param SnippetKey [in] Snippet's key. + @param Depends [in] List of snippet keys. } begin - WriteReferenceList(SnippetName, cDependsNode, Depends); + WriteReferenceList(SnippetKey, cDependsNode, Depends); end; -procedure TXMLDataWriter.WriteSnippetProps(const SnippetName: string; +procedure TXMLDataWriter.WriteSnippetProps(const SnippetKey: string; const Props: TSnippetData); {Write the properties of a snippet. Always called after all categories are written and before WriteSnippetsUnits, so can be used to perform any per- snippet intialisation. - @param SnippetName [in] Name of snippet. + @param SnippetKey [in] Snippet's key. @param Props [in] Properties of snippet. } var @@ -928,7 +931,7 @@ procedure TXMLDataWriter.WriteSnippetProps(const SnippetName: string; try // Create snippet node SnippetNode := fXMLDoc.CreateElement(fSnippetsNode, cSnippetNode); - SnippetNode.Attributes[cSnippetNameAttr] := SnippetName; + SnippetNode.Attributes[cSnippetNameAttr] := SnippetKey; // Add properties fXMLDoc.CreateElement(SnippetNode, cCatIdNode, Props.Cat); // description node is written even if empty (which it shouldn't be) @@ -968,24 +971,24 @@ procedure TXMLDataWriter.WriteSnippetProps(const SnippetName: string; end; end; -procedure TXMLDataWriter.WriteSnippetUnits(const SnippetName: string; +procedure TXMLDataWriter.WriteSnippetUnits(const SnippetKey: string; const Units: IStringList); {Write the list of units required by a snippet. - @param SnippetName [in] Name of snippet. + @param SnippetKey [in] Snippet's key. @param Units [in] List of names of required units. } begin - WriteReferenceList(SnippetName, cUnitsNode, Units); + WriteReferenceList(SnippetKey, cUnitsNode, Units); end; -procedure TXMLDataWriter.WriteSnippetXRefs(const SnippetName: string; +procedure TXMLDataWriter.WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); {Write the list of snippets that a snippet cross-references. - @param SnippetName [in] Name of snippet. + @param SnippetKey [in] Snippet's key. @param XRefs [in] List of cross references snippets. } begin - WriteReferenceList(SnippetName, cXRefNode, XRefs); + WriteReferenceList(SnippetKey, cXRefNode, XRefs); end; end. diff --git a/Src/ExternalObj.ridl b/Src/ExternalObj.ridl index 47a60868b..22c549d50 100644 --- a/Src/ExternalObj.ridl +++ b/Src/ExternalObj.ridl @@ -45,13 +45,13 @@ library ExternalObj HRESULT _stdcall UpdateDbase(void); /* - * Display named snippet. - * @param SnippetName [in] Name of snippet to display. + * Display snippet identified by key and collection ID. + * @param Key [in] Snippet's key. * @param CollectionIDAsHex [in] Hex representation of snippet's * collection ID. */ [id(0x00000080)] - HRESULT _stdcall DisplaySnippet([in] BSTR SnippetName, + HRESULT _stdcall DisplaySnippet([in] BSTR Key, [in] BSTR CollectionIDAsHex, [in] VARIANT_BOOL NewTab); /* @@ -61,11 +61,11 @@ library ExternalObj HRESULT _stdcall ConfigCompilers(void); /* - * Edits the named snippet. - * @param SnippetName [in] Name of snippet to edit. Must be user defined. + * Edits the snippet identified by its key. + * @param Key [in] Key of snippet to edit. Must be user defined. */ [id(0x0000006C)] - HRESULT _stdcall EditSnippet([in] BSTR SnippetName); + HRESULT _stdcall EditSnippet([in] BSTR Key); /* * Display identified category. diff --git a/Src/IntfNotifier.pas b/Src/IntfNotifier.pas index 40141c9bd..5269ef3a2 100644 --- a/Src/IntfNotifier.pas +++ b/Src/IntfNotifier.pas @@ -34,13 +34,13 @@ interface procedure UpdateDbase; /// Displays a snippet. - /// WideString [in] Name of required snippet. + /// WideString [in] Required snippet's key. /// /// TCollectionID [in] ID of the snippet's /// collection. /// WordBool [in] Whether to display snippet in a new /// detail pane tab. - procedure DisplaySnippet(const SnippetName: WideString; + procedure DisplaySnippet(const Key: WideString; ACollectionID: TCollectionID; NewTab: WordBool); /// Displays a category. @@ -68,9 +68,11 @@ interface procedure ChangeDetailPane(const Pane: Integer); /// Edits a snippet in Snippets Editor. - /// WideString [in] Name of snippet. + /// WideString [in] Snippet's key. /// Snippet must be user defined. - procedure EditSnippet(const SnippetName: WideString); + procedure EditSnippet(const Key: WideString); + {TODO -cVault: lift restriction on being user-defined. Provide 2nd param + containing snippet's collection ID?} /// Opens Snippets Editor ready to create a new snippet. procedure NewSnippet; diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index 310c570e2..34df201cf 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -74,13 +74,13 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) procedure UpdateDbase; /// Displays a snippet. - /// WideString [in] Name of required snippet. + /// WideString [in] Required snippet's key. /// /// TCollectionID [in] ID of the snippet's /// collection. /// WordBool [in] Whether to display snippet in a new /// detail pane tab. - procedure DisplaySnippet(const SnippetName: WideString; + procedure DisplaySnippet(const Key: WideString; ACollectionID: TCollectionID; NewTab: WordBool); /// Displays a category. @@ -115,12 +115,12 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) procedure ChangeDetailPane(const Pane: Integer); /// Edits a snippet in Snippets Editor. - /// WideString [in] Name of snippet. + /// WideString [in] Snippet's key. /// /// Snippet must be user defined. /// Methods of INotifier. /// - procedure EditSnippet(const SnippetName: WideString); + procedure EditSnippet(const Key: WideString); /// Opens Snippets Editor ready to create a new snippet. /// Methods of INotifier. @@ -254,23 +254,23 @@ procedure TNotifier.DisplayCategory(const CatID: WideString; NewTab: WordBool); end; end; -procedure TNotifier.DisplaySnippet(const SnippetName: WideString; +procedure TNotifier.DisplaySnippet(const Key: WideString; ACollectionID: TCollectionID; NewTab: WordBool); begin if Assigned(fDisplaySnippetAction) then begin - (fDisplaySnippetAction as TSnippetAction).SnippetName := SnippetName; + (fDisplaySnippetAction as TSnippetAction).SnippetName := Key; (fDisplaySnippetAction as TSnippetAction).CollectionID := ACollectionID; (fDisplaySnippetAction as TSnippetAction).NewTab := NewTab; fDisplaySnippetAction.Execute; end; end; -procedure TNotifier.EditSnippet(const SnippetName: WideString); +procedure TNotifier.EditSnippet(const Key: WideString); begin if Assigned(fEditSnippetAction) then begin - (fEditSnippetAction as TEditSnippetAction).SnippetName := SnippetName; + (fEditSnippetAction as TEditSnippetAction).SnippetName := Key; fEditSnippetAction.Execute; end; end; diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index 1e8988921..d02e4e956 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -39,10 +39,10 @@ TSnippetValidator = class(TNoConstructObject) returned. @return True if dependency list is valid or False if not. } - class function ValidateDependsList(const SnippetName: string; + class function ValidateDependsList(const SnippetKey: string; const Data: TSnippetEditData; out ErrorMsg: string): Boolean; overload; {Recursively checks dependency list of a snippet for validity. - @param SnippetName [in] Name of snippet for which dependencies are to be + @param SnippetKey [in] Key of snippet for which dependencies are to be checked. @param Data [in] Data describing properties and references of snippet for which dependencies are to be checked. @@ -68,36 +68,36 @@ TSnippetValidator = class(TNoConstructObject) @param ErrorSel [out] Selection that can be used to highlight error. @return True if description is valid or False if not. } - class function ValidateName(const Name: string; + class function ValidateName(const Key: string; const CheckForUniqueness: Boolean): Boolean; overload; - {Validates a snippet's name. - @param Name [in] Snippet name to be checked. + {Validates a snippet's key. + @param Key [in] Snippet key to be checked. @param CheckForUniqueness [in] Flag indicating whether a check should - be made to see if snippet name is already in user database. - @return True if name is valid or False if not. + be made to see if snippet key is already in user database. + @return True if key is valid or False if not. } - class function ValidateName(const Name: string; + class function ValidateName(const Key: string; const CheckForUniqueness: Boolean; out ErrorMsg: string): Boolean; overload; - {Validates a snippet's name. - @param Name [in] Snippet name to be checked. + {Validates a snippet's key. + @param Key [in] Snippet key to be checked. @param CheckForUniqueness [in] Flag indicating whether a check should - be made to see if snippet name is already in user database. + be made to see if snippet key is already in user database. @param ErrorMsg [out] Message that describes error. Undefined if True returned. - @return True if name is valid or False if not. + @return True if key is valid or False if not. } - class function ValidateName(const Name: string; + class function ValidateName(const Key: string; const CheckForUniqueness: Boolean; out ErrorMsg: string; out ErrorSel: TSelection): Boolean; overload; - {Validates a snippet's name. - @param Name [in] Snippet name to be checked. + {Validates a snippet's key. + @param Key [in] Snippet key to be checked. @param CheckForUniqueness [in] Flag indicating whether a check should - be made to see if snippet name is already in user database. + be made to see if snippet key is already in user database. @param ErrorMsg [out] Message that describes error. Undefined if True returned. @param ErrorSel [out] Selection that can be used to highlight error. - @return True if name is valid or False if not. + @return True if key is valid or False if not. } class function ValidateExtra(const Extra: IActiveText; out ErrorMsg: string): Boolean; @@ -275,10 +275,10 @@ class function TSnippetValidator.ValidateDependsList(const Snippet: TSnippet; ); end; -class function TSnippetValidator.ValidateDependsList(const SnippetName: string; +class function TSnippetValidator.ValidateDependsList(const SnippetKey: string; const Data: TSnippetEditData; out ErrorMsg: string): Boolean; {Recursively checks dependency list of a snippet for validity. - @param SnippetName [in] Name of snippet for which dependencies are to be + @param SnippetKey [in] Key of snippet for which dependencies are to be checked. @param Data [in] Data describing properties and references of snippet for which dependencies are to be checked. @@ -290,7 +290,7 @@ class function TSnippetValidator.ValidateDependsList(const SnippetName: string; TempSnippet: TSnippet; // temporary snippet that is checked for dependencies begin TempSnippet := (Database as IDatabaseEdit).CreateTempSnippet( - SnippetName, Data + SnippetKey, Data ); try Result := ValidateDependsList(TempSnippet, ErrorMsg); @@ -348,67 +348,67 @@ class function TSnippetValidator.ValidateExtra(const Extra: IActiveText; ErrorMsg := ErrorInfo.Description; end; -class function TSnippetValidator.ValidateName(const Name: string; +class function TSnippetValidator.ValidateName(const Key: string; const CheckForUniqueness: Boolean; out ErrorMsg: string): Boolean; - {Validates a snippet's name. - @param Name [in] Snippet name to be checked. + {Validates a snippet's key. + @param Key [in] Snippet key to be checked. @param CheckForUniqueness [in] Flag indicating whether a check should be - made to see if snippet name is already in user database. + made to see if snippet key is already in user database. @param ErrorMsg [out] Message that describes error. Undefined if True returned. - @return True if name is valid or False if not. + @return True if key is valid or False if not. } resourcestring // Error messages - sErrNoName = 'A name must be provided'; - sErrDupName = '"%s" is already in the database. Please choose another name'; - sErrBadName = '"%s" is not a valid Pascal identifier'; + sErrNoKey = 'A key must be provided'; + sErrDupKey = 'Key "%s" is already in the database. Please choose another key'; + sErrBadKey = '"%s" is not a valid Pascal identifier'; var - TrimmedName: string; // Name param trimmed of leading trailing spaces + TrimmedKey: string; // Key param trimmed of leading trailing spaces begin Result := False; - TrimmedName := StrTrim(Name); - if TrimmedName = '' then - ErrorMsg := sErrNoName - else if not IsValidIdent(TrimmedName) then - ErrorMsg := Format(sErrBadName, [TrimmedName]) + TrimmedKey := StrTrim(Key); + if TrimmedKey = '' then + ErrorMsg := sErrNoKey + else if not IsValidIdent(TrimmedKey) then + ErrorMsg := Format(sErrBadKey, [TrimmedKey]) else if CheckForUniqueness and - (Database.Snippets.Find(TrimmedName, TCollectionID.__TMP__UserDBCollectionID) <> nil) then - ErrorMsg := Format(sErrDupName, [TrimmedName]) + (Database.Snippets.Find(TrimmedKey, TCollectionID.__TMP__UserDBCollectionID) <> nil) then + ErrorMsg := Format(sErrDupKey, [TrimmedKey]) else Result := True; end; -class function TSnippetValidator.ValidateName(const Name: string; +class function TSnippetValidator.ValidateName(const Key: string; const CheckForUniqueness: Boolean; out ErrorMsg: string; out ErrorSel: TSelection): Boolean; - {Validates a snippet's name. - @param Name [in] Snippet name to be checked. + {Validates a snippet's key. + @param Key [in] Snippet key to be checked. @param CheckForUniqueness [in] Flag indicating whether a check should be - made to see if snippet name is already in user database. + made to see if snippet key is already in user database. @param ErrorMsg [out] Message that describes error. Undefined if True returned. @param ErrorSel [out] Selection that can be used to highlight error. - @return True if name is valid or False if not. + @return True if key is valid or False if not. } begin - Result := ValidateName(Name, CheckForUniqueness, ErrorMsg); + Result := ValidateName(Key, CheckForUniqueness, ErrorMsg); if not Result then - ErrorSel := TSelection.Create(0, Length(Name)); + ErrorSel := TSelection.Create(0, Length(Key)); end; -class function TSnippetValidator.ValidateName(const Name: string; +class function TSnippetValidator.ValidateName(const Key: string; const CheckForUniqueness: Boolean): Boolean; - {Validates a snippet's name. - @param Name [in] Snippet name to be checked. + {Validates a snippet's key. + @param Key [in] Snippet key to be checked. @param CheckForUniqueness [in] Flag indicating whether a check should be - made to see if snippet name is already in user database. - @return True if name is valid or False if not. + made to see if snippet key is already in user database. + @return True if key is valid or False if not. } var DummyErrMsg: string; begin - Result := ValidateName(Name, CheckForUniqueness, DummyErrMsg); + Result := ValidateName(Key, CheckForUniqueness, DummyErrMsg); end; class function TSnippetValidator.ValidateSourceCode(const Source: string; diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 04f11cbb2..04b8d51b4 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -53,10 +53,10 @@ TUserDBMgr = class(TNoConstructObject) /// Enables user to adds a new user defined snippet to the /// database using the snippets editor. class procedure AddSnippet; - /// Enables user to edit the snippet with the given name using the + /// Enables user to edit the snippet with the given key using the /// snippets editor. - /// The named snippet must be user defined. - class procedure EditSnippet(const SnippetName: string); + /// The snippet must be user defined. + class procedure EditSnippet(const SnippetKey: string); /// Duplicates the snippet specified by the given view as a user /// defined snippet with name specified by user. class procedure DuplicateSnippet(ViewItem: IView); @@ -392,7 +392,9 @@ class function TUserDBMgr.DeleteDatabase: Boolean; class procedure TUserDBMgr.DeleteSnippet(ViewItem: IView); - // Builds a list of snippet names from a given snippet ID list. + {TODO -cVault: rename following inner method to SnippetDisplayNames for + clarity} + // Builds a list of snippet display names from a given snippet ID list. function SnippetNames(const IDList: ISnippetIDList): IStringList; var ID: TSnippetID; // loops through all IDs in list @@ -461,11 +463,13 @@ class procedure TUserDBMgr.DuplicateSnippet(ViewItem: IView); TDuplicateSnippetDlg.Execute(nil, (ViewItem as ISnippetView).Snippet); end; -class procedure TUserDBMgr.EditSnippet(const SnippetName: string); +class procedure TUserDBMgr.EditSnippet(const SnippetKey: string); + {TODO -cVault: lift restriction on being user defined. Change to take a + collection ID as 2nd param?} var Snippet: TSnippet; // reference to snippet to be edited begin - Snippet := Database.Snippets.Find(SnippetName, TCollectionID.__TMP__UserDBCollectionID); + Snippet := Database.Snippets.Find(SnippetKey, TCollectionID.__TMP__UserDBCollectionID); if not Assigned(Snippet) then raise EBug.Create(ClassName + '.EditSnippet: Snippet not in user database'); TSnippetsEditorDlg.EditSnippet(nil, Snippet); diff --git a/Src/UWBExternal.pas b/Src/UWBExternal.pas index 5e0b5ba08..a8f82be92 100644 --- a/Src/UWBExternal.pas +++ b/Src/UWBExternal.pas @@ -57,30 +57,27 @@ TWBExternal = class(TAutoIntfObject, IWBExternal15, ISetNotifier) /// Method of IWBExternal15. procedure UpdateDbase; safecall; - /// Displays the Configure Compilers dialogue box. - /// Displays a named snippet. - /// WideString [in] Name of snippet to be - /// displayed. - /// WideString [in] Hex string - /// representation of the ID of the collection to which the snippet - /// belongs. + /// Display snippet identified by key and collection ID. + /// WideString [in] Snippet's key. + /// WideString [in] Hex representation of + /// snippet's collection ID. /// WordBool [in] Whether to display snippet in a new /// tab. /// Method of IWBExternal15. - procedure DisplaySnippet(const SnippetName: WideString; + procedure DisplaySnippet(const Key: WideString; const CollectionIDAsHex: WideString; NewTab: WordBool); safecall; + /// Displays the Configure Compilers dialogue box. /// Method of IWBExternal15. procedure ConfigCompilers; safecall; - /// Edits a named snippet. - /// WideString [in] Name of snippet to be edited. - /// + /// Edits the snippet identified by its key. + /// WideString [in] Key of snippet to edit. /// - /// The named snippet must be user defined. + /// The snippet must be user defined. /// Method of IWBExternal15. /// - procedure EditSnippet(const SnippetName: WideString); safecall; + procedure EditSnippet(const Key: WideString); safecall; /// Displays a named category. /// WideString [in] ID of category to be displayed. @@ -158,26 +155,26 @@ procedure TWBExternal.DisplayCategory(const CatID: WideString; end; end; -procedure TWBExternal.DisplaySnippet(const SnippetName, - CollectionIDAsHex: WideString; NewTab: WordBool); +procedure TWBExternal.DisplaySnippet(const Key, CollectionIDAsHex: WideString; + NewTab: WordBool); begin try if Assigned(fNotifier) then fNotifier.DisplaySnippet( - SnippetName, - TCollectionID.CreateFromHexString(CollectionIDAsHex), - NewTab + Key, TCollectionID.CreateFromHexString(CollectionIDAsHex), NewTab ); except HandleException; end; end; -procedure TWBExternal.EditSnippet(const SnippetName: WideString); +procedure TWBExternal.EditSnippet(const Key: WideString); + {TODO -cVault: change to take a collection ID as hex string as 2nd param & + lift restriction on having to be user defined.} begin try if Assigned(fNotifier) then - fNotifier.EditSnippet(SnippetName); + fNotifier.EditSnippet(Key); except HandleException; end; From 0272cab93c517a127fe9ee8a1f80eedb846eac17 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 7 Nov 2024 13:37:03 +0000 Subject: [PATCH 045/222] Rewrite TUniqueID & add new GenerateAlpha method TUniqueID was completely rewritten as an advanced record instead of a TNoConstructObject class. The existing Generate method was totally rewritten and code shared between it and the new GenerateAlpha method was extract into a private method. --- Src/UUniqueID.pas | 93 +++++++++++++++++++++++++++++++---------------- 1 file changed, 62 insertions(+), 31 deletions(-) diff --git a/Src/UUniqueID.pas b/Src/UUniqueID.pas index cf18f058a..90bd9ef94 100644 --- a/Src/UUniqueID.pas +++ b/Src/UUniqueID.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a static class that generates globally unique id strings. + * Implements a generator of globally unique ids. } @@ -16,22 +16,36 @@ interface uses - // Project - UBaseObjects; + // Delphi + SysUtils; type - { - TUniqueID: - Static class that generates globally unique id strings. - } - TUniqueID = class(TNoConstructObject) + /// Generator of globally unique ids. + TUniqueID = record + strict private + + /// Generates a new GUID and returns it as an array of bytes. + /// + class function NewUID: TBytes; static; + public - class function Generate: string; - {Generates a 32 digit globally unique id string of hex characters. - @return Required unique id. - } + + /// Generates a globally unique string of 32 hexadecimal + /// characters. + class function Generate: string; static; + {TODO -cClarity: Rename above method as GenerateHex} + + /// Generates a globally unique string of 32 alphabetical + /// characters. + /// + /// The returned string comprises the letters 'A' to 'S', omitting + /// 'I' and 'O'. + /// The string is a valid Pascal identifier. + /// + class function GenerateAlpha: string; static; + end; @@ -39,34 +53,51 @@ implementation uses - // Delphi - SysUtils; + // Project + UUtils; { TUniqueID } class function TUniqueID.Generate: string; - {Generates a 32 digit globally unique id string of hex characters. - @return Required unique id. - } +var + Bytes: TBytes; + B: Byte; +begin + Bytes := NewUID; + Result := ''; + for B in Bytes do + Result := Result + IntToHex(B, 2); +end; + +class function TUniqueID.GenerateAlpha: string; type - TGUIDFragment = LongWord; // part of a TGUID - TGUIDFragments = // array of TGUID parts - assume same size as TGUID - array[1..SizeOf(TGUID) div SizeOf(TGUIDFragment)] of TGUIDFragment; + TNybble = 0..15; +const + AlphaMap: array[TNybble] of Char = ( + 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', + 'J', 'K', 'L', 'M', 'P', 'Q', 'R', 'S' + ); var - GUID: TGUID; // generated GUID - Idx: Integer; // loops through parts of GUID as an array + Bytes: TBytes; + B: Byte; begin - Assert(SizeOf(TGUID) = SizeOf(TGUIDFragments), - ClassName + '.Generate: Size of TGUID <> size of TGUIDFragments'); - // get a GUID - CreateGUID(GUID); + Bytes := NewUID; Result := ''; - // crack GUID into parts and build result from hex representation of the parts - for Idx := Low(TGUIDFragments) to High(TGUIDFragments) do - Result := Result + IntToHex( - TGUIDFragments(GUID)[Idx], 2 * SizeOf(TGUIDFragment) - ); + for B in Bytes do + begin + Result := Result + + AlphaMap[TNybble(B shr 4)] + + AlphaMap[TNybble(B and $0F)]; + end; +end; + +class function TUniqueID.NewUID: TBytes; +var + GUID: TGUID; +begin + CreateGUID(GUID); + Result := GUIDToBytes(GUID); end; end. From f284f32febec6759d9e298272278fb8befd773c7 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 7 Nov 2024 15:08:28 +0000 Subject: [PATCH 046/222] Add new TDatabase.GetUniqueSnippetKey method This method was added to IDatabaseEdit and implemented in TDatabase. It returns a 32 character alphabetical value that is unique within a given snippet collection. Its purpose to for use in new snippet keys. The key is also a valid Pascal identifier, so can be used as a unit name for test compiling. --- Src/DB.UMain.pas | 44 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index f37e8dbdb..6e5844c1e 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -182,6 +182,14 @@ interface } IDatabaseEdit = interface(IInterface) ['{CBF6FBB0-4C18-481F-A378-84BB09E5ECF4}'] + + /// Creates a new snippet key that is unique within the given + /// collection. + /// TCollectionID ID of collection that + /// the new key must be unique within. + /// string containing the key. + function GetUniqueSnippetKey(const ACollectionID: TCollectionID): string; + function GetEditableSnippetInfo(const Snippet: TSnippet = nil): TSnippetEditData; {Provides details of all a snippet's data (properties and references) that @@ -294,7 +302,8 @@ implementation IntfCommon, UExceptions, UQuery, - UStrUtils; + UStrUtils, + UUniqueID; var @@ -448,7 +457,17 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) {Removes a change event handler from list of listeners. @param Handler [in] Handler to remove from list. } + { IDatabaseEdit methods } + + /// Creates a new snippet key that is unique within the given + /// collection. + /// TCollectionID ID of collection that + /// the new key must be unique within. + /// string containing the key. + /// Method of IDatabaseEdit. + function GetUniqueSnippetKey(const ACollectionID: TCollectionID): string; + function GetEditableSnippetInfo(const Snippet: TSnippet = nil): TSnippetEditData; {Provides details of all a snippet's data (properties and references) that @@ -919,6 +938,29 @@ function TDatabase.GetSnippets: TSnippetList; Result := fSnippets; end; +function TDatabase.GetUniqueSnippetKey( + const ACollectionID: TCollectionID): string; +var + SnippetsInCollection: TSnippetList; + Snippet: TSnippet; +begin + // NOTE: It is probable that TUniqueID will always generate a key that is + // unique across the whole database, let alone within the collection. But it's + // safer to check and regenerate if necessary. + SnippetsInCollection := TSnippetList.Create; + try + // Build list of all snippets in collection + for Snippet in fSnippets do + if Snippet.CollectionID = ACollectionID then + SnippetsInCollection.Add(Snippet); + repeat + Result := TUniqueID.GenerateAlpha; + until SnippetsInCollection.Find(Result, ACollectionID) = nil; + finally + SnippetsInCollection.Free; + end; +end; + function TDatabase.InternalAddCategory(const CatID: string; const Data: TCategoryData): TCategory; {Adds a new category to the user database. Assumes category not already in From a1b5e576d38e36a7b7bc4b1a45167ecdf1e762d2 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 7 Nov 2024 15:47:44 +0000 Subject: [PATCH 047/222] Auto-generate snippet key in duplicate snippets dlg Removed the ability for the user to specify the snippet key (formerly the snippet name) in the Duplicate snippet dialogue box. The new snippet key is now automatically generated and is certain to be unique within the snippet's collection. It is now compulsory to enter a display name (because the key that is used for the display name by default is now a pseudo random sequence of characters & makes no sense as a name). Hard wired the "user" snippets collection. Later this should be chosen by the user. Put snippet display name in dialogue box caption in double quotes. --- Src/FmDuplicateSnippetDlg.dfm | 37 +++++------------- Src/FmDuplicateSnippetDlg.pas | 74 ++++++++++------------------------- 2 files changed, 30 insertions(+), 81 deletions(-) diff --git a/Src/FmDuplicateSnippetDlg.dfm b/Src/FmDuplicateSnippetDlg.dfm index 567120d7e..001fc6109 100644 --- a/Src/FmDuplicateSnippetDlg.dfm +++ b/Src/FmDuplicateSnippetDlg.dfm @@ -1,7 +1,7 @@ inherited DuplicateSnippetDlg: TDuplicateSnippetDlg Caption = 'DuplicateSnippetDlg' ExplicitWidth = 474 - ExplicitHeight = 356 + ExplicitHeight = 375 PixelsPerInch = 96 TextHeight = 13 inherited pnlBody: TPanel @@ -9,17 +9,9 @@ inherited DuplicateSnippetDlg: TDuplicateSnippetDlg Height = 185 ExplicitWidth = 222 ExplicitHeight = 185 - object lblUniqueName: TLabel - Left = 0 - Top = 0 - Width = 173 - Height = 13 - Caption = '&Unique name for duplicated snippet:' - FocusControl = edUniqueName - end object lblCategory: TLabel Left = 0 - Top = 104 + Top = 58 Width = 49 Height = 13 Caption = '&Category:' @@ -27,48 +19,37 @@ inherited DuplicateSnippetDlg: TDuplicateSnippetDlg end object lblDisplayName: TLabel Left = 0 - Top = 48 + Top = 2 Width = 67 Height = 13 Caption = '&Display name:' FocusControl = edDisplayName end - object edUniqueName: TEdit - Left = 0 - Top = 19 - Width = 222 - Height = 21 - Anchors = [akLeft, akTop, akRight] - TabOrder = 0 - ExplicitWidth = 200 - end object cbCategory: TComboBox Left = 0 - Top = 123 + Top = 77 Width = 222 Height = 21 Style = csDropDownList Anchors = [akLeft, akTop, akRight] - TabOrder = 2 + TabOrder = 1 end object edDisplayName: TEdit Left = 0 - Top = 67 + Top = 21 Width = 222 Height = 21 Anchors = [akLeft, akTop, akRight] - TabOrder = 1 - ExplicitWidth = 200 + TabOrder = 0 end object chkEdit: TCheckBox Left = 0 - Top = 160 + Top = 114 Width = 222 Height = 17 Anchors = [akLeft, akTop, akRight] Caption = '&Edit in Snippets Editor' - TabOrder = 3 - ExplicitWidth = 200 + TabOrder = 2 end end inherited btnHelp: TButton diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 48e1bfdbf..1910b83dd 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -19,6 +19,7 @@ interface // Delphi SysUtils, Controls, StdCtrls, ExtCtrls, Classes, // Project + DB.UCollections, DB.USnippet, FmGenericOKDlg, UBaseObjects, UCategoryListAdapter, UIStringList; @@ -28,10 +29,8 @@ TDuplicateSnippetDlg = class(TGenericOKDlg, INoPublicConstruct) cbCategory: TComboBox; chkEdit: TCheckBox; edDisplayName: TEdit; - edUniqueName: TEdit; lblCategory: TLabel; lblDisplayName: TLabel; - lblUniqueName: TLabel; procedure btnOKClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); @@ -52,8 +51,9 @@ TPersistentOptions = class(TObject) fSnippet: TSnippet; fCatList: TCategoryListAdapter; fOptions: TPersistentOptions; - function DisallowedNames: IStringList; - function UniqueSnippetName(const BaseName: string): string; + fSnippetKey: string; + /// ID of collection to receive the duplicated snippet. + function SelectedCollectionID: TCollectionID; procedure ValidateData; procedure HandleException(const E: Exception); procedure UpdateDatabase; @@ -77,7 +77,6 @@ implementation // Delphi Math, // Project - DB.UCollections, DB.UCategory, DB.UMain, UCtrlArranger, UExceptions, UMessageBox, USettings, USnippetValidator, UStructs, UStrUtils, UUserDBMgr; @@ -90,16 +89,11 @@ procedure TDuplicateSnippetDlg.ArrangeForm; TCtrlArranger.SetLabelHeights(Self); TCtrlArranger.AlignLefts( - [ - lblUniqueName, lblDisplayName, lblCategory, edUniqueName, edDisplayName, - cbCategory, chkEdit - ], + [lblDisplayName, lblCategory, edDisplayName, cbCategory, chkEdit], 0 ); - lblUniqueName.Top := 0; - TCtrlArranger.MoveBelow(lblUniqueName, edUniqueName, 4); - TCtrlArranger.MoveBelow(edUniqueName, lblDisplayName, 8); + lblDisplayName.Top := 0; TCtrlArranger.MoveBelow(lblDisplayName, edDisplayName, 4); TCtrlArranger.MoveBelow(edDisplayName, lblCategory, 8); TCtrlArranger.MoveBelow(lblCategory, cbCategory, 4); @@ -117,6 +111,9 @@ procedure TDuplicateSnippetDlg.ArrangeForm; procedure TDuplicateSnippetDlg.btnOKClick(Sender: TObject); begin try + fSnippetKey := (Database as IDatabaseEdit).GetUniqueSnippetKey( + SelectedCollectionID + ); ValidateData; UpdateDatabase; except @@ -125,23 +122,12 @@ procedure TDuplicateSnippetDlg.btnOKClick(Sender: TObject); end; end; -function TDuplicateSnippetDlg.DisallowedNames: IStringList; -var - Snippet: TSnippet; -begin - Result := TIStringList.Create; - Result.CaseSensitive := False; - for Snippet in Database.Snippets do - if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then - Result.Add(Snippet.Key); -end; - class function TDuplicateSnippetDlg.Execute(const AOwner: TComponent; const ASnippet: TSnippet): Boolean; var Dlg: TDuplicateSnippetDlg; resourcestring - sCaption = 'Duplicate %s'; // dialog box caption + sCaption = 'Duplicate "%s"'; // dialogue box caption begin Assert(Assigned(ASnippet), ClassName + '.Execute: ASnippet is nil'); Dlg := InternalCreate(AOwner); @@ -179,10 +165,7 @@ procedure TDuplicateSnippetDlg.InitForm; SnippetCat: TCategory; begin inherited; - edUniqueName.Text := UniqueSnippetName(fSnippet.Key); - edDisplayName.Text := StrIf( - StrSameStr(fSnippet.Key, fSnippet.DisplayName), '', fSnippet.DisplayName - ); + edDisplayName.Text := fSnippet.DisplayName; fCatList.ToStrings(cbCategory.Items); SnippetCat := Database.Categories.Find(fSnippet.Category); if Assigned(SnippetCat) then @@ -192,48 +175,33 @@ procedure TDuplicateSnippetDlg.InitForm; chkEdit.Checked := fOptions.EditSnippetOnClose; end; -function TDuplicateSnippetDlg.UniqueSnippetName(const BaseName: string): string; -var - ExistingNames: IStringList; - Postfix: Cardinal; +function TDuplicateSnippetDlg.SelectedCollectionID: TCollectionID; begin - ExistingNames := DisallowedNames; - if not ExistingNames.Contains(BaseName) then - Exit(BaseName); - // BaseName exists: find number to append to it to make name unique - Postfix := 1; - repeat - Inc(PostFix); - Result := BaseName + IntToStr(PostFix); - until not ExistingNames.Contains(Result); + {TODO -cCollections: change the following to return the ID of a collection + chosen by the user.} + Result := TCollectionID.__TMP__UserDBCollectionID; end; procedure TDuplicateSnippetDlg.UpdateDatabase; var - UniqueName: string; DisplayName: string; begin - UniqueName := StrTrim(edUniqueName.Text); DisplayName := StrTrim(edDisplayName.Text); (Database as IDatabaseEdit).DuplicateSnippet( fSnippet, - UniqueName, - StrIf(StrSameStr(UniqueName, DisplayName), '', DisplayName), + fSnippetKey, + DisplayName, fCatList.CatID(cbCategory.ItemIndex) ); end; procedure TDuplicateSnippetDlg.ValidateData; -var - ErrMsg: string; - ErrSel: TSelection; resourcestring sNoCategory = 'You must choose a category'; + sNoDisplayName = 'You must provide a display name'; begin - if not TSnippetValidator.ValidateName( - StrTrim(edUniqueName.Text), True, ErrMsg, ErrSel - ) then - raise EDataEntry.Create(ErrMsg, edUniqueName, ErrSel); + if StrTrim(edDisplayName.Text) = '' then + raise EDataEntry.Create(sNoDisplayName, edDisplayName); if cbCategory.ItemIndex = -1 then raise EDataEntry.Create(sNoCategory, cbCategory); end; @@ -248,7 +216,7 @@ procedure TDuplicateSnippetDlg.FormCreate(Sender: TObject); procedure TDuplicateSnippetDlg.FormDestroy(Sender: TObject); begin if (ModalResult = mrOK) and chkEdit.Checked then - TUserDBMgr.EditSnippet(StrTrim(edUniqueName.Text)); + TUserDBMgr.EditSnippet(fSnippetKey); fOptions.EditSnippetOnClose := chkEdit.Checked; inherited; fOptions.Free; From d56e17274d11b77bd8cab3094bdfa6d9aca8d5c0 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 7 Nov 2024 16:44:20 +0000 Subject: [PATCH 048/222] Add precondition to TSnippet & TSnippetID Key props Changed TSnippet and TSnippetID so that attempting to pass an empty or all whitespace key string to their constructors will result in an assertion failure. Also changed TSnippetID's Key property setter to support the same precondition check. Key strings are now trimmed before assigning to the properties. --- Src/DB.USnippet.pas | 3 ++- Src/USnippetIDs.pas | 11 +++++++++-- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 483ffe928..573955009 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -480,7 +480,8 @@ function TSnippet.IsEqual(const Snippet: TSnippet): Boolean; procedure TSnippet.SetKey(const AKey: string); begin - fKey := AKey; + fKey := StrTrim(AKey); + Assert(fKey <> '', ClassName + '.SetKey: AKey is whitespace or empty'); end; procedure TSnippet.SetProps(const Data: TSnippetData); diff --git a/Src/USnippetIDs.pas b/Src/USnippetIDs.pas index 8b4ee35dd..0cad2c12b 100644 --- a/Src/USnippetIDs.pas +++ b/Src/USnippetIDs.pas @@ -34,10 +34,11 @@ TSnippetID = record /// Value of Key property. fKey: string; fCollectionID: TCollectionID; + procedure SetKey(const AValue: string); procedure SetCollectionID(const AValue: TCollectionID); public /// Snippet's key. - property Key: string read fKey write fKey; + property Key: string read fKey write SetKey; /// ID of the collection to which a snippet with this ID belongs. /// @@ -181,7 +182,7 @@ function TSnippetID.CompareTo(const SID: TSnippetID): Integer; constructor TSnippetID.Create(const AKey: string; const ACollectionID: TCollectionID); begin - fKey := AKey; + SetKey(AKey); SetCollectionID(ACollectionID); end; @@ -201,6 +202,12 @@ procedure TSnippetID.SetCollectionID(const AValue: TCollectionID); fCollectionID := AValue.Clone; end; +procedure TSnippetID.SetKey(const AValue: string); +begin + fKey := StrTrim(AValue); + Assert(fKey <> '', 'TSnippetID.SetKey: Value is whitespace or empty'); +end; + { TSnippetIDList } function TSnippetIDList.Add(const SnippetID: TSnippetID): Integer; From 65f5b7e50f1a6698df6b29ae094816f5cfd2ee99 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 7 Nov 2024 19:10:02 +0000 Subject: [PATCH 049/222] Add TSnippetValidator.ValidateDisplayName method Added new TSnippetValidator method to validate display names, which must be non-empty when trimmed of white space. --- Src/USnippetValidator.pas | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index d02e4e956..d3452ea15 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -31,6 +31,17 @@ TSnippetValidator = class(TNoConstructObject) cAllSnippetKinds: TSnippetKinds = // Set of all possible snippet kinds [skFreeform, skRoutine, skConstant, skTypeDef, skUnit, skClass]; public + + /// Validate a snippet display name. + /// string [in] Display name to be + /// checked. + /// string [out] Message that describes + /// error. Undefined if True returned. + /// Boolean. True if source code is valid or + /// False if not. + class function ValidateDisplayName(const DisplayName: string; + out ErrorMsg: string): Boolean; + class function ValidateDependsList(const Snippet: TSnippet; out ErrorMsg: string): Boolean; overload; {Recursively checks dependency list of a snippet for validity. @@ -332,6 +343,19 @@ class function TSnippetValidator.ValidateDescription(const Desc: string; Result := True; end; +class function TSnippetValidator.ValidateDisplayName(const DisplayName: string; + out ErrorMsg: string): Boolean; +var + TrimmedDisplayName: string; +resourcestring + sErrEmpty = 'A display name must be provided'; +begin + TrimmedDisplayName := StrTrim(DisplayName); + Result := TrimmedDisplayName <> ''; + if not Result then + ErrorMsg := sErrEmpty; +end; + class function TSnippetValidator.ValidateExtra(const Extra: IActiveText; out ErrorMsg: string): Boolean; {Validates a extra information from a snippet. From 3a978b034aadc97a050e70b4b7a142f8488522c0 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 7 Nov 2024 19:50:49 +0000 Subject: [PATCH 050/222] Remove editing of snippet key from Snippets Editor Removed the ability for the user to specify the snippet key (formerly the snippet name) in the Snippets Editor dialogue box. When creating new snippets, the new snippet key is now automatically generated and is certain to be unique within the snippet's collection. When editing existing snippets the original snippet ID is preserved. It is now compulsory to enter a display name, for two reasons: 1. because the key that is used for the display name by default is now a pseudo random sequence of characters & makes no sense as a name. 2. because the key can no longer be edited. Hard wired the "user" snippets collection for new snippets. Later this should be chosen by the user. Existing snippets being edited can't be moved from their original collection. Put snippet display name in dialogue box caption in double quotes. --- Src/FmSnippetsEditorDlg.dfm | 30 +++-------- Src/FmSnippetsEditorDlg.pas | 99 +++++++++++++++++++++---------------- 2 files changed, 64 insertions(+), 65 deletions(-) diff --git a/Src/FmSnippetsEditorDlg.dfm b/Src/FmSnippetsEditorDlg.dfm index 365274c63..bbb544308 100644 --- a/Src/FmSnippetsEditorDlg.dfm +++ b/Src/FmSnippetsEditorDlg.dfm @@ -42,14 +42,6 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Caption = '&Source code:' FocusControl = edSourceCode end - object lblName: TLabel - Left = 3 - Top = 11 - Width = 31 - Height = 13 - Caption = '&Name:' - FocusControl = edName - end object lblCategories: TLabel Left = 0 Top = 183 @@ -111,15 +103,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg ParentFont = False PopupMenu = mnuEditCtrls ScrollBars = ssBoth - TabOrder = 6 - end - object edName: TEdit - Left = 93 - Top = 7 - Width = 209 - Height = 21 - PopupMenu = mnuEditCtrls - TabOrder = 0 + TabOrder = 5 end object cbCategories: TComboBox Left = 93 @@ -127,7 +111,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Width = 209 Height = 21 Style = csDropDownList - TabOrder = 5 + TabOrder = 4 end object cbKind: TComboBox Left = 93 @@ -135,7 +119,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Width = 209 Height = 21 Style = csDropDownList - TabOrder = 4 + TabOrder = 3 OnChange = cbKindChange end inline frmDescription: TSnippetsActiveTextEdFrame @@ -146,7 +130,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Color = clWindow ParentBackground = False ParentColor = False - TabOrder = 2 + TabOrder = 1 ExplicitLeft = 93 ExplicitTop = 67 ExplicitWidth = 462 @@ -171,7 +155,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Height = 25 Action = actViewDescription Caption = 'Previe&w...' - TabOrder = 3 + TabOrder = 2 end object edDisplayName: TEdit Left = 93 @@ -179,7 +163,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Width = 298 Height = 21 PopupMenu = mnuEditCtrls - TabOrder = 1 + TabOrder = 0 end object chkUseHiliter: TCheckBox Left = 3 @@ -187,7 +171,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Width = 478 Height = 17 Caption = 'Synta&x highlight this snippet as Pascal code' - TabOrder = 7 + TabOrder = 6 end end object tsReferences: TTabSheet diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index be21eced6..4b3f8ec64 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -21,7 +21,8 @@ interface SysUtils, Classes, ActnList, Buttons, StdCtrls, Forms, Controls, CheckLst, ComCtrls, ExtCtrls, StdActns, Menus, ImgList, // Project - ActiveText.UMain, Compilers.UGlobals, DB.USnippet, FmGenericOKDlg, + ActiveText.UMain, Compilers.UGlobals, + DB.UCollections, DB.USnippet, FmGenericOKDlg, FrBrowserBase, FrFixedHTMLDlg, FrHTMLDlg, UBaseObjects, UCategoryListAdapter, UCompileMgr, UCompileResultsLBMgr, UCSSBuilder, UMemoCaretPosDisplayMgr, UMemoHelper, USnipKindListAdapter, USnippetsChkListMgr, UUnitsChkListMgr, @@ -61,7 +62,6 @@ TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) clbDepends: TCheckListBox; clbUnits: TCheckListBox; clbXRefs: TCheckListBox; - edName: TEdit; edSourceCode: TMemo; edUnit: TEdit; lbCompilers: TListBox; @@ -73,7 +73,6 @@ TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) lblDescription: TLabel; lblExtra: TLabel; lblExtraCaretPos: TLabel; - lblName: TLabel; lblKind: TLabel; lblSourceCaretPos: TLabel; lblSourceCode: TLabel; @@ -160,7 +159,6 @@ TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) fCatList: TCategoryListAdapter; // Accesses sorted list of categories fSnipKindList: TSnipKindListAdapter; // Accesses sorted list of snippet kinds - fOrigName: string; // Original name of snippet ('' for new) fEditData: TSnippetEditData; // Record storing a snippet's editable data fCompileMgr: TCompileMgr; // Manages compilation and results display fDependsCLBMgr: @@ -173,6 +171,24 @@ TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) fSourceMemoHelper: TMemoHelper; // Helper for working with source code memo fMemoCaretPosDisplayMgr: TMemoCaretPosDisplayMgr; // Manages display of memo caret positions + + /// Returns the ID of the collection that applies to a new or + /// existing snippet. + /// TCollectionID. The required collection ID. + /// For a new snippet the return value is the collection to be + /// applied to the snippet. For an existing snippet this is collection to + /// which the snippet already belongs. + function SelectedCollectionID: TCollectionID; + + /// Returns a snippet key that is unique with the current + /// snippet collection. + /// string. The required key. + /// For a new snippet this key will change depending each time the + /// method is called, and will always be unique within the selected + /// collection. For an existing snippet the key is always that of the + /// snippet and never changes across method calls. + function UniqueSnippetKey: string; + procedure PopulateControls; {Populates controls with dynamic data. } @@ -254,7 +270,6 @@ implementation // Delphi Windows {for inlining}, Graphics, // Project - DB.UCollections, DB.UMain, DB.USnippetKind, FmDependenciesDlg, IntfCommon, UColours, UConsts, UCSSUtils, UCtrlArranger, UExceptions, UFontHelper, UIStringList, UReservedCategories, USnippetExtraHelper, USnippetValidator, UMessageBox, @@ -425,7 +440,7 @@ procedure TSnippetsEditorDlg.actViewDependenciesExecute(Sender: TObject); fDependsCLBMgr.GetCheckedSnippets(DependsList); TDependenciesDlg.Execute( Self, - TSnippetID.Create(StrTrim(edName.Text), TCollectionID.__TMP__UserDBCollectionID), + TSnippetID.Create(UniqueSnippetKey, TCollectionID.__TMP__UserDBCollectionID), StrTrim(edDisplayName.Text), DependsList, [tiDependsUpon], @@ -555,7 +570,7 @@ procedure TSnippetsEditorDlg.ArrangeForm; edSourceCode.Width := tsCode.ClientWidth - 8; TCtrlArranger.AlignLefts( [ - lblName, lblDisplayName, lblDescription, lblKind, lblCategories, + lblDisplayName, lblDescription, lblKind, lblCategories, lblSourceCode, edSourceCode ], 3 @@ -564,10 +579,7 @@ procedure TSnippetsEditorDlg.ArrangeForm; [edSourceCode, lblSourceCaretPos, btnViewDescription] ); frmDescription.Width := btnViewDescription.Left - frmDescription.Left - 8; - TCtrlArranger.AlignVCentres(3, [lblName, edName]); - TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf([lblName, edName], 8), - [lblDisplayName, edDisplayName] + TCtrlArranger.AlignVCentres(3, [lblDisplayName, edDisplayName] ); TCtrlArranger.AlignTops( [lblDescription, frmDescription, btnViewDescription], @@ -622,24 +634,21 @@ procedure TSnippetsEditorDlg.btnOKClick(Sender: TObject); snippet if all is well. @param Sender [in] Not used. } -var - SnippetName: string; // name of snippet being edited / added begin inherited; try // Validate and record entered data ValidateData; fEditData.Assign(UpdateData); - SnippetName := StrTrim(edName.Text); // Add or update snippet if Assigned(fSnippet) then - fSnippet := (Database as IDatabaseEdit).UpdateSnippet( - fSnippet, fEditData, SnippetName + (Database as IDatabaseEdit).UpdateSnippet( + fSnippet, fEditData, UniqueSnippetKey ) else begin - fSnippet := (Database as IDatabaseEdit).AddSnippet( - SnippetName, fEditData + (Database as IDatabaseEdit).AddSnippet( + UniqueSnippetKey, fEditData ) end; except @@ -685,7 +694,7 @@ function TSnippetsEditorDlg.CreateTempSnippet: TSnippet; // Create snippet object from entered data EditData.Assign(UpdateData); Result := (Database as IDatabaseEdit).CreateTempSnippet( - StrTrim(edName.Text), EditData + UniqueSnippetKey, EditData ); end; @@ -718,6 +727,7 @@ class function TSnippetsEditorDlg.EditSnippet(AOwner: TComponent; resourcestring sCaption = 'Edit Snippet'; // dialogue box caption begin + Assert(Assigned(Snippet), ClassName + '.EditSnippet: Snippet is nil'); Instance := InternalCreate(AOwner); try Instance.Caption := sCaption; @@ -822,11 +832,7 @@ procedure TSnippetsEditorDlg.InitControls; chkUseHiliter.Checked := fSnippet.HiliteSource; frmDescription.DefaultEditMode := emAuto; frmDescription.ActiveText := fSnippet.Description; - edName.Text := fSnippet.Key; - if fSnippet.Key <> fSnippet.DisplayName then - edDisplayName.Text := fSnippet.DisplayName - else - edDisplayName.Text := ''; + edDisplayName.Text := fSnippet.DisplayName; cbCategories.ItemIndex := fCatList.IndexOf(fSnippet.Category); frmExtra.DefaultEditMode := emAuto; frmExtra.ActiveText := fSnippet.Extra; @@ -845,7 +851,6 @@ procedure TSnippetsEditorDlg.InitControls; chkUseHiliter.Checked := True; frmDescription.DefaultEditMode := emPlainText; frmDescription.Clear; - edName.Clear; edDisplayName.Clear; cbCategories.ItemIndex := fCatList.IndexOf(TReservedCategories.UserCatID); if cbCategories.ItemIndex = -1 then @@ -874,11 +879,6 @@ procedure TSnippetsEditorDlg.InitForm; // Get data associated with snippet, or blank / default data if adding a new // snippet fEditData := (Database as IDatabaseEdit).GetEditableSnippetInfo(fSnippet); - // Record snippet's original name, if any - if Assigned(fSnippet) then - fOrigName := fSnippet.Key - else - fOrigName := ''; // Populate controls with dynamic data PopulateControls; // Initialise controls to default values @@ -934,6 +934,17 @@ procedure TSnippetsEditorDlg.PopulateControls; fCatList.ToStrings(cbCategories.Items); end; +function TSnippetsEditorDlg.SelectedCollectionID: TCollectionID; +begin + if Assigned(fSnippet) then + Result := fSnippet.CollectionID + else + {TODO -cCollections: Replace the following __TMP__ method with collection ID + selected by user from a combo box. DO NOT permit this choice when + editing an existing snippet.} + Result := TCollectionID.__TMP__UserDBCollectionID; +end; + procedure TSnippetsEditorDlg.SetAllCompilerResults( const CompRes: TCompileResult); {Sets all compiler results to same value. @@ -943,16 +954,23 @@ procedure TSnippetsEditorDlg.SetAllCompilerResults( fCompilersLBMgr.SetCompileResults(CompRes); end; +function TSnippetsEditorDlg.UniqueSnippetKey: string; +begin + if Assigned(fSnippet) then + Result := fSnippet.Key + else + Result := (Database as IDatabaseEdit).GetUniqueSnippetKey( + SelectedCollectionID + ); +end; + function TSnippetsEditorDlg.UpdateData: TSnippetEditData; {Updates snippet's data from user entries. Assumes data has been validated. @return Record containing snippet's data. } begin Result.Init; - if StrTrim(edName.Text) <> StrTrim(edDisplayName.Text) then - Result.Props.DisplayName := StrTrim(edDisplayName.Text) - else - Result.Props.DisplayName := ''; + Result.Props.DisplayName := StrTrim(edDisplayName.Text); Result.Props.Cat := fCatList.CatID(cbCategories.ItemIndex); Result.Props.Kind := fSnipKindList.SnippetKind(cbKind.ItemIndex); (Result.Props.Desc as IAssignable).Assign(frmDescription.ActiveText); @@ -980,7 +998,7 @@ procedure TSnippetsEditorDlg.UpdateReferences; fXRefsCLBMgr.Save; fXRefsCLBMgr.Clear; - EditSnippetID := TSnippetID.Create(fOrigName, TCollectionID.__TMP__UserDBCollectionID); + EditSnippetID := TSnippetID.Create(UniqueSnippetKey, SelectedCollectionID); EditSnippetKind := fSnipKindList.SnippetKind(cbKind.ItemIndex); for Snippet in Database.Snippets do begin @@ -1019,13 +1037,10 @@ procedure TSnippetsEditorDlg.ValidateData; ErrorMessage: string; // receives validation error messages ErrorSelection: TSelection; // receives selection containing errors begin - if not TSnippetValidator.ValidateName( - edName.Text, - not StrSameText(StrTrim(edName.Text), fOrigName), - ErrorMessage, - ErrorSelection + if not TSnippetValidator.ValidateDisplayName( + edDisplayName.Text, ErrorMessage ) then - raise EDataEntry.Create(ErrorMessage, edName, ErrorSelection); + raise EDataEntry.Create(ErrorMessage, edDisplayName); frmDescription.Validate; if not TSnippetValidator.ValidateSourceCode( edSourceCode.Text, ErrorMessage, ErrorSelection @@ -1033,7 +1048,7 @@ procedure TSnippetsEditorDlg.ValidateData; raise EDataEntry.Create(ErrorMessage, edSourceCode, ErrorSelection); frmExtra.Validate; if not TSnippetValidator.ValidateDependsList( - StrTrim(edName.Text), UpdateData, ErrorMessage + UniqueSnippetKey, UpdateData, ErrorMessage ) then raise EDataEntry.Create( // selection not applicable to list boxes StrMakeSentence(ErrorMessage) + EOL2 + sDependencyPrompt, clbDepends From 93169ceed93d4843c09754887d3192221381146d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 8 Nov 2024 09:55:18 +0000 Subject: [PATCH 051/222] Rename "Name" to "Key" in snippet import units Updated UCodeImportMgr & UCodeImportExport units to refer to snippet keys by the correct terminology in fields, parameters and method names. Updated all other units affected by this refactoring. --- Src/FmCodeImportDlg.dfm | 16 +++++++++++ Src/FmCodeImportDlg.pas | 8 +++--- Src/UCodeImportExport.pas | 10 +++---- Src/UCodeImportMgr.pas | 58 +++++++++++++++++++-------------------- 4 files changed, 54 insertions(+), 38 deletions(-) diff --git a/Src/FmCodeImportDlg.dfm b/Src/FmCodeImportDlg.dfm index f3cc01a43..6b516057b 100644 --- a/Src/FmCodeImportDlg.dfm +++ b/Src/FmCodeImportDlg.dfm @@ -14,6 +14,10 @@ inherited CodeImportDlg: TCodeImportDlg object tsInfo: TTabSheet Caption = 'tsInfo' TabVisible = False + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblIntro: TLabel Left = 0 Top = 8 @@ -30,6 +34,10 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'tsFile' ImageIndex = 1 TabVisible = False + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblFile: TLabel Left = 0 Top = 8 @@ -71,6 +79,10 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'tsUpdate' ImageIndex = 3 TabVisible = False + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblImportList: TLabel Left = 0 Top = 53 @@ -149,6 +161,10 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'tsFinish' ImageIndex = 5 TabVisible = False + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblFinish: TLabel Left = 0 Top = 8 diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index 7315b29e8..7dfb4956e 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -346,8 +346,8 @@ procedure TCodeImportDlg.InitImportInfo; LI := lvImports.Items.Add; LI.SubItems.Add(''); LI.SubItems.Add(''); - LI.Caption := Info.OrigName; - SetImportNameInLV(LI, Info.ImportAsName); + LI.Caption := Info.OrigKey; + SetImportNameInLV(LI, Info.ImportAsKey); LI.Checked := not Info.Skip; UpdateActionDisplay(LI); end; @@ -440,7 +440,7 @@ procedure TCodeImportDlg.PresentResults; begin if DataItem.Skip then Continue; - AddLabel(LblTop, DataItem.ImportAsName); + AddLabel(LblTop, DataItem.ImportAsKey); end; end; @@ -511,7 +511,7 @@ procedure TCodeImportDlg.UpdateImportData(const Item: TListItem); begin if not Assigned(Item) then Exit; - Idx := fImportMgr.ImportInfo.IndexOfName(Item.Caption); + Idx := fImportMgr.ImportInfo.IndexOfKey(Item.Caption); if Idx = -1 then raise EBug.Create( ClassName + '.UpdateImportData: Can''t find import data item.' diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index 600e47990..902edc10b 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -34,8 +34,8 @@ interface /// Encapsulates data that describes a snippet that has been read /// from an import file. TSnippetInfo = record - /// Snippet name. - Name: string; + /// Snippet key. + Key: string; /// Description of snippet. Data: TSnippetEditData; /// Copies given TSnippetInfo record to this one. @@ -419,7 +419,7 @@ procedure TCodeImporter.Execute(const Data: TBytes); begin // Read a snippet node SnippetNode := SnippetNodes[Idx]; - fSnippetInfo[Idx].Name := SnippetNode.Attributes[cSnippetNameAttr]; + fSnippetInfo[Idx].Key := SnippetNode.Attributes[cSnippetNameAttr]; fSnippetInfo[Idx].Data := (Database as IDatabaseEdit).GetEditableSnippetInfo; fSnippetInfo[Idx].Data.Props.Cat := TReservedCategories.ImportsCatID; @@ -545,13 +545,13 @@ function TCodeImporter.ValidateDoc: Integer; procedure TSnippetInfo.Assign(const Src: TSnippetInfo); begin - Name := Src.Name; + Key := Src.Key; Data.Assign(Src.Data); end; procedure TSnippetInfo.Init; begin - Name := ''; + Key := ''; Data.Init; end; diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index f2ae236d2..2410bfc27 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -30,18 +30,18 @@ interface TImportInfo = record strict private // Property values - fOrigName: string; - fImportAsName: string; + fOrigKey: string; + fImportAsKey: string; fSkip: Boolean; public /// Initialises properties to given values. - constructor Create(const AOrigName, AImportAsName: string; + constructor Create(const AOrigKey, AImportAsKey: string; const ASkip: Boolean = False); - /// Name of snippet per import file. - property OrigName: string read fOrigName; - /// Name of snippet to be used when updating database. + /// Snippet key per import file. + property OrigKey: string read fOrigKey; + /// Key of snippet to be used when updating database. /// Can be changed by user. - property ImportAsName: string read fImportAsName write fImportAsName; + property ImportAsKey: string read fImportAsKey write fImportAsKey; /// Flag indicating if snippet is to be skipped (ignored) when /// updating database. property Skip: Boolean read fSkip write fSkip; @@ -68,16 +68,16 @@ TImportInfoList = class(TList) public /// Constructs list with appropriate comparer. constructor Create; - /// Finds a record based on its OrigName field value. - /// string [in] Name to be found. + /// Finds a record based on its OrigKey field value. + /// string [in] Key to be found. /// TImportInfo [out] Found record. Undefined if /// Name not found. - /// Boolean: True if Name found, False if not. - function FindByName(const Name: string; out ImportInfo: TImportInfo): + /// Boolean: True if Key found, False if not. + function FindByKey(const Key: string; out ImportInfo: TImportInfo): Boolean; - /// Returns index of record in list whose OrigName field matches + /// Returns index of record in list whose OrigKey field matches /// given name or -1 if name not found. - function IndexOfName(const Name: string): Integer; + function IndexOfKey(const Key: string): Integer; end; type @@ -188,8 +188,8 @@ function TCodeImportMgr.DisallowedNames(const ExcludedName: string): if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then Result.Add(Snippet.Key); for SnippetInfo in fSnippetInfoList do - if not StrSameText(SnippetInfo.Name, ExcludedName) then - Result.Add(SnippetInfo.Name); + if not StrSameText(SnippetInfo.Key, ExcludedName) then + Result.Add(SnippetInfo.Key); end; function TCodeImportMgr.GetUniqueSnippetName( @@ -234,7 +234,7 @@ procedure TCodeImportMgr.InitImportInfoList; begin fImportInfoList.Add( TImportInfo.Create( - SnippetInfo.Name, GetUniqueSnippetName(SnippetInfo.Name) + SnippetInfo.Key, GetUniqueSnippetName(SnippetInfo.Key) ) ); end; @@ -271,36 +271,36 @@ procedure TCodeImportMgr.UpdateDatabase; ImportInfo: TImportInfo; // info about how / whether to import a snippet resourcestring // Error message - sBadNameError = 'Can''t find snippet "%s" in import data'; + sBadNameError = 'Can''t find snippet with key "%s" in import data'; begin Editor := Database as IDatabaseEdit; for SnippetInfo in fSnippetInfoList do begin - if not fImportInfoList.FindByName(SnippetInfo.Name, ImportInfo) then - raise EBug.CreateFmt(sBadNameError, [SnippetInfo.Name]); + if not fImportInfoList.FindByKey(SnippetInfo.Key, ImportInfo) then + raise EBug.CreateFmt(sBadNameError, [SnippetInfo.Key]); if ImportInfo.Skip then Continue; AdjustDependsList(SnippetInfo.Data.Refs.Depends); - Snippet := Database.Snippets.Find(ImportInfo.ImportAsName, TCollectionID.__TMP__UserDBCollectionID); + Snippet := Database.Snippets.Find(ImportInfo.ImportAsKey, TCollectionID.__TMP__UserDBCollectionID); if Assigned(Snippet) then // snippet already exists: overwrite it Editor.UpdateSnippet(Snippet, SnippetInfo.Data) else // snippet is new: add to database - Editor.AddSnippet(ImportInfo.ImportAsName, SnippetInfo.Data); + Editor.AddSnippet(ImportInfo.ImportAsKey, SnippetInfo.Data); end; end; { TImportInfo } -constructor TImportInfo.Create(const AOrigName, AImportAsName: string; +constructor TImportInfo.Create(const AOrigKey, AImportAsKey: string; const ASkip: Boolean); begin - fOrigName := AOrigName; - fImportAsName := AImportAsName; + fOrigKey := AOrigKey; + fImportAsKey := AImportAsKey; fSkip := ASkip; end; @@ -308,7 +308,7 @@ constructor TImportInfo.Create(const AOrigName, AImportAsName: string; function TImportInfoComparer.Compare(const Left, Right: TImportInfo): Integer; begin - Result := TSnippetID.CompareKeys(Left.OrigName, Right.OrigName); + Result := TSnippetID.CompareKeys(Left.OrigKey, Right.OrigKey); end; { TImportInfoList } @@ -318,21 +318,21 @@ constructor TImportInfoList.Create; inherited Create(TImportInfoComparer.Create); end; -function TImportInfoList.FindByName(const Name: string; +function TImportInfoList.FindByKey(const Key: string; out ImportInfo: TImportInfo): Boolean; var Idx: Integer; // index of named snippet in list begin - Idx := IndexOf(TImportInfo.Create(Name, '')); + Idx := IndexOf(TImportInfo.Create(Key, '')); if Idx = -1 then Exit(False); ImportInfo := Items[Idx]; Result := True; end; -function TImportInfoList.IndexOfName(const Name: string): Integer; +function TImportInfoList.IndexOfKey(const Key: string): Integer; begin - Result := IndexOf(TImportInfo.Create(Name, '')); + Result := IndexOf(TImportInfo.Create(Key, '')); end; end. From 3e2c492c49667bba1bfe3559c8e046fd0be96770 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 8 Nov 2024 15:58:42 +0000 Subject: [PATCH 052/222] Prevent editing of snippet keys in snippet imports Revised tsUpdate page of snippet import wizard in FmCodeImportDlg.dfm / .pas: * Removed edit box and related button, action and label where snippet keys were renamed. * Changed list view to display snippet's display name instead of key and removed column that displayed optionally renamed keys. Overhauled supporting code in FmCodeImportDlg.pas: * Removed code that supported editing snippet keys * Added placeholder code for getting collection into which imported snippets are to be added. Changed UCodeImportExport unit to ensure display name snippet property is always set. Updated UCodeImportMgr: * Removed support for changing snippet IDs * Removed support for updating existing snippets with data from imported snippet when both snippets have the same ID. * Added a callback to permit user to specify the collection into which the imported snippets will be added. * Replaced custom code for finding a unique snippet ID with a call to IDatabaseEdit.GetUniqueSnippetKey. --- Src/FmCodeImportDlg.dfm | 60 ++------------- Src/FmCodeImportDlg.pas | 151 ++++++++++---------------------------- Src/UCodeImportExport.pas | 2 + Src/UCodeImportMgr.pas | 139 ++++++++++++++++++----------------- 4 files changed, 117 insertions(+), 235 deletions(-) diff --git a/Src/FmCodeImportDlg.dfm b/Src/FmCodeImportDlg.dfm index 6b516057b..5182ac866 100644 --- a/Src/FmCodeImportDlg.dfm +++ b/Src/FmCodeImportDlg.dfm @@ -14,10 +14,6 @@ inherited CodeImportDlg: TCodeImportDlg object tsInfo: TTabSheet Caption = 'tsInfo' TabVisible = False - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblIntro: TLabel Left = 0 Top = 8 @@ -34,10 +30,6 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'tsFile' ImageIndex = 1 TabVisible = False - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblFile: TLabel Left = 0 Top = 8 @@ -79,10 +71,6 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'tsUpdate' ImageIndex = 3 TabVisible = False - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblImportList: TLabel Left = 0 Top = 53 @@ -91,14 +79,6 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'Imported &snippets:' FocusControl = lvImports end - object lblSelectedSnippet: TLabel - Left = 0 - Top = 217 - Width = 83 - Height = 13 - Caption = 'S&elected snippet:' - FocusControl = edRename - end object lblModifyInstructions: TLabel Left = 0 Top = 8 @@ -106,9 +86,10 @@ inherited CodeImportDlg: TCodeImportDlg Height = 40 AutoSize = False Caption = - 'The functions to be imported are listed below. Select, deselect ' + - 'and rename as required then click the "Update" button to update ' + - 'the database. Use "Cancel" to abandon the import.' + 'The functions to be imported are listed below. Clear the check b' + + 'oxes next to any snippets you don'#39't want to import then click th' + + 'e "Update" button to update the database. Use "Cancel" to abando' + + 'n the import.' WordWrap = True end object lvImports: TListView @@ -119,12 +100,8 @@ inherited CodeImportDlg: TCodeImportDlg Checkboxes = True Columns = < item - Caption = 'Snippet Name' - Width = 140 - end - item - Caption = 'Import Using Name' - Width = 140 + Caption = 'Snippet' + Width = 280 end item Caption = 'Action' @@ -138,33 +115,13 @@ inherited CodeImportDlg: TCodeImportDlg SortType = stText TabOrder = 0 ViewStyle = vsReport - OnSelectItem = lvImportsSelectItem OnItemChecked = lvImportsItemChecked end - object btnRename: TButton - Left = 161 - Top = 236 - Width = 75 - Height = 25 - Action = actRename - TabOrder = 1 - end - object edRename: TEdit - Left = 0 - Top = 238 - Width = 155 - Height = 21 - TabOrder = 2 - end end object tsFinish: TTabSheet Caption = 'tsFinish' ImageIndex = 5 TabVisible = False - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblFinish: TLabel Left = 0 Top = 8 @@ -190,11 +147,6 @@ inherited CodeImportDlg: TCodeImportDlg object alMain: TActionList Left = 448 Top = 208 - object actRename: TAction - Caption = '&Rename...' - OnExecute = actRenameExecute - OnUpdate = actRenameUpdate - end object actBrowse: TAction Caption = '...' Hint = 'Browse for import file' diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index 7dfb4956e..4bdd74688 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -25,6 +25,7 @@ interface ExtCtrls, Forms, // Project + DB.UCollections, FmWizardDlg, UBaseObjects, UCodeImportMgr; @@ -47,38 +48,32 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) lvImports: TListView; lblImportList: TLabel; lblLoadFile: TLabel; - btnRename: TButton; - edRename: TEdit; - lblSelectedSnippet: TLabel; alMain: TActionList; - actRename: TAction; actBrowse: TAction; lblModifyInstructions: TLabel; lblFinish: TLabel; sbFinish: TScrollBox; /// Handles clicks on list view check boxes. procedure lvImportsItemChecked(Sender: TObject; Item: TListItem); - /// Handles selection changes events in list view. - procedure lvImportsSelectItem(Sender: TObject; Item: TListItem; - Selected: Boolean); - /// Updates enabled state of rename action and associated - /// controls. - procedure actRenameUpdate(Sender: TObject); - /// Handles event that requests renaming of a snippet. - procedure actRenameExecute(Sender: TObject); /// Handles request to display open file dialog box to get import /// file name. procedure actBrowseExecute(Sender: TObject); + /// Frees objects stored in list view items' Data properties. + /// + procedure FormDestroy(Sender: TObject); strict private const + {TODO -cCollections: Insert a new page to get collection to receive + imports from user after cFilePage and before cUpdatePage. That way + we can be sure that the collection won't change after selecting + snippets.} // Indices of wizard pages cIntroPage = 0; cFilePage = 1; cUpdatePage = 2; cFinishPage = 3; // Index of subitems in list view - cLVActionIdx = 1; - cLVImportName = 0; + cLVActionIdx = 0; var /// Reference to import manager object used to perform import /// operations. @@ -86,11 +81,6 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) /// Validates entries on wizard pages indetified by the page /// index. procedure ValidatePage(const PageIdx: Integer); - /// Checks validity of a given snippet name that is to be used - /// to replace the name in a given list item. Passes any error message - /// back via parameter list. - function ValidateSnippetName(const Name: string; const Item: TListItem; - out ErrMsg: string): Boolean; /// Reads input file from disk. procedure ReadImportFile; /// Retrieves import file name from edit control where it is @@ -106,12 +96,6 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) /// Counts snippets that will be / have been added to database. /// Excludes any snippets skipped by user. function CountImportSnippets: Integer; - /// Retrieves the name that will be used to add an imported - /// snippet to the database from the given list item. - function GetImportAsNameFromLV(const Item: TListItem): string; - /// Updates given list item with new imported snippet name. - /// - procedure SetImportNameInLV(const Item: TListItem; const Value: string); /// Updates given list item with description of current import /// action for the associated snippet. procedure SetActionInLV(const Item: TListItem; const Value: string); @@ -126,6 +110,9 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) procedure UpdateDatabase; /// Displays names of imported snippets on finish page. procedure PresentResults; + /// Gets the ID of the collection into which all snippets are to + /// be imported. + function GetCollectionID: TCollectionID; strict protected /// Protected constructor that sets up object to use given import /// manager object. @@ -168,6 +155,7 @@ implementation SysUtils, Dialogs, // Project + UBox, UCtrlArranger, UExceptions, UMessageBox, @@ -187,7 +175,7 @@ procedure TCodeImportDlg.actBrowseExecute(Sender: TObject); resourcestring sFilter = 'CodeSnip export files (*.csexp)|*.csexp|' // file filter + 'All files (*.*)|*.*'; - sTitle = 'Import File'; // dialog box title + sTitle = 'Import File'; // dialogue box title begin OpenDlg := TOpenDialogEx.Create(nil); try @@ -208,23 +196,6 @@ procedure TCodeImportDlg.actBrowseExecute(Sender: TObject); end; end; -procedure TCodeImportDlg.actRenameExecute(Sender: TObject); -var - ErrMsg: string; // any error message returned from snippets validator -begin - if not ValidateSnippetName(edRename.Text, lvImports.Selected, ErrMsg) then - raise EDataEntry.Create(ErrMsg, edRename); - SetImportNameInLV(lvImports.Selected, edRename.Text); - lvImports.Selected.MakeVisible(False); - UpdateImportData(lvImports.Selected); -end; - -procedure TCodeImportDlg.actRenameUpdate(Sender: TObject); -begin - actRename.Enabled := Assigned(lvImports.Selected); - edRename.Enabled := Assigned(lvImports.Selected); -end; - procedure TCodeImportDlg.ArrangeForm; begin TCtrlArranger.SetLabelHeights(Self); @@ -243,10 +214,6 @@ procedure TCodeImportDlg.ArrangeForm; // tsUpdate lblImportList.Top := TCtrlArranger.BottomOf(lblModifyInstructions, 8); lvImports.Top := TCtrlArranger.BottomOf(lblImportList, 6); - lblSelectedSnippet.Top := TCtrlArranger.BottomOf(lvImports, 8); - TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf(lblSelectedSnippet, 6), [edRename, btnRename] - ); // tsFinish sbFinish.Top := TCtrlArranger.BottomOf(lblFinish, 6); @@ -307,16 +274,28 @@ class function TCodeImportDlg.Execute(AOwner: TComponent; end; end; -function TCodeImportDlg.GetFileNameFromEditCtrl: string; +procedure TCodeImportDlg.FormDestroy(Sender: TObject); +var + Idx: Integer; begin - Result := StrTrim(edFile.Text); + inherited; + // Free the TBox<> objects stored in list item data pointer + for Idx := Pred(lvImports.Items.Count) downto 0 do + TObject(lvImports.Items[Idx].Data).Free; +end; + +function TCodeImportDlg.GetCollectionID: TCollectionID; +begin + {TODO -cCollections: Add code to get user's choice of collection into which + snippets are to be imported. Will need a drop down list of available + collections. At present, only the "user" collection is permitted. + } + Result := TCollectionID.__TMP__UserDBCollectionID; end; -function TCodeImportDlg.GetImportAsNameFromLV(const Item: TListItem): string; +function TCodeImportDlg.GetFileNameFromEditCtrl: string; begin - if Item.SubItems.Count <= cLVImportName then - Exit(''); - Result := Item.SubItems[cLVImportName]; + Result := StrTrim(edFile.Text); end; function TCodeImportDlg.HeadingText(const PageIdx: Integer): string; @@ -337,7 +316,6 @@ function TCodeImportDlg.HeadingText(const PageIdx: Integer): string; procedure TCodeImportDlg.InitImportInfo; - // --------------------------------------------------------------------------- /// Creates a new list view items containing given information. procedure AddListItem(const Info: TImportInfo); var @@ -345,13 +323,11 @@ procedure TCodeImportDlg.InitImportInfo; begin LI := lvImports.Items.Add; LI.SubItems.Add(''); - LI.SubItems.Add(''); - LI.Caption := Info.OrigKey; - SetImportNameInLV(LI, Info.ImportAsKey); + LI.Caption := Info.DisplayName; LI.Checked := not Info.Skip; + LI.Data := TBox.Create(Info); UpdateActionDisplay(LI); end; - // --------------------------------------------------------------------------- var InfoItem: TImportInfo; // import info item describing an imported snippet @@ -375,6 +351,7 @@ constructor TCodeImportDlg.InternalCreate(AOwner: TComponent; begin inherited InternalCreate(AOwner); fImportMgr := ImportMgr; + fImportMgr.RequestCollectionCallback := GetCollectionID; end; procedure TCodeImportDlg.lvImportsItemChecked(Sender: TObject; Item: TListItem); @@ -383,13 +360,6 @@ procedure TCodeImportDlg.lvImportsItemChecked(Sender: TObject; Item: TListItem); UpdateImportData(Item); end; -procedure TCodeImportDlg.lvImportsSelectItem(Sender: TObject; Item: TListItem; - Selected: Boolean); -begin - if Assigned(Item) then - edRename.Text := GetImportAsNameFromLV(Item); -end; - procedure TCodeImportDlg.MoveForward(const PageIdx: Integer; var CanMove: Boolean); begin @@ -415,7 +385,6 @@ procedure TCodeImportDlg.MoveForward(const PageIdx: Integer; procedure TCodeImportDlg.PresentResults; - // --------------------------------------------------------------------------- /// Creates a label containing name of an imported snippet and adds it to /// scroll box with top at given position. procedure AddLabel(var Top: Integer; const SnippetName: string); @@ -429,7 +398,6 @@ procedure TCodeImportDlg.PresentResults; Lbl.Caption := '� ' + SnippetName; Top := TCtrlArranger.BottomOf(Lbl, 2); end; - // --------------------------------------------------------------------------- var DataItem: TImportInfo; // description of each snippet from import file @@ -440,7 +408,7 @@ procedure TCodeImportDlg.PresentResults; begin if DataItem.Skip then Continue; - AddLabel(LblTop, DataItem.ImportAsKey); + AddLabel(LblTop, DataItem.DisplayName); end; end; @@ -457,14 +425,6 @@ procedure TCodeImportDlg.SetActionInLV(const Item: TListItem; Item.SubItems[cLVActionIdx] := Value; end; -procedure TCodeImportDlg.SetImportNameInLV(const Item: TListItem; - const Value: string); -begin - if Item.SubItems.Count <= cLVImportName then - Exit; - Item.SubItems[cLVImportName] := Value; -end; - procedure TCodeImportDlg.UpdateActionDisplay(const Item: TListItem); resourcestring // description of actions @@ -505,21 +465,13 @@ procedure TCodeImportDlg.UpdateDatabase; end; procedure TCodeImportDlg.UpdateImportData(const Item: TListItem); -var - DataItem: TImportInfo; // description of each snippet from import file - Idx: Integer; // index of selected snippet name in import info list begin if not Assigned(Item) then Exit; - Idx := fImportMgr.ImportInfo.IndexOfKey(Item.Caption); - if Idx = -1 then - raise EBug.Create( - ClassName + '.UpdateImportData: Can''t find import data item.' - ); - DataItem := TImportInfo.Create( - Item.Caption, GetImportAsNameFromLV(Item), not Item.Checked + fImportMgr.ImportInfo.SetSkip( + TBox(Item.Data).Value.OrigKey, + not Item.Checked ); - fImportMgr.ImportInfo.Items[Idx] := DataItem; end; procedure TCodeImportDlg.ValidatePage(const PageIdx: Integer); @@ -548,29 +500,4 @@ procedure TCodeImportDlg.ValidatePage(const PageIdx: Integer); end; end; -function TCodeImportDlg.ValidateSnippetName(const Name: string; - const Item: TListItem; out ErrMsg: string): Boolean; -resourcestring - // Error message - sDuplicateName = '"%s" duplicates a name in the import list.'; -var - LI: TListItem; // each list item in list view -begin - // Checks snippet name for being well formed and not already in user database - Result := TSnippetValidator.ValidateName(Name, True, ErrMsg); - if not Result then - Exit; - // Checks name not already used for other imported snippets - for LI in lvImports.Items do - begin - if LI = Item then - Continue; // this is item we're about to change: ignore its name - if StrSameText(Name, GetImportAsNameFromLV(LI)) then - begin - ErrMsg := Format(sDuplicateName, [Name]); - Exit(False); - end; - end; -end; - end. diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index 902edc10b..6940a699d 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -427,6 +427,8 @@ procedure TCodeImporter.Execute(const Data: TBytes); fSnippetInfo[Idx].Data.Props.DisplayName := TXMLDocHelper.GetSubTagText( fXMLDoc, SnippetNode, cDisplayNameNode ); + if fSnippetInfo[Idx].Data.Props.DisplayName = '' then + fSnippetInfo[Idx].Data.Props.DisplayName := fSnippetInfo[Idx].Key; fSnippetInfo[Idx].Data.Props.SourceCode := TXMLDocHelper.GetSubTagText( fXMLDoc, SnippetNode, cSourceCodeTextNode ); diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index 2410bfc27..b1e71dec2 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -18,9 +18,14 @@ interface uses // Delphi - Generics.Collections, Generics.Defaults, + SysUtils, + Generics.Collections, + Generics.Defaults, // Project - UCodeImportExport, UExceptions, UIStringList; + DB.UCollections, + UCodeImportExport, + UExceptions, + UIStringList; type @@ -31,17 +36,16 @@ TImportInfo = record strict private // Property values fOrigKey: string; - fImportAsKey: string; + fDisplayName: string; fSkip: Boolean; public /// Initialises properties to given values. - constructor Create(const AOrigKey, AImportAsKey: string; + constructor Create(const AOrigKey, ADisplayName: string; const ASkip: Boolean = False); /// Snippet key per import file. property OrigKey: string read fOrigKey; - /// Key of snippet to be used when updating database. - /// Can be changed by user. - property ImportAsKey: string read fImportAsKey write fImportAsKey; + /// Snippet's display name. + property DisplayName: string read fDisplayName; /// Flag indicating if snippet is to be skipped (ignored) when /// updating database. property Skip: Boolean read fSkip write fSkip; @@ -78,6 +82,12 @@ TImportInfoList = class(TList) /// Returns index of record in list whose OrigKey field matches /// given name or -1 if name not found. function IndexOfKey(const Key: string): Integer; + /// Updates Skip property of a given list item. + /// string [in] Key that identifies list item to + /// be updated. + /// Boolean [in] Value to be stored in the given + /// list item's Skip property. + procedure SetSkip(const AKey: string; const AFlag: Boolean); end; type @@ -94,27 +104,11 @@ TCodeImportMgr = class sealed(TObject) fSnippetInfoList: TSnippetInfoList; /// Value of ImportInfo property. fImportInfoList: TImportInfoList; + /// Value of RequestCollectionCallback property. + fRequestCollectionCallback: TFunc; /// Initialises import information list with details of snippets /// read from import file. procedure InitImportInfoList; - /// Returns list of names that can't be used to rename an imported - /// snippet. - /// string [in] Name of snippet to be excluded - /// from import list. - /// IStringList: List of disallowed snippet names. - /// List is made up of all names of snippets in user database plus - /// names of all imported snippets except for ExcludedName. ExcludedName - /// should be the name of a snippet being renamed. - function DisallowedNames(const ExcludedName: string): IStringList; - /// Returns a name for snippet SnippetName that does not already - /// exist in user database or imported snippet list. - /// - /// If SnippetName is not in user database then it is returned - /// unchanged. - /// If SnippetName is in user database then numbers are appended - /// sequentially until a unique name is found. - /// - function GetUniqueSnippetName(const SnippetName: string): string; public /// Constructor. Sets up object. constructor Create; @@ -133,6 +127,12 @@ TCodeImportMgr = class sealed(TObject) /// List of information describing if and how to import snippets /// in import file. Permits customisation of import. property ImportInfo: TImportInfoList read fImportInfoList; + /// Callback that gets the ID of the collection that will receive + /// the imported snippets. + /// Defaults to the "user" collection ID if not assigned. + /// + property RequestCollectionCallback: TFunc + read fRequestCollectionCallback write fRequestCollectionCallback; end; type @@ -148,11 +148,9 @@ implementation uses // Delphi - SysUtils, Classes, // Project ActiveText.UMain, - DB.UCollections, DB.UMain, DB.USnippet, UIOUtils, @@ -167,6 +165,13 @@ constructor TCodeImportMgr.Create; inherited Create; SetLength(fSnippetInfoList, 0); fImportInfoList := TImportInfoList.Create; + // set default event handler + fRequestCollectionCallback := function: TCollectionID + begin + {TODO -cCollections: Require a TCollections.DefaultCollection method or + similar to replace the following __TMP__ method call.} + Result := TCollectionID.__TMP__UserDBCollectionID; + end; end; destructor TCodeImportMgr.Destroy; @@ -176,38 +181,6 @@ destructor TCodeImportMgr.Destroy; inherited; end; -function TCodeImportMgr.DisallowedNames(const ExcludedName: string): - IStringList; -var - Snippet: TSnippet; // each snippet in user database - SnippetInfo: TSnippetInfo; // info about each imported snippet -begin - Result := TIStringList.Create; - Result.CaseSensitive := False; - for Snippet in Database.Snippets do - if Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then - Result.Add(Snippet.Key); - for SnippetInfo in fSnippetInfoList do - if not StrSameText(SnippetInfo.Key, ExcludedName) then - Result.Add(SnippetInfo.Key); -end; - -function TCodeImportMgr.GetUniqueSnippetName( - const SnippetName: string): string; -var - UsedNames: IStringList; // list of snippet names in use - Postfix: Cardinal; // number to be appended to name to make unique -begin - UsedNames := DisallowedNames(SnippetName); - if not UsedNames.Contains(SnippetName) then - Exit(SnippetName); - Postfix := 1; - repeat - Inc(PostFix); - Result := SnippetName + IntToStr(PostFix); - until not UsedNames.Contains(Result); -end; - procedure TCodeImportMgr.Import(const FileName: string); var Data: TBytes; // content of import file as bytes @@ -228,13 +201,19 @@ procedure TCodeImportMgr.Import(const FileName: string); procedure TCodeImportMgr.InitImportInfoList; var SnippetInfo: TSnippetInfo; // info about each snippet in import file + begin fImportInfoList.Clear; for SnippetInfo in fSnippetInfoList do begin fImportInfoList.Add( TImportInfo.Create( - SnippetInfo.Key, GetUniqueSnippetName(SnippetInfo.Key) + SnippetInfo.Key, + StrIf( + SnippetInfo.Data.Props.DisplayName = '', + SnippetInfo.Key, + SnippetInfo.Data.Props.DisplayName + ) ) ); end; @@ -269,11 +248,14 @@ procedure TCodeImportMgr.UpdateDatabase; Snippet: TSnippet; // reference any existing snippet to overwrite SnippetInfo: TSnippetInfo; // info about each snippet from import file ImportInfo: TImportInfo; // info about how / whether to import a snippet + CollectionID: TCollectionID; + SnippetKey: string; resourcestring // Error message sBadNameError = 'Can''t find snippet with key "%s" in import data'; begin Editor := Database as IDatabaseEdit; + CollectionID := RequestCollectionCallback(); for SnippetInfo in fSnippetInfoList do begin if not fImportInfoList.FindByKey(SnippetInfo.Key, ImportInfo) then @@ -284,24 +266,27 @@ procedure TCodeImportMgr.UpdateDatabase; AdjustDependsList(SnippetInfo.Data.Refs.Depends); - Snippet := Database.Snippets.Find(ImportInfo.ImportAsKey, TCollectionID.__TMP__UserDBCollectionID); + Snippet := Database.Snippets.Find(ImportInfo.OrigKey, CollectionID); if Assigned(Snippet) then - // snippet already exists: overwrite it - Editor.UpdateSnippet(Snippet, SnippetInfo.Data) + SnippetKey := (Database as IDatabaseEdit).GetUniqueSnippetKey( + CollectionID + ) else - // snippet is new: add to database - Editor.AddSnippet(ImportInfo.ImportAsKey, SnippetInfo.Data); + SnippetKey := ImportInfo.OrigKey; + Editor.AddSnippet(SnippetKey, SnippetInfo.Data); + {TODO -cVault: Reintroduce the option to overwrite a snippet with matching + ID, but allow user to select whether this can happen.} end; end; { TImportInfo } -constructor TImportInfo.Create(const AOrigKey, AImportAsKey: string; - const ASkip: Boolean); +constructor TImportInfo.Create(const AOrigKey, ADisplayName: string; + const ASkip: Boolean = False); begin fOrigKey := AOrigKey; - fImportAsKey := AImportAsKey; fSkip := ASkip; + fDisplayName := ADisplayName; end; { TImportInfoComparer } @@ -323,7 +308,7 @@ function TImportInfoList.FindByKey(const Key: string; var Idx: Integer; // index of named snippet in list begin - Idx := IndexOf(TImportInfo.Create(Key, '')); + Idx := IndexOfKey(Key); if Idx = -1 then Exit(False); ImportInfo := Items[Idx]; @@ -335,5 +320,21 @@ function TImportInfoList.IndexOfKey(const Key: string): Integer; Result := IndexOf(TImportInfo.Create(Key, '')); end; +procedure TImportInfoList.SetSkip(const AKey: string; const AFlag: Boolean); +const + // Do not localise + sKeyNotFound = 'Snippet key "%s" not found while setting import skip flag'; +var + ImportInfo: TImportInfo; + Idx: Integer; +begin + Idx := IndexOfKey(AKey); + if Idx < 0 then + raise EBug.CreateFmt(sKeyNotFound, [AKey]); + ImportInfo := Items[Idx]; + ImportInfo.Skip := AFlag; + Items[Idx] := ImportInfo; +end; + end. From eb51720c1d3cf6a28a3ace4801ef5b58f4086e24 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 8 Nov 2024 17:35:28 +0000 Subject: [PATCH 053/222] Change how SWAG import handles snippet keys The snippet key under which a SWAG snippet is to be created has been changed. It was previously created from concatenating "SWAG" with the SWAG ID number of the snippet. It is now generated by calling IDatabaseEdit.GetUniqueSnippetKey, which brings it into line with how other parts of CodeSnip create new keys. As part of this change, the ID of the collection receiving the snippets was required. A method was added to TSWAGImportDlg to get the ID of the collection in which to add imported SWAG snippets. This method is a stub that always returns the "user" collection ID. In later updates it will be changed to get the required collection from the user. The SWAG import wizard no longer displays the key to be used for imported snippets. --- Src/FmSWAGImportDlg.dfm | 15 +++++--------- Src/FmSWAGImportDlg.pas | 21 ++++++++++++++++++-- Src/SWAG.UImporter.pas | 43 +++++++++++++---------------------------- 3 files changed, 37 insertions(+), 42 deletions(-) diff --git a/Src/FmSWAGImportDlg.dfm b/Src/FmSWAGImportDlg.dfm index e93311a78..534e58ae8 100644 --- a/Src/FmSWAGImportDlg.dfm +++ b/Src/FmSWAGImportDlg.dfm @@ -192,11 +192,10 @@ inherited SWAGImportDlg: TSWAGImportDlg AutoSize = False Caption = 'You have chosen to import the following SWAG packets as CodeSnip' + - ' snippets. They will be imported with the given Display Names an' + - 'd Packet IDs. You can change these if you wish using the Snippet' + - 's Editor. To make changes go back to the previous page. When you' + - ' are ready to import the packets click "Import". This step can'#39't' + - ' be undone.' + ' snippets with the given Display Names. You can change these nam' + + 'es later, if you wish, using the Snippets Editor. To modify your' + + ' selection go back to the previous page. When you are ready to i' + + 'mport the packets click "Import". This step can'#39't be undone.' WordWrap = True end object lvImports: TListView @@ -207,11 +206,7 @@ inherited SWAGImportDlg: TSWAGImportDlg Columns = < item Caption = 'Packet Title '#8594' Snippet Display Name' - Width = 400 - end - item - Caption = 'Snippet Name from SWAG ID' - Width = 200 + Width = 600 end> ColumnClick = False GridLines = True diff --git a/Src/FmSWAGImportDlg.pas b/Src/FmSWAGImportDlg.pas index ffe252edc..a6e3db4eb 100644 --- a/Src/FmSWAGImportDlg.pas +++ b/Src/FmSWAGImportDlg.pas @@ -24,9 +24,11 @@ interface StdCtrls, Forms, ExtCtrls, + ActnList, Classes, Generics.Collections, // Project + DB.UCollections, FmWizardDlg, FrBrowserBase, FrFixedHTMLDlg, @@ -37,7 +39,7 @@ interface UCSSBuilder, SWAG.UCommon, SWAG.UImporter, - SWAG.UReader, ActnList; + SWAG.UReader; type @@ -106,6 +108,9 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) procedure actDisplayPacketUpdate(Sender: TObject); strict private const + {TODO -cCollections: Add combo box to select collection into which to add + imported snippets. Either add combo box to update page, or add a + new page for it before finish page or before update page.} /// Index of introductory page in wizard. cIntroPage = 0; /// Index of SWAG database folder selection page in wizard. @@ -140,6 +145,10 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) /// Retrieves import directory name from edit control where it is /// entered. function GetDirNameFromEditCtrl: string; + /// Retrieves collection specified by user that applies to + /// imported snippets. + /// TCollectionID. The required collection ID. + function SelectedCollectionID: TCollectionID; /// Validates entries on the wizard page identified by the given /// page index. procedure ValidatePage(const PageIdx: Integer); @@ -771,7 +780,6 @@ procedure TSWAGImportDlg.PopulateImportsLV; begin LI := lvImports.Items.Add; LI.Caption := Packet.Title; - LI.SubItems.Add(TSWAGImporter.MakeValidSnippetName(Packet.ID)); end; finally lvImports.Items.EndUpdate; @@ -823,6 +831,14 @@ procedure TSWAGImportDlg.PreviewSelectedPacket; ); end; +function TSWAGImportDlg.SelectedCollectionID: TCollectionID; +begin + {TODO -cCollections: Replace the following __TMP__ method with collection ID + selected by user from a combo box. DO NOT permit this choice when + editing an existing snippet.} + Result := TCollectionID.__TMP__UserDBCollectionID; +end; + procedure TSWAGImportDlg.UpdateButtons(const PageIdx: Integer); resourcestring // button caption for update page @@ -856,6 +872,7 @@ procedure TSWAGImportDlg.UpdateDatabase; procedure begin fImporter.Import( + SelectedCollectionID, procedure (const Packet: TSWAGPacket) begin Application.ProcessMessages; diff --git a/Src/SWAG.UImporter.pas b/Src/SWAG.UImporter.pas index ab193dd22..131d565da 100644 --- a/Src/SWAG.UImporter.pas +++ b/Src/SWAG.UImporter.pas @@ -21,6 +21,7 @@ interface Generics.Collections, // Project ActiveText.UMain, + DB.UCollections, DB.USnippet, SWAG.UCommon; @@ -57,7 +58,8 @@ TSWAGImporter = class(TObject) TSnippetEditData; /// Imports (i.e. adds) the given SWAG packet into the user /// database as a CodeSnip format snippet. - procedure ImportPacketAsSnippet(const SWAGPacket: TSWAGPacket); + procedure ImportPacketAsSnippet(const ACollectionID: TCollectionID; + const SWAGPacket: TSWAGPacket); public /// Constructs new object instance. constructor Create; @@ -76,11 +78,8 @@ TSWAGImporter = class(TObject) /// called after each SWAG packet is imported. /// The packets that are imported are those that have been /// recorded by calling IncludePacket. - procedure Import(const Callback: TProgressCallback = nil); - /// Creates and returns a valid CodeSnip snippet name, based on - /// the given SWAG packet ID, that is unique in the user database. - /// - class function MakeValidSnippetName(SWAGPacketID: Cardinal): string; + procedure Import(const ACollectionID: TCollectionID; + const Callback: TProgressCallback = nil); /// Description of the category in the user database used for all /// imported SWAG packets. class function SWAGCategoryDesc: string; @@ -234,7 +233,8 @@ function TSWAGImporter.ExtraBoilerplate: IActiveText; Result := fExtraBoilerplate; end; -procedure TSWAGImporter.Import(const Callback: TProgressCallback); +procedure TSWAGImporter.Import(const ACollectionID: TCollectionID; + const Callback: TProgressCallback); var SWAGPacket: TSWAGPacket; begin @@ -242,18 +242,19 @@ procedure TSWAGImporter.Import(const Callback: TProgressCallback); begin if Assigned(Callback) then Callback(SWAGPacket); - ImportPacketAsSnippet(SWAGPacket); + ImportPacketAsSnippet(ACollectionID, SWAGPacket); end; end; -procedure TSWAGImporter.ImportPacketAsSnippet(const SWAGPacket: TSWAGPacket); +procedure TSWAGImporter.ImportPacketAsSnippet( + const ACollectionID: TCollectionID; const SWAGPacket: TSWAGPacket); var - SnippetName: string; // unique name of new snippet + SnippetKey: string; // unique ID of new snippet SnippetDetails: TSnippetEditData; // data describing new snippet begin - SnippetName := MakeValidSnippetName(SWAGPacket.ID); + SnippetKey := (Database as IDatabaseEdit).GetUniqueSnippetKey(ACollectionID); SnippetDetails := BuildSnippetInfo(SWAGPacket); - (Database as IDatabaseEdit).AddSnippet(SnippetName, SnippetDetails); + (Database as IDatabaseEdit).AddSnippet(SnippetKey, SnippetDetails); end; procedure TSWAGImporter.IncludePacket(const SWAGPacket: TSWAGPacket); @@ -261,24 +262,6 @@ procedure TSWAGImporter.IncludePacket(const SWAGPacket: TSWAGPacket); fImportList.Add(SWAGPacket); end; -class function TSWAGImporter.MakeValidSnippetName(SWAGPacketID: Cardinal): - string; -var - Appendix: Integer; - RootName: string; -begin - RootName := 'SWAG_' + IntToStr(SWAGPacketID); - Assert(IsValidIdent(RootName, False), ClassName - + '.MakeValidSnippetName: RootName is not a valid snippet identifier'); - Result := RootName; - Appendix := 0; - while not TSnippetValidator.ValidateName(Result, True) do - begin - Inc(Appendix); - Result := RootName + '_' + IntToStr(Appendix); - end; -end; - procedure TSWAGImporter.Reset; begin fImportList.Clear; From 667a3bafc7dcd51fa882be5473376e231b5a20d4 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 8 Nov 2024 18:03:15 +0000 Subject: [PATCH 054/222] Removed all TSnippetValidator.ValidateName overloads The TSnippetValidator.ValidateName overloads are no longer required or called now that snippet keys are not user-editable: program generated keys are guaranteed to be valid. Also removed call to TSnippetValidator.ValidateName from TSnippetValidator.Validate that validates an entire snippet, because snippets cannot now be created with invalid keys. --- Src/USnippetValidator.pas | 99 ++------------------------------------- 1 file changed, 3 insertions(+), 96 deletions(-) diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index d3452ea15..0cbcdd7c9 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -79,37 +79,6 @@ TSnippetValidator = class(TNoConstructObject) @param ErrorSel [out] Selection that can be used to highlight error. @return True if description is valid or False if not. } - class function ValidateName(const Key: string; - const CheckForUniqueness: Boolean): Boolean; overload; - {Validates a snippet's key. - @param Key [in] Snippet key to be checked. - @param CheckForUniqueness [in] Flag indicating whether a check should - be made to see if snippet key is already in user database. - @return True if key is valid or False if not. - } - class function ValidateName(const Key: string; - const CheckForUniqueness: Boolean; out ErrorMsg: string): Boolean; - overload; - {Validates a snippet's key. - @param Key [in] Snippet key to be checked. - @param CheckForUniqueness [in] Flag indicating whether a check should - be made to see if snippet key is already in user database. - @param ErrorMsg [out] Message that describes error. Undefined if True - returned. - @return True if key is valid or False if not. - } - class function ValidateName(const Key: string; - const CheckForUniqueness: Boolean; out ErrorMsg: string; - out ErrorSel: TSelection): Boolean; overload; - {Validates a snippet's key. - @param Key [in] Snippet key to be checked. - @param CheckForUniqueness [in] Flag indicating whether a check should - be made to see if snippet key is already in user database. - @param ErrorMsg [out] Message that describes error. Undefined if True - returned. - @param ErrorSel [out] Selection that can be used to highlight error. - @return True if key is valid or False if not. - } class function ValidateExtra(const Extra: IActiveText; out ErrorMsg: string): Boolean; {Validates a extra information from a snippet. @@ -183,8 +152,9 @@ class function TSnippetValidator.Validate(const Snippet: TSnippet; @return True if snippet valid or False if not. } begin - Result := ValidateName(Snippet.Key, False, ErrorMsg, ErrorSel) - and ValidateDescription(Snippet.Description.ToString, ErrorMsg, ErrorSel) + Result := + {TODO -cVault: Add validation of display name here} + ValidateDescription(Snippet.Description.ToString, ErrorMsg, ErrorSel) and ValidateSourceCode(Snippet.SourceCode, ErrorMsg, ErrorSel) and ValidateDependsList(Snippet, ErrorMsg) and ValidateExtra(Snippet.Extra, ErrorMsg); @@ -372,69 +342,6 @@ class function TSnippetValidator.ValidateExtra(const Extra: IActiveText; ErrorMsg := ErrorInfo.Description; end; -class function TSnippetValidator.ValidateName(const Key: string; - const CheckForUniqueness: Boolean; out ErrorMsg: string): Boolean; - {Validates a snippet's key. - @param Key [in] Snippet key to be checked. - @param CheckForUniqueness [in] Flag indicating whether a check should be - made to see if snippet key is already in user database. - @param ErrorMsg [out] Message that describes error. Undefined if True - returned. - @return True if key is valid or False if not. - } -resourcestring - // Error messages - sErrNoKey = 'A key must be provided'; - sErrDupKey = 'Key "%s" is already in the database. Please choose another key'; - sErrBadKey = '"%s" is not a valid Pascal identifier'; -var - TrimmedKey: string; // Key param trimmed of leading trailing spaces -begin - Result := False; - TrimmedKey := StrTrim(Key); - if TrimmedKey = '' then - ErrorMsg := sErrNoKey - else if not IsValidIdent(TrimmedKey) then - ErrorMsg := Format(sErrBadKey, [TrimmedKey]) - else if CheckForUniqueness and - (Database.Snippets.Find(TrimmedKey, TCollectionID.__TMP__UserDBCollectionID) <> nil) then - ErrorMsg := Format(sErrDupKey, [TrimmedKey]) - else - Result := True; -end; - -class function TSnippetValidator.ValidateName(const Key: string; - const CheckForUniqueness: Boolean; out ErrorMsg: string; - out ErrorSel: TSelection): Boolean; - {Validates a snippet's key. - @param Key [in] Snippet key to be checked. - @param CheckForUniqueness [in] Flag indicating whether a check should be - made to see if snippet key is already in user database. - @param ErrorMsg [out] Message that describes error. Undefined if True - returned. - @param ErrorSel [out] Selection that can be used to highlight error. - @return True if key is valid or False if not. - } -begin - Result := ValidateName(Key, CheckForUniqueness, ErrorMsg); - if not Result then - ErrorSel := TSelection.Create(0, Length(Key)); -end; - -class function TSnippetValidator.ValidateName(const Key: string; - const CheckForUniqueness: Boolean): Boolean; - {Validates a snippet's key. - @param Key [in] Snippet key to be checked. - @param CheckForUniqueness [in] Flag indicating whether a check should be - made to see if snippet key is already in user database. - @return True if key is valid or False if not. - } -var - DummyErrMsg: string; -begin - Result := ValidateName(Key, CheckForUniqueness, DummyErrMsg); -end; - class function TSnippetValidator.ValidateSourceCode(const Source: string; out ErrorMsg: string; out ErrorSel: TSelection): Boolean; {Validates a source code from a snippet. From a909774993b7046f2e3ed3a9faac0409bc4b9121 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 9 Nov 2024 00:40:29 +0000 Subject: [PATCH 055/222] Change property names in snippet related actions Renamed `SnippetName` property to `Key` in both TSnippetAction and TEditSnippetAction. Updated calling code re the renaming. --- Src/FmMain.pas | 2 +- Src/UEditSnippetAction.pas | 16 +++++++++------- Src/UNotifier.pas | 4 ++-- Src/USnippetAction.pas | 26 +++++++++++++++----------- 4 files changed, 27 insertions(+), 21 deletions(-) diff --git a/Src/FmMain.pas b/Src/FmMain.pas index 6b04f8107..606a035a1 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -762,7 +762,7 @@ procedure TMainForm.ActEditDeleteSnippetUpdate(Sender: TObject); procedure TMainForm.ActEditSnippetByNameExecute(Sender: TObject); begin - TUserDBMgr.EditSnippet((Sender as TEditSnippetAction).SnippetName); + TUserDBMgr.EditSnippet((Sender as TEditSnippetAction).Key); end; procedure TMainForm.actEditSnippetExecute(Sender: TObject); diff --git a/Src/UEditSnippetAction.pas b/Src/UEditSnippetAction.pas index 4b33cc385..8763da475 100644 --- a/Src/UEditSnippetAction.pas +++ b/Src/UEditSnippetAction.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * - * Custom action used to request editing of a named user-defined snippet. + * Custom action used to request editing of a user-defined snippet. } @@ -20,19 +20,21 @@ interface Classes; +{TODO -cCollections: Add a collection ID property, or change Key property to ID of + type TSnippetID.} + type /// - /// Custom action used to request that a named user defined snippet is - /// edited. + /// Custom action used to request that a user defined snippet is edited. /// TEditSnippetAction = class(TBasicAction) strict private var - /// Value of SnippetName property. - fSnippetName: string; + /// Value of Key property. + fKey: string; public - /// Name of snippet to be edited. - property SnippetName: string read fSnippetName write fSnippetName; + /// Key of snippet to be edited. + property Key: string read fKey write fKey; end; diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index 34df201cf..e4fc727b1 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -259,7 +259,7 @@ procedure TNotifier.DisplaySnippet(const Key: WideString; begin if Assigned(fDisplaySnippetAction) then begin - (fDisplaySnippetAction as TSnippetAction).SnippetName := Key; + (fDisplaySnippetAction as TSnippetAction).Key := Key; (fDisplaySnippetAction as TSnippetAction).CollectionID := ACollectionID; (fDisplaySnippetAction as TSnippetAction).NewTab := NewTab; fDisplaySnippetAction.Execute; @@ -270,7 +270,7 @@ procedure TNotifier.EditSnippet(const Key: WideString); begin if Assigned(fEditSnippetAction) then begin - (fEditSnippetAction as TEditSnippetAction).SnippetName := Key; + (fEditSnippetAction as TEditSnippetAction).Key := Key; fEditSnippetAction.Execute; end; end; diff --git a/Src/USnippetAction.pas b/Src/USnippetAction.pas index 6f801e5bc..5d17d1fcc 100644 --- a/Src/USnippetAction.pas +++ b/Src/USnippetAction.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * - * Custom action used to request display of a snippet by name. + * Custom action used to request display of a snippet by key and collection ID. } @@ -23,20 +23,22 @@ interface IntfNotifier; +{TODO -cVault: Combine the two TSnippetAction properties into a single + TSnippetID property.} + type /// /// Custom action used to request display of a snippet. /// /// - /// Required snippet is uniquely identified by its name and whether it is - /// user defined or not. + /// Required snippet is uniquely identified by its key and collection ID. /// TSnippetAction = class(TBasicAction, ISetNotifier) strict private var - /// Value of SnippetName property. - fSnippetName: string; + /// Value of Key property. + fKey: string; /// Value of CollectionID property. fCollectionID: TCollectionID; /// Value of NewTab property. @@ -57,12 +59,12 @@ TSnippetAction = class(TBasicAction, ISetNotifier) /// Stores reference to given notifier object. /// Implements ISetNotifier.SetNotifier procedure SetNotifier(const Notifier: INotifier); - /// Name of snippet to be displayed. - property SnippetName: string read fSnippetName write fSnippetName; + /// Key of snippet to be displayed. + property Key: string read fKey write fKey; /// ID of the collection containing the snippet to be displayed. /// property CollectionID: TCollectionID read fCollectionID write fCollectionID; - /// Flag indicating if snippet is to be displayed in new detail + /// Flag indicating if snippet is to be displayed in a new detail /// pane tab. property NewTab: Boolean read fNewTab write fNewTab; end; @@ -85,9 +87,11 @@ function TSnippetAction.Execute: Boolean; Snippet: TSnippet; // snippet to be displayed begin Assert(Assigned(fNotifier), ClassName + '.Execute: Notifier not set'); - Assert(SnippetName <> '', ClassName + '.Execute: SnippetName not provided'); - Snippet := Database.Snippets.Find(SnippetName, fCollectionID); - Assert(Assigned(Snippet), ClassName + '.Execute: SnippetName not valid'); + Assert(Key <> '', ClassName + '.Execute: Key not provided'); + + Snippet := Database.Snippets.Find(Key, fCollectionID); + Assert(Assigned(Snippet), ClassName + '.Execute: Key not valid'); + // Create a view item for snippet and get notifier to display it fNotifier.ShowViewItem(TViewFactory.CreateSnippetView(Snippet), NewTab); Result := False; From aae1699aa649336ffdae03a6931df019780d10fa Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 9 Nov 2024 02:30:53 +0000 Subject: [PATCH 056/222] Add collection ID param to TDatabase.Add method Also added collection ID parameter to TDatabase.InternalAdd. Calling code and internal TDatabase code was updated re this change. --- Src/DB.UMain.pas | 98 +++++++++++++++++++++---------------- Src/FmSnippetsEditorDlg.pas | 2 +- Src/SWAG.UImporter.pas | 4 +- Src/UCodeImportMgr.pas | 2 +- 4 files changed, 61 insertions(+), 45 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 6e5844c1e..59d089cfb 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -219,13 +219,17 @@ interface key is not to change. @return Reference to updated snippet. Will have changed. } - function AddSnippet(const SnippetKey: string; - const Data: TSnippetEditData): TSnippet; - {Adds a new snippet to the user database. - @param SnippetKey [in] New snippet's key. - @param Data [in] Record storing new snippet's properties and references. - @return Reference to new snippet. - } + + /// Adds a new snippet to the database. + /// string [in] New snippet's key. + /// TCollectionID [in] ID of collection + /// that the new snippet will belong to. + /// TSnippetEditData [in] Record storing the new + /// snippet's properties and references. + /// TSnippet. Reference to the new snippet. + function AddSnippet(const AKey: string; const ACollectionID: TCollectionID; + const AData: TSnippetEditData): TSnippet; + function DuplicateSnippet(const Snippet: TSnippet; const UniqueKey, DisplayName: string; const CatID: string): TSnippet; function CreateTempSnippet(const SnippetKey: string; @@ -390,14 +394,26 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) @param Info [in] Reference to any further information for event. May be nil. } - function InternalAddSnippet(const SnippetKey: string; - const Data: TSnippetEditData): TSnippet; + + /// Adds a new snippet to the database. Assumes the snippet is + /// not already in the database. + /// string [in] New snippet's key. + /// TCollectionID [in] ID of collection + /// that the new snippet will belong to. + /// TSnippetEditData [in] Record storing the new + /// snippet's properties and references. + /// TSnippet. Reference to the new snippet. + /// ECodeSnip raised if the snippet's category does not + /// exist. + function InternalAddSnippet(const AKey: string; + const ACollectionID: TCollectionID; const AData: TSnippetEditData): + TSnippet; {Adds a new snippet to the user database. Assumes snippet not already in user database. @param SnippetKey [in] New snippet's key. @param Data [in] Properties and references of new snippet. @return Reference to new snippet object. - @except Exception raised if snippet's category does not exist. + @except Exception raised if } procedure InternalDeleteSnippet(const Snippet: TSnippet); {Deletes a snippet from the user database. @@ -497,13 +513,18 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) key is not to change. @return Reference to updated snippet. Will have changed. } - function AddSnippet(const SnippetKey: string; - const Data: TSnippetEditData): TSnippet; - {Adds a new snippet to the user database. - @param SnippetKey [in] New snippet's key. - @param Data [in] Record storing new snippet's properties and references. - @return Reference to new snippet. - } + + /// Adds a new snippet to the database. + /// string [in] New snippet's key. + /// TCollectionID [in] ID of collection + /// that the new snippet will belong to. + /// TSnippetEditData [in] Record storing the new + /// snippet's properties and references. + /// TSnippet. Reference to the new snippet. + /// Method of IDatabaseEdit. + function AddSnippet(const AKey: string; const ACollectionID: TCollectionID; + const AData: TSnippetEditData): TSnippet; + function DuplicateSnippet(const Snippet: TSnippet; const UniqueKey, DisplayName: string; const CatID: string): TSnippet; function CreateTempSnippet(const SnippetKey: string; @@ -662,24 +683,19 @@ procedure TDatabase.AddChangeEventHandler(const Handler: TNotifyEventInfo); fChangeEvents.AddHandler(Handler); end; -function TDatabase.AddSnippet(const SnippetKey: string; - const Data: TSnippetEditData): TSnippet; - {Adds a new snippet to the user database. - @param SnippetKey [in] New snippet's key. - @param Data [in] Record storing new snippet's properties and references. - @return Reference to new snippet. - } +function TDatabase.AddSnippet(const AKey: string; + const ACollectionID: TCollectionID; const AData: TSnippetEditData): TSnippet; resourcestring // Error message - sKeyExists = 'Snippet with key "%s" already exists in user database'; + sKeyExists = 'Snippet with key "%s" already exists in collection'; begin Result := nil; // keeps compiler happy TriggerEvent(evChangeBegin); try // Check if snippet with same key exists in user database: error if so - if fSnippets.Find(SnippetKey, TCollectionID.__TMP__UserDBCollectionID) <> nil then - raise ECodeSnip.CreateFmt(sKeyExists, [SnippetKey]); - Result := InternalAddSnippet(SnippetKey, Data); + if fSnippets.Find(AKey, ACollectionID) <> nil then + raise ECodeSnip.CreateFmt(sKeyExists, [AKey]); + Result := InternalAddSnippet(AKey, ACollectionID, AData); Query.Update; TriggerEvent(evSnippetAdded, Result); finally @@ -815,13 +831,14 @@ destructor TDatabase.Destroy; function TDatabase.DuplicateSnippet(const Snippet: TSnippet; const UniqueKey, DisplayName: string; const CatID: string): TSnippet; + {TODO -cCollections: Add collection ID parameter} var Data: TSnippetEditData; begin Data := (Snippet as TSnippetEx).GetEditData; Data.Props.Cat := CatID; Data.Props.DisplayName := DisplayName; - Result := AddSnippet(UniqueKey, Data); + Result := AddSnippet(UniqueKey, TCollectionID.__TMP__UserDBCollectionID, Data); end; function TDatabase.GetCategories: TCategoryList; @@ -974,15 +991,8 @@ function TDatabase.InternalAddCategory(const CatID: string; fCategories.Add(Result); end; -function TDatabase.InternalAddSnippet(const SnippetKey: string; - const Data: TSnippetEditData): TSnippet; - {Adds a new snippet to the user database. Assumes snippet not already in user - database. - @param SnippetKey [in] New snippet's key. - @param Data [in] Properties and references of new snippet. - @return Reference to new snippet object. - @except Exception raised if snippet's category does not exist. - } +function TDatabase.InternalAddSnippet(const AKey: string; + const ACollectionID: TCollectionID; const AData: TSnippetEditData): TSnippet; var Cat: TCategory; // category object containing new snippet resourcestring @@ -990,8 +1000,8 @@ function TDatabase.InternalAddSnippet(const SnippetKey: string; sCatNotFound = 'Category "%0:s" referenced by new snippet with key "%1:s" ' + 'does not exist'; begin - Result := TSnippetEx.Create(SnippetKey, TCollectionID.__TMP__UserDBCollectionID, Data.Props); - (Result as TSnippetEx).UpdateRefs(Data.Refs, fSnippets); + Result := TSnippetEx.Create(AKey, ACollectionID, AData.Props); + (Result as TSnippetEx).UpdateRefs(AData.Refs, fSnippets); Cat := fCategories.Find(Result.Category); if not Assigned(Cat) then raise ECodeSnip.CreateFmt(sCatNotFound, [Result.Category, Result.Key]); @@ -1193,6 +1203,10 @@ function TDatabase.Updated: Boolean; function TDatabase.UpdateSnippet(const Snippet: TSnippet; const Data: TSnippetEditData; const NewKey: string): TSnippet; + {TODO -cCollections: Don't need NewKey parameter: key never changes. Also + don't pass a collection ID, since that can never change either, + because to do so would (1) invalidate the key because key is only + guaranteed unique in collection and (2) would change the snippet ID} {Updates a user defined snippet's properties and references using provided data. @param Snippet [in] Snippet to be updated. Must be user-defined. @@ -1202,7 +1216,7 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; @return Reference to updated snippet. Will have changed. } var - SnippetKey: string; // snippet key + SnippetKey: string; // snippet key Dependent: TSnippet; // loops thru each snippetthat depends on Snippet Dependents: TSnippetList; // list of dependent snippets Referrer: TSnippet; // loops thru snippets that cross references Snippet @@ -1243,7 +1257,7 @@ function TDatabase.UpdateSnippet(const Snippet: TSnippet; // delete the snippet InternalDeleteSnippet(Snippet); // add new snippet - Result := InternalAddSnippet(SnippetKey, Data); + Result := InternalAddSnippet(SnippetKey, TCollectionID.__TMP__UserDBCollectionID, Data); // add new snippet to referrer list of referring snippets for Referrer in Referrers do Referrer.XRef.Add(Result); diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 4b3f8ec64..a93d070cd 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -648,7 +648,7 @@ procedure TSnippetsEditorDlg.btnOKClick(Sender: TObject); else begin (Database as IDatabaseEdit).AddSnippet( - UniqueSnippetKey, fEditData + UniqueSnippetKey, SelectedCollectionID, fEditData ) end; except diff --git a/Src/SWAG.UImporter.pas b/Src/SWAG.UImporter.pas index 131d565da..23f359efb 100644 --- a/Src/SWAG.UImporter.pas +++ b/Src/SWAG.UImporter.pas @@ -254,7 +254,9 @@ procedure TSWAGImporter.ImportPacketAsSnippet( begin SnippetKey := (Database as IDatabaseEdit).GetUniqueSnippetKey(ACollectionID); SnippetDetails := BuildSnippetInfo(SWAGPacket); - (Database as IDatabaseEdit).AddSnippet(SnippetKey, SnippetDetails); + (Database as IDatabaseEdit).AddSnippet( + SnippetKey, ACollectionID, SnippetDetails + ); end; procedure TSWAGImporter.IncludePacket(const SWAGPacket: TSWAGPacket); diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index b1e71dec2..8a91a2560 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -273,7 +273,7 @@ procedure TCodeImportMgr.UpdateDatabase; ) else SnippetKey := ImportInfo.OrigKey; - Editor.AddSnippet(SnippetKey, SnippetInfo.Data); + Editor.AddSnippet(SnippetKey, CollectionID, SnippetInfo.Data); {TODO -cVault: Reintroduce the option to overwrite a snippet with matching ID, but allow user to select whether this can happen.} end; From b7e65378dfe177c89cd2f42d78ba6082134cb888 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 9 Nov 2024 03:18:10 +0000 Subject: [PATCH 057/222] Remove key parameter from TDatabase.UpdateSnippet Revised TDatabase.UpdateSnippet to prevent the snippet key from being changed. The `NewKey` parameter was removed. Revised calling code in FmSnippetsEditorDlg re the changed signature of TDatabase.UpdateSnippet. --- Src/DB.UMain.pas | 122 +++++++++++++++++------------------- Src/FmSnippetsEditorDlg.pas | 4 +- 2 files changed, 59 insertions(+), 67 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 59d089cfb..1078fd939 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -209,16 +209,18 @@ interface @param Snippet [in] Snippet for which cross referers are required. @return List of IDs of referring snippets. } - function UpdateSnippet(const Snippet: TSnippet; - const Data: TSnippetEditData; const NewKey: string = ''): TSnippet; - {Updates a user defined snippet's properties and references using provided - data. - @param Snippet [in] Snippet to be updated. Must be user-defined. - @param Data [in] Record containing revised data. - @param NewKey [in] New snippet's key. Set to '' or Snippet.Key if - key is not to change. - @return Reference to updated snippet. Will have changed. - } + + /// Updates a snippet's properties and references using the + /// provided data. + /// TSnippet [in] Snippet to be updated. + /// + /// TSnippetEditData [in] Record containing the + /// revised data. + /// TSnippet. Reference to the updated snippet. + /// The returned TSnippet object will be a different object + /// to ASnippet. + function UpdateSnippet(const ASnippet: TSnippet; + const AData: TSnippetEditData): TSnippet; /// Adds a new snippet to the database. /// string [in] New snippet's key. @@ -503,16 +505,21 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) @param Snippet [in] Snippet which is cross referenced. @return List of IDs of referring snippets. } - function UpdateSnippet(const Snippet: TSnippet; - const Data: TSnippetEditData; const NewKey: string = ''): TSnippet; - {Updates a user defined snippet's properties and references using provided - data. - @param Snippet [in] Snippet to be updated. Must be user-defined. - @param Data [in] Record containing revised data. - @param NewKey [in] New snippet's key. Set to '' or Snippet.Key if - key is not to change. - @return Reference to updated snippet. Will have changed. - } + + /// Updates a snippet's properties and references using the + /// provided data. + /// TSnippet [in] Snippet to be updated. + /// + /// TSnippetEditData [in] Record containing the + /// revised data. + /// TSnippet. Reference to the updated snippet. + /// + /// The returned TSnippet object will be a different object + /// to ASnippet. + /// Method of IDatabaseEdit. + /// + function UpdateSnippet(const ASnippet: TSnippet; + const AData: TSnippetEditData): TSnippet; /// Adds a new snippet to the database. /// string [in] New snippet's key. @@ -1201,70 +1208,57 @@ function TDatabase.Updated: Boolean; Result := fUpdated; end; -function TDatabase.UpdateSnippet(const Snippet: TSnippet; - const Data: TSnippetEditData; const NewKey: string): TSnippet; - {TODO -cCollections: Don't need NewKey parameter: key never changes. Also - don't pass a collection ID, since that can never change either, - because to do so would (1) invalidate the key because key is only - guaranteed unique in collection and (2) would change the snippet ID} - {Updates a user defined snippet's properties and references using provided - data. - @param Snippet [in] Snippet to be updated. Must be user-defined. - @param Data [in] Record containing revised data. - @param NewKey [in] New snippet's key. Set to '' or Snippet.Key if key - is not to change. - @return Reference to updated snippet. Will have changed. - } +function TDatabase.UpdateSnippet(const ASnippet: TSnippet; + const AData: TSnippetEditData): TSnippet; var - SnippetKey: string; // snippet key - Dependent: TSnippet; // loops thru each snippetthat depends on Snippet Dependents: TSnippetList; // list of dependent snippets - Referrer: TSnippet; // loops thru snippets that cross references Snippet + Dependent: TSnippet; // each snippet that depend on ASnippet Referrers: TSnippetList; // list of referencing snippets -resourcestring - // Error message - sCantChangeKey = 'Can''t change key of snippet with key %0:s to %1:s: ' - + 'Snippet with key %1:s already exists in user database'; + Referrer: TSnippet; // each snippet that cross references ASnippet + PreservedSnippetID: TSnippetID; begin - Result := Snippet; // keeps compiler happy - Assert(Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, - ClassName + '.UpdateSnippet: Snippet is not user-defined'); Referrers := nil; Dependents := nil; + TriggerEvent(evChangeBegin); - TriggerEvent(evBeforeSnippetChange, Snippet); + TriggerEvent(evBeforeSnippetChange, ASnippet); + try - // Calculate new key - if NewKey <> '' then - SnippetKey := NewKey - else - SnippetKey := Snippet.Key; - // If key has changed then new key musn't exist in user database - if not StrSameText(SnippetKey, Snippet.Key) then - if fSnippets.Find(SnippetKey, TCollectionID.__TMP__UserDBCollectionID) <> nil then - raise ECodeSnip.CreateFmt(sCantChangeKey, [Snippet.Key, SnippetKey]); // We update by deleting old snippet and inserting new one + // get lists of snippets that cross reference or depend on this snippet Dependents := TSnippetList.Create; - GetDependentList(Snippet, Dependents); + GetDependentList(ASnippet, Dependents); Referrers := TSnippetList.Create; - GetReferrerList(Snippet, Referrers); - // remove invalid references from referring snippets + GetReferrerList(ASnippet, Referrers); + + // remove references to pre-update snippet from referring snippets for Referrer in Referrers do - (Referrer.XRef as TSnippetListEx).Delete(Snippet); + (Referrer.XRef as TSnippetListEx).Delete(ASnippet); for Dependent in Dependents do - (Dependent.Depends as TSnippetListEx).Delete(Snippet); - // delete the snippet - InternalDeleteSnippet(Snippet); - // add new snippet - Result := InternalAddSnippet(SnippetKey, TCollectionID.__TMP__UserDBCollectionID, Data); - // add new snippet to referrer list of referring snippets + (Dependent.Depends as TSnippetListEx).Delete(ASnippet); + + // record snippet's key and collection ID for use in re-created updated + // snippet + PreservedSnippetID := ASnippet.ID; + + // delete the old, pre-update snippet + InternalDeleteSnippet(ASnippet); + // add new, post-update snippet with same key & collection ID as old snippet + Result := InternalAddSnippet( + PreservedSnippetID.Key, PreservedSnippetID.CollectionID, AData + ); + + // add updated snippet to referrer lists of referring snippets for Referrer in Referrers do Referrer.XRef.Add(Result); for Dependent in Dependents do Dependent.Depends.Add(Result); + Query.Update; + TriggerEvent(evSnippetChanged, Result); + finally fUpdated := True; Referrers.Free; diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index a93d070cd..b4745cae2 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -642,9 +642,7 @@ procedure TSnippetsEditorDlg.btnOKClick(Sender: TObject); fEditData.Assign(UpdateData); // Add or update snippet if Assigned(fSnippet) then - (Database as IDatabaseEdit).UpdateSnippet( - fSnippet, fEditData, UniqueSnippetKey - ) + (Database as IDatabaseEdit).UpdateSnippet(fSnippet, fEditData) else begin (Database as IDatabaseEdit).AddSnippet( From 7d6622d37c481812e66272730c3b97ea87102a60 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 9 Nov 2024 09:46:41 +0000 Subject: [PATCH 058/222] Add collection ID param to TDatabase.DuplicateSnippet Updated TDatabase.DuplicateSnippet to take an additional TCollectionID parameter and to use that as the duplicate snippet's collection ID instead of always using the "user" collection. Renamed some the parameters. Updated calling code in FmDuplicateSnippetDlg to pass the required collection ID. --- Src/DB.UMain.pas | 55 ++++++++++++++++++++++++++++------- Src/FmDuplicateSnippetDlg.pas | 9 +++--- 2 files changed, 49 insertions(+), 15 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 1078fd939..0bf1a344c 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -232,8 +232,22 @@ interface function AddSnippet(const AKey: string; const ACollectionID: TCollectionID; const AData: TSnippetEditData): TSnippet; - function DuplicateSnippet(const Snippet: TSnippet; - const UniqueKey, DisplayName: string; const CatID: string): TSnippet; + /// Duplicates a snippet in the database. + /// TSnippet [in] Snippet to be duplicated. + /// + /// string [in] Key to be used for duplicated + /// snippet. + /// TCollectionID [in] ID of + /// collection the duplicated snippet belongs to. + /// string [in] Display name of the + /// duplicated snippet. + /// string [in] ID of the category to which the + /// duplicated snippet will belong. + /// TSnippet. Reference to the duplicated snippet. + /// + function DuplicateSnippet(const ASnippet: TSnippet; const ANewKey: string; + const ANewCollectionID: TCollectionID; const ANewDisplayName: string; + const ACatID: string): TSnippet; function CreateTempSnippet(const SnippetKey: string; const Data: TSnippetEditData): TSnippet; overload; {Creates a new temporary snippet without adding it to the Snippets @@ -532,8 +546,24 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) function AddSnippet(const AKey: string; const ACollectionID: TCollectionID; const AData: TSnippetEditData): TSnippet; - function DuplicateSnippet(const Snippet: TSnippet; - const UniqueKey, DisplayName: string; const CatID: string): TSnippet; + /// Duplicates a snippet in the database. + /// TSnippet [in] Snippet to be duplicated. + /// + /// string [in] Key to be used for duplicated + /// snippet. + /// TCollectionID [in] ID of + /// collection the duplicated snippet belongs to. + /// string [in] Display name of the + /// duplicated snippet. + /// string [in] ID of the category to which the + /// duplicated snippet will belong. + /// TSnippet. Reference to the duplicated snippet. + /// + /// Method of IDatabaseEdit. + function DuplicateSnippet(const ASnippet: TSnippet; const ANewKey: string; + const ANewCollectionID: TCollectionID; const ANewDisplayName: string; + const ACatID: string): TSnippet; + function CreateTempSnippet(const SnippetKey: string; const Data: TSnippetEditData): TSnippet; overload; {Creates a new temporary user defined snippet without adding it to the @@ -543,6 +573,7 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) @param Data [in] Record storing new snippet's properties and references. @return Reference to new snippet. } + function CreateTempSnippet(const Snippet: TSnippet): TSnippet; overload; {Creates a new temporary copy of a snippet without adding it to the Snippets object's snippets list. The new instance may not be added to the @@ -836,16 +867,18 @@ destructor TDatabase.Destroy; inherited; end; -function TDatabase.DuplicateSnippet(const Snippet: TSnippet; - const UniqueKey, DisplayName: string; const CatID: string): TSnippet; - {TODO -cCollections: Add collection ID parameter} +function TDatabase.DuplicateSnippet(const ASnippet: TSnippet; + const ANewKey: string; const ANewCollectionID: TCollectionID; + const ANewDisplayName: string; const ACatID: string): TSnippet; var Data: TSnippetEditData; begin - Data := (Snippet as TSnippetEx).GetEditData; - Data.Props.Cat := CatID; - Data.Props.DisplayName := DisplayName; - Result := AddSnippet(UniqueKey, TCollectionID.__TMP__UserDBCollectionID, Data); + {TODO -cVault: Update edit data before calling this method and replace + and ANewDisplayName and ACatID with a single AData parameter.} + Data := (ASnippet as TSnippetEx).GetEditData; + Data.Props.Cat := ACatID; + Data.Props.DisplayName := ANewDisplayName; + Result := AddSnippet(ANewKey, ANewCollectionID, Data); end; function TDatabase.GetCategories: TCategoryList; diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 1910b83dd..b43e946cd 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -82,6 +82,9 @@ implementation {$R *.dfm} +{TODO -cTidy: Re-order methods alphabetically} +{TODO -cRefactor: Add method to get display name from ctrl and strip whitespace} + { TDuplicateSnippetDlg } procedure TDuplicateSnippetDlg.ArrangeForm; @@ -183,14 +186,12 @@ function TDuplicateSnippetDlg.SelectedCollectionID: TCollectionID; end; procedure TDuplicateSnippetDlg.UpdateDatabase; -var - DisplayName: string; begin - DisplayName := StrTrim(edDisplayName.Text); (Database as IDatabaseEdit).DuplicateSnippet( fSnippet, fSnippetKey, - DisplayName, + SelectedCollectionID, + StrTrim(edDisplayName.Text), fCatList.CatID(cbCategory.ItemIndex) ); end; From 9c708b1ce07991064d248fd9871d39fd2f31782f Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 9 Nov 2024 10:24:43 +0000 Subject: [PATCH 059/222] Add collection ID param to TDatabase.CreateTempSnippet Updated TDatabase.CreateTempSnippet to take an additional TCollectionID parameter and to use that as the temporary snippet's collection ID instead of always using the "user" collection. Renamed some the parameters. Updated affected calling code: * Updated one of the TSnippetValidator.ValidateDependsList overloaded methods to also add a collection ID parameter so that it can pass it along to the revised TDatabase.CreateTempSnippet method. * Updated FmSnippetsEditorDlg to pass the required collection ID parameter to both TDatabase.CreateTempSnippet and TSnippetValidator.ValidateDependsList. --- Src/DB.UMain.pas | 63 ++++++++++++++++++++----------------- Src/FmSnippetsEditorDlg.pas | 4 +-- Src/USnippetValidator.pas | 46 +++++++++++++++++---------- 3 files changed, 65 insertions(+), 48 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 0bf1a344c..ca030ef0b 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -248,15 +248,21 @@ interface function DuplicateSnippet(const ASnippet: TSnippet; const ANewKey: string; const ANewCollectionID: TCollectionID; const ANewDisplayName: string; const ACatID: string): TSnippet; - function CreateTempSnippet(const SnippetKey: string; - const Data: TSnippetEditData): TSnippet; overload; - {Creates a new temporary snippet without adding it to the Snippets - object's snippets list. The new instance may not be added to the - Snippets object. - @param SnippetKey [in] New snippet's key. - @param Data [in] Record storing new snippet's properties and references. - @return Reference to new snippet. - } + + /// Creates a new temporary snippet without adding it to the + /// database. + /// string [in] The new nippet's key. + /// TCollectionID [in] ID of the + /// collection to which the new snippet belongs. + /// TSnippetEditData [in] Record storing the new + /// snippet's properties and references. + /// TSnippet Reference to new snippet. + /// The returned snippet must not be added to the database. + /// + function CreateTempSnippet(const AKey: string; + const ACollectionID: TCollectionID; const AData: TSnippetEditData): + TSnippet; overload; + function CreateTempSnippet(const Snippet: TSnippet): TSnippet; overload; {Creates a new temporary copy of a snippet without adding it to the Snippets object's snippets list. The new instance may not be added to the @@ -564,15 +570,21 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) const ANewCollectionID: TCollectionID; const ANewDisplayName: string; const ACatID: string): TSnippet; - function CreateTempSnippet(const SnippetKey: string; - const Data: TSnippetEditData): TSnippet; overload; - {Creates a new temporary user defined snippet without adding it to the - Snippets object's snippets list. The new instance may not be added to the - Snippets object. - @param SnippetKey [in] New snippet's key. - @param Data [in] Record storing new snippet's properties and references. - @return Reference to new snippet. - } + /// Creates a new temporary snippet without adding it to the + /// database. + /// string [in] The new nippet's key. + /// TCollectionID [in] ID of the + /// collection to which the new snippet belongs. + /// TSnippetEditData [in] Record storing the new + /// snippet's properties and references. + /// TSnippet Reference to new snippet. + /// + /// The returned snippet must not be added to the database. + /// Method of IDatabaseEdit. + /// + function CreateTempSnippet(const AKey: string; + const ACollectionID: TCollectionID; const AData: TSnippetEditData): + TSnippet; overload; function CreateTempSnippet(const Snippet: TSnippet): TSnippet; overload; {Creates a new temporary copy of a snippet without adding it to the @@ -781,18 +793,11 @@ function TDatabase.CreateTempSnippet(const Snippet: TSnippet): TSnippet; ); end; -function TDatabase.CreateTempSnippet(const SnippetKey: string; - const Data: TSnippetEditData): TSnippet; - {Creates a new temporary user defined snippet without adding it to the - Snippets object's snippets list. The new instance may not be added to the - Snippets object. - @param SnippetKey [in] New snippet's key. - @param Data [in] Record storing new snippet's properties and references. - @return Reference to new snippet. - } +function TDatabase.CreateTempSnippet(const AKey: string; + const ACollectionID: TCollectionID; const AData: TSnippetEditData): TSnippet; begin - Result := TTempSnippet.Create(SnippetKey, TCollectionID.__TMP__UserDBCollectionID, Data.Props); - (Result as TTempSnippet).UpdateRefs(Data.Refs, fSnippets); + Result := TTempSnippet.Create(AKey, ACollectionID, AData.Props); + (Result as TTempSnippet).UpdateRefs(AData.Refs, fSnippets); end; procedure TDatabase.DeleteCategory(const Category: TCategory); diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index b4745cae2..633a7fab0 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -692,7 +692,7 @@ function TSnippetsEditorDlg.CreateTempSnippet: TSnippet; // Create snippet object from entered data EditData.Assign(UpdateData); Result := (Database as IDatabaseEdit).CreateTempSnippet( - UniqueSnippetKey, EditData + UniqueSnippetKey, SelectedCollectionID, EditData ); end; @@ -1046,7 +1046,7 @@ procedure TSnippetsEditorDlg.ValidateData; raise EDataEntry.Create(ErrorMessage, edSourceCode, ErrorSelection); frmExtra.Validate; if not TSnippetValidator.ValidateDependsList( - UniqueSnippetKey, UpdateData, ErrorMessage + UniqueSnippetKey, SelectedCollectionID, UpdateData, ErrorMessage ) then raise EDataEntry.Create( // selection not applicable to list boxes StrMakeSentence(ErrorMessage) + EOL2 + sDependencyPrompt, clbDepends diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index 0cbcdd7c9..2674623b8 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -17,7 +17,12 @@ interface uses // Project - ActiveText.UMain, DB.USnippet, DB.USnippetKind, UBaseObjects, UStructs; + ActiveText.UMain, + DB.UCollections, + DB.USnippet, + DB.USnippetKind, + UBaseObjects, + UStructs; type @@ -50,17 +55,24 @@ TSnippetValidator = class(TNoConstructObject) returned. @return True if dependency list is valid or False if not. } - class function ValidateDependsList(const SnippetKey: string; - const Data: TSnippetEditData; out ErrorMsg: string): Boolean; overload; - {Recursively checks dependency list of a snippet for validity. - @param SnippetKey [in] Key of snippet for which dependencies are to be - checked. - @param Data [in] Data describing properties and references of snippet - for which dependencies are to be checked. - @param ErrorMsg [out] Message that describes error. Undefined if True - returned. - @return True if dependency list is valid or False if not. - } + + /// Recursively checks dependency list of a snippet for validity. + /// + /// string [in] Key of snippet for which + /// dependencies are to be checked. + /// TCollectionID [in] ID of the + /// collection to which snippet belongs. + /// TSnippetEditData [in] Data describing + /// properties and references of snippet for which dependencies are to be + /// checked. + /// string [out] Message that describes any + /// error. Undefined if True is returned. + /// Boolean. True if dependency list is valid or + /// False if not. + class function ValidateDependsList(const AKey: string; + const ACollectionID: TCollectionID; const AData: TSnippetEditData; + out AErrorMsg: string): Boolean; overload; + class function ValidateSourceCode(const Source: string; out ErrorMsg: string; out ErrorSel: TSelection): Boolean; {Validates a source code from a snippet. @@ -121,7 +133,6 @@ implementation SysUtils, // Project ActiveText.UValidator, - DB.UCollections, DB.UMain, UStrUtils; @@ -256,8 +267,9 @@ class function TSnippetValidator.ValidateDependsList(const Snippet: TSnippet; ); end; -class function TSnippetValidator.ValidateDependsList(const SnippetKey: string; - const Data: TSnippetEditData; out ErrorMsg: string): Boolean; +class function TSnippetValidator.ValidateDependsList(const AKey: string; + const ACollectionID: TCollectionID; const AData: TSnippetEditData; + out AErrorMsg: string): Boolean; {Recursively checks dependency list of a snippet for validity. @param SnippetKey [in] Key of snippet for which dependencies are to be checked. @@ -271,10 +283,10 @@ class function TSnippetValidator.ValidateDependsList(const SnippetKey: string; TempSnippet: TSnippet; // temporary snippet that is checked for dependencies begin TempSnippet := (Database as IDatabaseEdit).CreateTempSnippet( - SnippetKey, Data + AKey, ACollectionID, AData ); try - Result := ValidateDependsList(TempSnippet, ErrorMsg); + Result := ValidateDependsList(TempSnippet, AErrorMsg); finally TempSnippet.Free; end; From 1cc19233e22da3837e1887dcb43868bb96d98dbc Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 10 Nov 2024 09:06:50 +0000 Subject: [PATCH 060/222] All categories now display in same colour The code that checks which collection a category belongs to was removed from: * tree-view drawing code * HTML rendering code for category views rendered in the Details pane * RTF rendering code for category documentation in TRTFCategoryDoc. Consequently, all categories descriptions are now drawn in the same colour. --- Src/FrOverview.pas | 3 --- Src/FrSelectSnippetsBase.pas | 2 -- Src/UDetailPageHTML.pas | 11 ----------- Src/URTFCategoryDoc.pas | 1 - 4 files changed, 17 deletions(-) diff --git a/Src/FrOverview.pas b/Src/FrOverview.pas index d097cff68..aaeaf6e39 100644 --- a/Src/FrOverview.pas +++ b/Src/FrOverview.pas @@ -969,14 +969,11 @@ function TOverviewFrame.TTVDraw.GetCollectionID(const Node: TTreeNode): var ViewItem: IView; // view item represented by node SnippetView: ISnippetView; // view item if node represents a snippet - CategoryView: ICategoryView; // view item if node represents a category begin // TODO -cBug: Exception reported as issue #70 could have moved here ViewItem := (Node as TViewItemTreeNode).ViewItem; if Supports(ViewItem, ISnippetView, SnippetView) then Result := SnippetView.Snippet.CollectionID - else if Supports(ViewItem, ICategoryView, CategoryView) then - Result := CategoryView.Category.CollectionID else Result := TCollectionID.CreateNull; end; diff --git a/Src/FrSelectSnippetsBase.pas b/Src/FrSelectSnippetsBase.pas index 50b233e4d..71a08498d 100644 --- a/Src/FrSelectSnippetsBase.pas +++ b/Src/FrSelectSnippetsBase.pas @@ -283,8 +283,6 @@ function TSelectSnippetsBaseFrame.TTVDraw.GetCollectionID( SnipObj := TObject(Node.Data); if SnipObj is TSnippet then Result := (SnipObj as TSnippet).CollectionID - else if SnipObj is TCategory then - Result := (SnipObj as TCategory).CollectionID else Result := TCollectionID.CreateNull end; diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index e231822f6..1710e1e02 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -278,9 +278,6 @@ TCategoryPageHTML = class sealed(TSnippetListPageHTML) /// The snippet is to be displayed if it is in the category being /// displayed. function IsSnippetRequired(const Snippet: TSnippet): Boolean; override; - /// Returns name of CSS class to be used for page heading. - /// - function GetH1ClassName: string; override; /// Returns narrative to be used at top of any page that displays /// a snippet list. function GetNarrative: string; override; @@ -665,14 +662,6 @@ function TCategoryPageHTML.GetEmptyListNote: string; Result := sNote; end; -function TCategoryPageHTML.GetH1ClassName: string; -begin - if (View as ICategoryView).Category.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then - Result := 'userdb' - else - Result := inherited GetH1ClassName; -end; - function TCategoryPageHTML.GetNarrative: string; resourcestring sNarrative = 'List of selected snippets in this category.'; diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index 35070366e..8d2bc6bbd 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -216,7 +216,6 @@ procedure TRTFCategoryDoc.OutputCategoryHeading(const Category: TCategory); fBuilder.SetFont(MainFontName); fBuilder.SetFontSize(HeadingFontSize); fBuilder.SetFontStyle([fsBold]); - SetColour(Preferences.GetDBHeadingColour(Category.CollectionID)); fBuilder.AddText(Category.Description); fBuilder.EndPara; fBuilder.EndGroup; From 95ec483812971f81cfb43d221b6e35ba55060c75 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 10 Nov 2024 11:08:44 +0000 Subject: [PATCH 061/222] Permit any category to be renamed or deleted Implemented new rules that (1) any non-empty category can be deleted and (2) Any category can be renamed at any time. Changed FmDeleteCategoryDlg in light of these changes. The dialogue box is now only given empty categories to display, so checks for non-empty categories were removed along with the label used to display warning of non-empty categories. Lifted restriction in database object on editing a non-user-defined cateogory. --- Src/DB.UCategory.pas | 6 ++-- Src/DB.UMain.pas | 2 -- Src/FmDeleteCategoryDlg.dfm | 12 +------- Src/FmDeleteCategoryDlg.pas | 45 ++++++++---------------------- Src/UUserDBMgr.pas | 55 ++++++++++++------------------------- 5 files changed, 31 insertions(+), 89 deletions(-) diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index 11415a8f6..171c58acd 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -193,7 +193,7 @@ implementation // Delphi SysUtils, // Project - UReservedCategories, UStrUtils; + UStrUtils; { TCategory } @@ -203,9 +203,7 @@ function TCategory.CanDelete: Boolean; @return True if deletion allowed, False if not. } begin - Result := (fCollectionID <> TCollectionID.__TMP__MainDBCollectionID) - and fSnippets.IsEmpty - and not TReservedCategories.IsReserved(Self); + Result := fSnippets.IsEmpty; end; function TCategory.CompareDescriptionTo(const Cat: TCategory): Integer; diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index ca030ef0b..cce30a1a4 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -934,8 +934,6 @@ function TDatabase.GetEditableCategoryInfo( @return Required data. } begin - Assert(not Assigned(Category) or (Category.CollectionID <> TCollectionID.__TMP__MainDBCollectionID), - ClassName + '.GetEditableCategoryInfo: Category is not user-defined'); if Assigned(Category) then Result := (Category as TCategoryEx).GetEditData else diff --git a/Src/FmDeleteCategoryDlg.dfm b/Src/FmDeleteCategoryDlg.dfm index 48c13e494..67f1b748f 100644 --- a/Src/FmDeleteCategoryDlg.dfm +++ b/Src/FmDeleteCategoryDlg.dfm @@ -1,15 +1,9 @@ inherited DeleteCategoryDlg: TDeleteCategoryDlg Caption = 'Delete Category' + ExplicitHeight = 375 PixelsPerInch = 96 TextHeight = 13 inherited pnlBody: TPanel - object lblErrorMsg: TLabel - Left = 0 - Top = 144 - Width = 156 - Height = 13 - Caption = 'Non-empty category: can'#39't delete' - end inline frmCategories: TCategoryListFrame Left = 0 Top = 0 @@ -18,10 +12,6 @@ inherited DeleteCategoryDlg: TDeleteCategoryDlg TabOrder = 0 TabStop = True ExplicitHeight = 138 - inherited lblCategories: TLabel - Width = 60 - ExplicitWidth = 60 - end inherited lbCategories: TListBox Height = 108 ExplicitHeight = 108 diff --git a/Src/FmDeleteCategoryDlg.pas b/Src/FmDeleteCategoryDlg.pas index 3f6a65b0f..0f3677660 100644 --- a/Src/FmDeleteCategoryDlg.pas +++ b/Src/FmDeleteCategoryDlg.pas @@ -5,8 +5,7 @@ * * Copyright (C) 2009-2023, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a dialogue box that permits user to select and delete a user - * defined category. + * Implements a dialogue box that permits user to select and delete a category. } @@ -24,13 +23,11 @@ interface type - { - TDeleteCategoryDlg: - Dialog box that permits user to select and delete a user-defined category. - } + + /// Dialogue box that permits the user to select and delete a + /// category. TDeleteCategoryDlg = class(TCategoryEditDlg, INoPublicConstruct) frmCategories: TCategoryListFrame; - lblErrorMsg: TLabel; procedure btnOKClick(Sender: TObject); strict private fCategories: TCategoryList; // List of categories that can be deleted @@ -39,14 +36,12 @@ TDeleteCategoryDlg = class(TCategoryEditDlg, INoPublicConstruct) according to changes. @param Sender [in] Not used. } - procedure UpdateErrorLabelState; - {Shows or hides error state label depending of whether selected category - can be deleted. - } + + /// Deletes a category from the database. + /// TCategory [in] Category to be deleted. + /// The category must be empty. procedure DeleteCategory(const Cat: TCategory); - {Deletes category and all its snippets from database. - @param Cat [in] Category to be deleted. - } + strict protected procedure ConfigForm; override; {Configures form. Populates controls and supplies event handler to frame. @@ -86,8 +81,6 @@ procedure TDeleteCategoryDlg.ArrangeForm; } begin frmCategories.ArrangeFrame; - TCtrlArranger.SetLabelHeight(lblErrorMsg); - lblErrorMsg.Top := TCtrlArranger.BottomOf(frmCategories, 8); inherited; end; @@ -117,16 +110,11 @@ procedure TDeleteCategoryDlg.ConfigForm; frmCategories.OnChange := SelectionChangeHandler; frmCategories.Prompt := sPrompt; frmCategories.SetCategories(fCategories); - TFontHelper.SetDefaultFont(lblErrorMsg.Font); - lblErrorMsg.Font.Color := clWarningText; - lblErrorMsg.Visible := False; end; procedure TDeleteCategoryDlg.DeleteCategory(const Cat: TCategory); - {Deletes category and all its snippets from database. - @param Cat [in] Category to be deleted. - } begin + Assert(Cat.CanDelete, ClassName + '.DeleteCategory: Cat can''t be deleted'); (Database as IDatabaseEdit).DeleteCategory(Cat); end; @@ -156,18 +144,6 @@ procedure TDeleteCategoryDlg.SelectionChangeHandler(Sender: TObject); } begin UpdateOKBtn; - UpdateErrorLabelState; -end; - -procedure TDeleteCategoryDlg.UpdateErrorLabelState; - {Shows or hides error state label depending of whether selected category can - be deleted. - } -begin - if not frmCategories.IsValidEntry then - lblErrorMsg.Visible := False - else - lblErrorMsg.Visible := not frmCategories.SelectedCategory.CanDelete; end; procedure TDeleteCategoryDlg.UpdateOKBtn; @@ -176,6 +152,7 @@ procedure TDeleteCategoryDlg.UpdateOKBtn; } begin btnOK.Enabled := frmCategories.IsValidEntry + // following check is potentially redundant, but leaving in for safety and frmCategories.SelectedCategory.CanDelete; end; diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 04b8d51b4..743f027b2 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2008-2022, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a static class that manages user's interaction with user database. + * Implements a static class that manages user's interaction with the database. } @@ -42,13 +42,6 @@ TUserDBMgr = class(TNoConstructObject) /// Boolean [in/out] Set to True to permit dialogue /// to close or False to inhibit closure. class procedure CanSaveDialogClose(Sender: TObject; var CanClose: Boolean); - /// Creates a list of user defined categories. - /// Boolean [in] Flag indicating whether list - /// should include special, non-deletable, categories. - /// Required category list. - /// Caller must free the returned object. - class function CreateUserCatList( - const IncludeSpecial: Boolean): TCategoryList; public /// Enables user to adds a new user defined snippet to the /// database using the snippets editor. @@ -117,7 +110,7 @@ implementation FmDeleteUserDBDlg, FmWaitDlg, UAppInfo, UConsts, UExceptions, UIStringList, UMessageBox, UOpenDialogEx, - UOpenDialogHelper, UReservedCategories, USaveDialogEx, USnippetIDs, + UOpenDialogHelper, USaveDialogEx, USnippetIDs, UUserDBBackup, UWaitForThreadUI; type @@ -272,14 +265,12 @@ class procedure TUserDBMgr.BackupDatabase(ParentCtrl: TComponent); class function TUserDBMgr.CanDeleteACategory: Boolean; var - CatList: TCategoryList; // list of user deletable categories + Cat: TCategory; begin - CatList := CreateUserCatList(False); // builds list of deletable user cats - try - Result := CatList.Count > 0; - finally - CatList.Free; - end; + Result := False; + for Cat in Database.Categories do + if Cat.CanDelete then + Exit(True); end; class function TUserDBMgr.CanDuplicate(ViewItem: IView): Boolean; @@ -321,15 +312,8 @@ class procedure TUserDBMgr.CanOpenDialogClose(Sender: TObject; end; class function TUserDBMgr.CanRenameACategory: Boolean; -var - CatList: TCategoryList; // list of user renamable categories begin - CatList := CreateUserCatList(True); // build list of all user categories - try - Result := CatList.Count > 0; - finally - CatList.Free; - end; + Result := True; end; class function TUserDBMgr.CanSave: Boolean; @@ -355,24 +339,16 @@ class procedure TUserDBMgr.CanSaveDialogClose(Sender: TObject; ); end; -class function TUserDBMgr.CreateUserCatList( - const IncludeSpecial: Boolean): TCategoryList; -var - Cat: TCategory; // references each category in snippets database -begin - Result := TCategoryList.Create; - for Cat in Database.Categories do - if (Cat.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) and - (IncludeSpecial or not TReservedCategories.IsReserved(Cat)) then - Result.Add(Cat); -end; - class procedure TUserDBMgr.DeleteACategory; var CatList: TCategoryList; // list of deletable categories + Cat: TCategory; begin - CatList := CreateUserCatList(False); + CatList := TCategoryList.Create; try + for Cat in Database.Categories do + if Cat.CanDelete then + CatList.Add(Cat); // all work takes place in dialog box TDeleteCategoryDlg.Execute(nil, CatList) finally @@ -485,10 +461,13 @@ class procedure TUserDBMgr.MoveDatabase; class procedure TUserDBMgr.RenameACategory; var + Cat: TCategory; CatList: TCategoryList; // list of user defined categories begin - CatList := CreateUserCatList(True); + CatList := TCategoryList.Create; try + for Cat in Database.Categories do + CatList.Add(Cat); // all work takes place in dialog box TRenameCategoryDlg.Execute(nil, CatList) finally From d0484ce00d4c181ba04259cbf47d2a62c2dc025c Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 10 Nov 2024 14:42:18 +0000 Subject: [PATCH 062/222] Make code importers ensure their categories exist Since it is no longer guaranteed that the former "required" categories used by the TCodeImporter and TSWAGImporter classes will automatically exist both those classes were altered to create those categories if they are not aleady defined. --- Src/SWAG.UImporter.pas | 37 ++++++++++++++++++++++++-------- Src/UCodeImportExport.pas | 44 +++++++++++++++++++++++++++++---------- 2 files changed, 61 insertions(+), 20 deletions(-) diff --git a/Src/SWAG.UImporter.pas b/Src/SWAG.UImporter.pas index 23f359efb..89cf2cdd4 100644 --- a/Src/SWAG.UImporter.pas +++ b/Src/SWAG.UImporter.pas @@ -21,6 +21,7 @@ interface Generics.Collections, // Project ActiveText.UMain, + DB.UCategory, DB.UCollections, DB.USnippet, SWAG.UCommon; @@ -42,6 +43,11 @@ TSWAGImporter = class(TObject) /// TProgressCallback = reference to procedure ( const SWAGPacket: TSWAGPacket); + const + {TODO -cVault: Let user select or create a category rather than imposing + this one} + /// ID of category used to import snippets. + SWAGCatID = '_swag_'; var /// List of SWAG packets to be imported. fImportList: TList; @@ -60,6 +66,8 @@ TSWAGImporter = class(TObject) /// database as a CodeSnip format snippet. procedure ImportPacketAsSnippet(const ACollectionID: TCollectionID; const SWAGPacket: TSWAGPacket); + + class procedure EnsureSWAGCategoryExists; public /// Constructs new object instance. constructor Create; @@ -93,10 +101,8 @@ implementation // Delphi SysUtils, // Project - DB.UCategory, DB.UMain, DB.USnippetKind, - UReservedCategories, USnippetValidator; @@ -135,7 +141,7 @@ function TSWAGImporter.BuildSnippetInfo(const SWAGPacket: TSWAGPacket): begin Result.Init; Result.Props.Kind := skFreeform; - Result.Props.Cat := TReservedCategories.SWAGCatID; + Result.Props.Cat := SWAGCatID; Result.Props.Desc := BuildDescription; Result.Props.SourceCode := SWAGPacket.SourceCode; Result.Props.HiliteSource := not SWAGPacket.IsDocument; @@ -148,6 +154,7 @@ constructor TSWAGImporter.Create; begin inherited Create; fImportList := TList.Create; + EnsureSWAGCategoryExists; end; destructor TSWAGImporter.Destroy; @@ -156,6 +163,22 @@ destructor TSWAGImporter.Destroy; inherited; end; +class procedure TSWAGImporter.EnsureSWAGCategoryExists; +resourcestring + SWAGCatDesc = 'SWAG Imports'; +var + SWAGCatData: TCategoryData; + SWAGCat: TCategory; +begin + SWAGCat := Database.Categories.Find(SWAGCatID); + if not Assigned(SWAGCat) then + begin + SWAGCatData.Init; + SWAGCatData.Desc := SWAGCatDesc; + (Database as IDatabaseEdit).AddCategory(SWAGCatID, SWAGCatData); + end; +end; + function TSWAGImporter.ExtraBoilerplate: IActiveText; procedure AddText(const Text: string); @@ -270,13 +293,9 @@ procedure TSWAGImporter.Reset; end; class function TSWAGImporter.SWAGCategoryDesc: string; -var - Cat: TCategory; // reserved SWAG category in code snippets database begin - Cat := Database.Categories.Find(TReservedCategories.SWAGCatID); - Assert(Assigned(Cat), - ClassName + '.SWAGCategoryDesc: Can''t find SWAG category'); - Result := Cat.Description; + EnsureSWAGCategoryExists; + Result := Database.Categories.Find(SWAGCatID).Description; end; end. diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index 6940a699d..18446c944 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -5,8 +5,7 @@ * * Copyright (C) 2008-2023, Peter Johnson (gravatar.com/delphidabbler). * - * Implements classes that can import and export user defined snippets from and - * to XML. + * Implements classes that can import and export snippets from and to XML. } @@ -22,6 +21,7 @@ interface Classes, XMLIntf, // Project + DB.UCategory, DB.USnippet, UBaseObjects, UEncodings, @@ -52,10 +52,16 @@ TSnippetInfo = record /// Imports code snippets from XML. TCodeImporter = class(TNoPublicConstructObject) strict private - /// Version of file being imported. - fVersion: Integer; - /// List of snippets read from XML. - fSnippetInfo: TSnippetInfoList; + const + {TODO -cVault: Let user select or create a category rather than imposing + this one} + /// ID of category used to import snippets. + ImportCatID = 'imports'; + var + /// Version of file being imported. + fVersion: Integer; + /// List of snippets read from XML. + fSnippetInfo: TSnippetInfoList; /// Extended XML document object. fXMLDoc: IXMLDocumentEx; /// Retrieves a list of all snippet nodes from XML document. @@ -69,9 +75,13 @@ TCodeImporter = class(TNoPublicConstructObject) /// /// ECodeImporter raised if XML is not valid. function ValidateDoc: Integer; + /// Checks if the special import category exists and creates it if + /// not. + class procedure EnsureImportCategoryExists; /// Constructs and initialises object ready to perform import. /// constructor InternalCreate; + public /// Destroys object. destructor Destroy; override; @@ -169,7 +179,6 @@ implementation DB.UMain, DB.USnippetKind, UAppInfo, - UReservedCategories, USnippetExtraHelper, USnippetIDs, UStructs, @@ -345,6 +354,20 @@ destructor TCodeImporter.Destroy; inherited; end; +class procedure TCodeImporter.EnsureImportCategoryExists; +resourcestring + ImportCatDesc = 'Imported Snippets'; +var + ImportCatData: TCategoryData; +begin + if not Assigned(Database.Categories.Find(ImportCatID)) then + begin + ImportCatData.Init; + ImportCatData.Desc := ImportCatDesc; + (Database as IDatabaseEdit).AddCategory(ImportCatID, ImportCatData); + end; +end; + procedure TCodeImporter.Execute(const Data: TBytes); /// Reads list of units from under SnippetNode into Units list. @@ -372,7 +395,7 @@ procedure TCodeImporter.Execute(const Data: TBytes); Depends.Clear; for SnippetName in SnippetNames do // Note: in building snippet ID list we assume each snippet is from the - // standard user collection. It may not be, but there is no way of telling + // default collection. It may not be, but there is no way of telling // from XML. Depends.Add(TSnippetID.Create(SnippetName, TCollectionID.__TMP__UserDBCollectionID)); end; @@ -422,7 +445,7 @@ procedure TCodeImporter.Execute(const Data: TBytes); fSnippetInfo[Idx].Key := SnippetNode.Attributes[cSnippetNameAttr]; fSnippetInfo[Idx].Data := (Database as IDatabaseEdit).GetEditableSnippetInfo; - fSnippetInfo[Idx].Data.Props.Cat := TReservedCategories.ImportsCatID; + fSnippetInfo[Idx].Data.Props.Cat := ImportCatID; fSnippetInfo[Idx].Data.Props.Desc := GetDescription(SnippetNode); fSnippetInfo[Idx].Data.Props.DisplayName := TXMLDocHelper.GetSubTagText( fXMLDoc, SnippetNode, cDisplayNameNode @@ -511,11 +534,10 @@ class procedure TCodeImporter.ImportData(out SnippetInfo: TSnippetInfoList; constructor TCodeImporter.InternalCreate; begin inherited InternalCreate; - // Set up XML document that will read data OleInitialize(nil); fXMLDoc := TXMLDocHelper.CreateXMLDoc; - // Initialise fields that receive imported data SetLength(fSnippetInfo, 0); + EnsureImportCategoryExists; end; function TCodeImporter.ValidateDoc: Integer; From cc146bf94fc8718d4e307dcedad15d6c745d9cdb Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 10 Nov 2024 14:51:33 +0000 Subject: [PATCH 063/222] Ensure a default category is always created A new TCategoryEx.CreateDefault method was added that creates a default category with ID '__default__' and description "My Snippets". TDatabase.Load now call the above method to create a default category if one with the same ID was not loaded. This new category can be deleted, but it will always be recreated. The category can, though, be renamed. Updated FmSnippetsEditorDlg to use the new category as the default selection in the snippets editor dialogue box. --- Src/DB.UCategory.pas | 22 ++++++++++++++++++++++ Src/DB.UMain.pas | 4 ++++ Src/FmSnippetsEditorDlg.pas | 5 +++-- 3 files changed, 29 insertions(+), 2 deletions(-) diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index 171c58acd..000565173 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -62,6 +62,10 @@ TCategory = class(TObject) are equal or +1 if this category's ID is greater than Cat's. } public + const + /// ID of default category. + DefaultID = '__default__'; + /// Object constructor. Sets up category object with given /// property values. /// CatID [in] Category ID. @@ -112,6 +116,10 @@ TCategory = class(TObject) } TCategoryEx = class(TCategory) public + /// Creates the default category with its default description. + /// + class function CreateDefault: TCategory; + function GetEditData: TCategoryData; {Gets details of all editable data of category. @return Required editable data. @@ -235,6 +243,9 @@ function TCategory.CompareIDTo(const Cat: TCategory): Integer; constructor TCategory.Create(const CatID: string; const ACollectionID: TCollectionID; const Data: TCategoryData); begin + {TODO -cVault: Add a simpler contructor that takes only the category ID and + description and creates does all the convoluted TCategoryData setting! + } Assert(ClassType <> TCategory, ClassName + '.Create: must only be called from descendants.'); inherited Create; @@ -271,6 +282,17 @@ procedure TCategory.SetCollectionID(const AValue: TCollectionID); { TCategoryEx } +class function TCategoryEx.CreateDefault: TCategory; +var + Data: TCategoryData; +resourcestring + sDefCatDesc = 'My Snippets'; +begin + Data.Init; + Data.Desc := sDefCatDesc; + Result := Create(DefaultID, TCollectionID.__TMP__UserDBCollectionID, Data); +end; + function TCategoryEx.GetEditData: TCategoryData; {Gets details of all editable data of category. @return Required editable data. diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index cce30a1a4..14851782e 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -1121,6 +1121,10 @@ procedure TDatabase.Load; Loader.Load(fSnippets, fCategories, Factory); end; + // Ensure that the default category is present, if it's not already loaded + if not Assigned(fCategories.Find(TCategory.DefaultID)) then + fCategories.Add(TCategoryEx.CreateDefault); + fUpdated := False; except // If an exception occurs clear the database diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 633a7fab0..9bd91f635 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -270,9 +270,10 @@ implementation // Delphi Windows {for inlining}, Graphics, // Project + DB.UCategory, DB.UMain, DB.USnippetKind, FmDependenciesDlg, IntfCommon, UColours, UConsts, UCSSUtils, UCtrlArranger, UExceptions, UFontHelper, UIStringList, - UReservedCategories, USnippetExtraHelper, USnippetValidator, UMessageBox, + USnippetExtraHelper, USnippetValidator, UMessageBox, USnippetIDs, UStructs, UStrUtils, UTestUnitDlgMgr, UThemesEx, UUtils; @@ -850,7 +851,7 @@ procedure TSnippetsEditorDlg.InitControls; frmDescription.DefaultEditMode := emPlainText; frmDescription.Clear; edDisplayName.Clear; - cbCategories.ItemIndex := fCatList.IndexOf(TReservedCategories.UserCatID); + cbCategories.ItemIndex := fCatList.IndexOf(TCategory.DefaultID); if cbCategories.ItemIndex = -1 then cbCategories.ItemIndex := 0; cbKind.ItemIndex := fSnipKindList.IndexOf(skFreeform); From 5c5ab00b5553e61ee8544b4dffaf6563891bd7fb Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 10 Nov 2024 15:01:16 +0000 Subject: [PATCH 064/222] No longer forcibly create reserved categories The v4 "native" loader used to ensure that all the "reserved" categories defined in UReservedCategories were created if they weren't stored in the "user database". This no longer happens. --- Src/DB.UDatabaseIO.pas | 25 +------------------------ 1 file changed, 1 insertion(+), 24 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 16a02c42c..df4fc38d5 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -107,7 +107,6 @@ implementation UConsts, UFolderBackup, UIStringList, - UReservedCategories, USnippetIDs; @@ -169,7 +168,7 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) {Returns heading to use in error messages. Should identify the database. @return Required heading. } - procedure LoadCategories; virtual; + procedure LoadCategories; {Loads all categories from storage. } procedure CreateCategory(const CatID: string; @@ -248,9 +247,6 @@ TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) {Returns heading to use in error messages. Identifies main database. @return Required heading. } - procedure LoadCategories; override; - {Loads all categories from storage and adds user category if not present. - } end; /// Base for classes that save a collection to storage. @@ -687,25 +683,6 @@ function TNativeV4FormatLoader.FindSnippet(const SnippetKey: string; Result := SnipList.Find(SnippetKey, TCollectionID.__TMP__MainDBCollectionID); end; -procedure TNativeV4FormatLoader.LoadCategories; - {Loads all categories from storage and adds user and imports categories if not - present. - } -var - ResCatIdx: Integer; // loops thru all reserved categories - ResCatInfo: TReservedCategoryInfo; // info about a reserved category -begin - // Get all categories from storage - inherited; - // Add default user-defined categories if not present - for ResCatIdx := 0 to Pred(TReservedCategories.Count) do - begin - ResCatInfo := TReservedCategories.Info(ResCatIdx); - if Categories.Find(ResCatInfo.Name) = nil then - CreateCategory(ResCatInfo.Name, ResCatInfo.Data); - end; -end; - { TFormatSaver } constructor TFormatSaver.Create(const ACollection: TCollection); From e217d4cb1a7c55bf46a99d0083fa36ac5699f988 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 10 Nov 2024 15:05:40 +0000 Subject: [PATCH 065/222] Remove UReservedCategories unit from project This unit is now redundant and has been removed. --- Src/CodeSnip.dpr | 1 - Src/CodeSnip.dproj | 1 - Src/UReservedCategories.pas | 166 ------------------------------------ 3 files changed, 168 deletions(-) delete mode 100644 Src/UReservedCategories.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 98cb69a47..02ba3d324 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -297,7 +297,6 @@ uses UProtocols in 'UProtocols.pas', UQuery in 'UQuery.pas', UREMLDataIO in 'UREMLDataIO.pas', - UReservedCategories in 'UReservedCategories.pas', UResourceUtils in 'UResourceUtils.pas', URTFBuilder in 'URTFBuilder.pas', URTFCategoryDoc in 'URTFCategoryDoc.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 1141453ca..48eb74367 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -499,7 +499,6 @@ - diff --git a/Src/UReservedCategories.pas b/Src/UReservedCategories.pas deleted file mode 100644 index dc8db26e4..000000000 --- a/Src/UReservedCategories.pas +++ /dev/null @@ -1,166 +0,0 @@ -{ - * This Source Code Form is subject to the terms of the Mozilla Public License, - * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at https://mozilla.org/MPL/2.0/ - * - * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). - * - * Implements a static class that provides information about reserved user - * defined categories. -} - - -unit UReservedCategories; - - -interface - - -uses - // Project - DB.UCategory, UBaseObjects; - - -type - - { - TReservedCategoryInfo: - Record that fully describes a category, i.e. contains all the required data. - } - TReservedCategoryInfo = record - Name: string; // Name (unique id) of category - Data: TCategoryData; // Category's properties - procedure Assign(const Src: TReservedCategoryInfo); - {Sets this record's fields to be same as another TReservedCategoryInfo - record. - @param Src [in] Record containing fields to be copied. - } - procedure Init; - {Initialises record to nul values. - } - end; - - { - TReservedCategories: - Static class that provides information about reserved user defined - categories. - } - TReservedCategories = class(TNoConstructObject) - strict private - class function IsReservedName(const CatID: string): Boolean; - {Checks if a category name is the id of a reserved category. - @param CatID [in] ID to be checked. - @return True if category is reserved, False if not. - } - public - const UserCatID = 'user'; // default category for user snippets - const ImportsCatID = 'imports'; // category for imported user snippets - const SWAGCatID = '_swag_'; // category for imported SWAG snippets - class function IsReserved(const Cat: TCategory): Boolean; - {Checks if a category is reserved. - @param Cat [in] Category to be checked. - @return True if category is reserved, False if not. - } - class function Info(Idx: Integer): TReservedCategoryInfo; - {Gets information about a reserved category. - @param Idx [in] Index of required category. - @return Record containing information about category. - } - class function Count: Integer; - {Gets number of reserved categories. - @return Number of reserved categories. - } - end; - - -implementation - - -uses - // Delphi - Windows {for inlining}, - // Project - UStrUtils; - - -resourcestring - // Default reserved category descriptions - sUserDesc = 'User Defined Snippets'; - sImportsDesc = 'Imported Snippets'; - sSWAGDesc = 'SWAG Imports'; - -const - // Maps reserved category ids onto info that describes category - cReservedCats: array[0..2] of TReservedCategoryInfo = ( - (Name: TReservedCategories.UserCatID; Data: (Desc: sUserDesc)), - (Name: TReservedCategories.ImportsCatID; Data: (Desc: sImportsDesc)), - (Name: TReservedCategories.SWAGCatID; Data: (Desc: sSWAGDesc)) - ); - -{ TReservedCategories } - -class function TReservedCategories.Count: Integer; - {Gets number of reserved categories. - @return Number of reserved categories. - } -begin - Result := Length(cReservedCats); -end; - -class function TReservedCategories.Info(Idx: Integer): TReservedCategoryInfo; - {Gets information about a reserved category. - @param Idx [in] Index of required category. - @return Record containing information about category. - } -begin - Result.Assign(cReservedCats[Idx]); -end; - -class function TReservedCategories.IsReserved(const Cat: TCategory): Boolean; - {Checks if a category is reserved. - @param Cat [in] Category to be checked. - @return True if category is reserved, False if not. - } -begin - Result := IsReservedName(Cat.ID); -end; - -class function TReservedCategories.IsReservedName( - const CatID: string): Boolean; - {Checks if a category name is the id of a reserved category. - @param CatID [in] ID to be checked. - @return True if category is reserved, False if not. - } -var - Idx: Integer; // loops thru all reserved categories -begin - Result := False; - for Idx := 0 to Pred(Count) do - if StrSameText(CatID, Info(Idx).Name) then - begin - Result := True; - Exit; - end; -end; - -{ TReservedCategoryInfo } - -procedure TReservedCategoryInfo.Assign(const Src: TReservedCategoryInfo); - {Sets this record's fields to be same as another TReservedCategoryInfo record. - @param Src [in] Record containing fields to be copied. - } -begin - Name := Src.Name; - Data.Assign(Src.Data); -end; - -procedure TReservedCategoryInfo.Init; - {Initialises record to nul values. - } -begin - Name := ''; - Data.Init; -end; - -end. - From c9ebccf203e5b7c67ec561e277428a639ebb19c4 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 11 Nov 2024 17:48:56 +0000 Subject: [PATCH 066/222] Fix bug in DBIO.UIniData If the "main" collection is not loaded first then any categories that have already been loaded that it doesn't recognise would cause a crash when the loader tried to open a non-existent category .ini fle. Added an if statement to check for the existance of the required .ini file before trying to open it. --- Src/DBIO.UIniData.pas | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/Src/DBIO.UIniData.pas b/Src/DBIO.UIniData.pas index d314f8a61..e54c5c20a 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DBIO.UIniData.pas @@ -514,16 +514,24 @@ procedure TIniDataReader.GetCatProps(const CatID: string; function TIniDataReader.GetCatSnippets(const CatID: string): IStringList; var + CatIniFile: string; CatIni: TCustomIniFile; // accesses .ini file associated with category SnipList: TStringList; // list of snippets in category begin + Result := TIStringList.Create; try // Snippet names are names of sections in category's .ini file + CatIniFile := CatToCatIni(CatID); + if not TFile.Exists(CatIniFile) then + // This is not an error since it is possible that a category exists in + // another collection and loader will request info from that collection + // too. + Exit; CatIni := fIniCache.GetIniFile(CatToCatIni(CatID)); SnipList := TStringList.Create; try CatIni.ReadSections(SnipList); - Result := TIStringList.Create(SnipList); + Result.Add(SnipList); finally SnipList.Free; end; From fad930cfd8b6ea2382358f1ca339854b00e433ac Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 11 Nov 2024 20:21:12 +0000 Subject: [PATCH 067/222] Add new C escape char routines to UStrUtils New StrCEscapeStr and StrCUnEscapeStr routines escape and un-escape specified characters in a string with C-style escape character sequences, respectively. --- Src/UStrUtils.pas | 144 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 144 insertions(+) diff --git a/Src/UStrUtils.pas b/Src/UStrUtils.pas index 4e0e29584..b56d8005c 100644 --- a/Src/UStrUtils.pas +++ b/Src/UStrUtils.pas @@ -289,6 +289,45 @@ function StrOfChar(const Ch: Char; const Count: Word): string; /// If Count is zero then an empty string is returned. function StrOfSpaces(const Count: Word): string; +/// Escapes specified characters in a string using C format escape +/// sequences. +/// string [in] String to be escaped. +/// string [in] String of characters to be +/// used in the escape sequence. +/// string [in] String of characters to be +/// escaped. +/// string. String with all characters from +/// EscapableChars replaced by a backslash followed by the character at +/// the same index in EscapeChars +/// +/// NOTE: The backslash symbol is always escaped regardless of whether it +/// is included in EscapeChars and EscapableChars. +/// EscapeChars and EscapableChars must be the same +/// length. +/// +function StrCEscapeStr(const S: string; EscapeChars, EscapableChars: string): + string; + +/// Un-escapes a string containing C format escape sequences. +/// +/// string [in] String to be un-escaped. +/// string [in] String of characters used in +/// the escape sequences. +/// string [in] String of characters to be +/// used to replace the escape sequences. +/// string. String with all escape sequences comprising a +/// backslash followed by a character from EscapeChars replaced by a +/// corresponding character from EscapableChars. +/// +/// NOTE: The backslash symbol is always unescaped regardless of whether +/// it is included in EscapeChars and EscapableChars. +/// EscapeChars and EscapableChars must be the same +/// length. +/// +function StrCUnEscapeStr(const S: string; EscapeChars, EscapableChars: string): + string; + + implementation @@ -944,5 +983,110 @@ function StrOfSpaces(const Count: Word): string; Result := StrOfChar(' ', Count); end; +function StrCEscapeStr(const S: string; EscapeChars, EscapableChars: string): + string; +const + cEscChar = '\'; // the C escape character +var + EscCount: Integer; // count of escaped characters in string + Idx: Integer; // loops thru string + PRes: PChar; // points to chars in result string + EscCharPos: Integer; // position of esc chars in EscapeChars & EscapableChars +begin + Assert(Length(EscapeChars) = Length(EscapableChars), + 'StrCEscapeStr: EscapeChars & EscapableChars are different lengths'); + // Ensure '\' get escaped + if StrPos(cEscChar, EscapeChars) = 0 then + EscapeChars := cEscChar + EscapeChars; + if StrPos(cEscChar, EscapableChars) = 0 then + EscapableChars := cEscChar + EscapableChars; + // Check for empty string and treat specially + // (empty string crashes main code) + if S = '' then + begin + Result := ''; + Exit; + end; + // Count escapable characters in string + EscCount := 0; + for Idx := 1 to Length(S) do + begin + if SysUtils.AnsiPos(S[Idx], EscapableChars) > 0 then + Inc(EscCount); + end; + // Set size of result string and get pointer to it + SetLength(Result, Length(S) + EscCount); + PRes := PChar(Result); + // Replace escapable chars with the escaped version + for Idx := 1 to Length(S) do + begin + EscCharPos := SysUtils.AnsiPos(S[Idx], EscapableChars); + if EscCharPos > 0 then + begin + PRes^ := cEscChar; + Inc(PRes); + PRes^ := EscapeChars[EscCharPos]; + end + else + PRes^ := S[Idx]; + Inc(PRes); + end; +end; + +function StrCUnEscapeStr(const S: string; EscapeChars, EscapableChars: string): + string; +const + cEscChar = '\'; // the C escape character +var + EscCount: Integer; // counts escaped characters in string + Idx: Integer; // loops thru source string + PRes: PChar; // points to chars in result string + EscCharPos: Integer; // position of esc chars in EscapeChars & EscapableChars +begin + Assert(Length(EscapeChars) = Length(EscapableChars), + 'StrCUnEscapeStr: EscapeChars & EscapableChars are different lengths'); + // Ensure '\' get unescaped + if StrPos(cEscChar, EscapeChars) = 0 then + EscapeChars := cEscChar + EscapeChars; + if StrPos(cEscChar, EscapableChars) = 0 then + EscapableChars := cEscChar + EscapableChars; + // Count escape sequences + EscCount := 0; + Idx := 1; + while Idx < Length(S) do // don't count '\' if last character + begin + if S[Idx] = cEscChar then + begin + Inc(EscCount); + Inc(Idx); + end; + Inc(Idx); + end; + // Set length of result string and get pointer to it + SetLength(Result, Length(S) - EscCount); + PRes := PChar(Result); + // Replace escaped chars with literal ones + Idx := 1; + while Idx <= Length(S) do + begin + // check for escape char (unless last char when treat literally) + if (S[Idx] = cEscChar) and (Idx <> Length(S)) then + begin + // we have an escape char + Inc(Idx); // skip over '\' + // get index of escaped char (0 if not valid) + EscCharPos := SysUtils.AnsiPos(S[Idx], EscapeChars); + if EscCharPos > 0 then + PRes^ := EscapableChars[EscCharPos] + else + PRes^ := S[Idx]; // invalid escape char: copy literally + end + else + PRes^ := S[Idx]; + Inc(Idx); + Inc(PRes); + end; +end; + end. From daaf730b8aa005ceaea8bc1c27a4d1cba1272759 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 11 Nov 2024 19:51:31 +0000 Subject: [PATCH 068/222] Add UTabSeparatedFileIO unit to project This defines classes that read and write tab separated values from/to UTF8 text files. --- Src/CodeSnip.dpr | 3 +- Src/CodeSnip.dproj | 1 + Src/UTabSeparatedFileIO.pas | 250 ++++++++++++++++++++++++++++++++++++ 3 files changed, 253 insertions(+), 1 deletion(-) create mode 100644 Src/UTabSeparatedFileIO.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 02ba3d324..f86338372 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -374,7 +374,8 @@ uses FmRegisterCompilersDlg in 'FmRegisterCompilersDlg.pas' {RegisterCompilersDlg}, ClassHelpers.UGraphics in 'ClassHelpers.UGraphics.pas', ClassHelpers.UActions in 'ClassHelpers.UActions.pas', - DB.UCollections in 'DB.UCollections.pas'; + DB.UCollections in 'DB.UCollections.pas', + UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas'; // Include resources {$Resource ExternalObj.tlb} // Type library file diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 48eb74367..ba059b80d 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -581,6 +581,7 @@ + Base diff --git a/Src/UTabSeparatedFileIO.pas b/Src/UTabSeparatedFileIO.pas new file mode 100644 index 000000000..0c411c570 --- /dev/null +++ b/Src/UTabSeparatedFileIO.pas @@ -0,0 +1,250 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). + * + * Classes that can read and write UTF8 files containing a watermark line + * followed by lines of tabbed separated values. +} + +unit UTabSeparatedFileIO; + +interface + +uses + // Delphi + SysUtils, + // Project + UExceptions, + UIStringList; + +type + + /// Class that writes UTF8 files beginning with a watermark line + /// followed by and blank line then lines of tabbed separated values. + /// + TTabSeparatedFileWriter = class(TObject) + strict private + var + fFileName: string; + fBuilder: TStringBuilder; + /// Convert any characters in AValue that can't appear in a + /// field into C-style escape sequences. + function Escape(const AValue: string): string; + /// Outputs the watermark AWatermark on a line on its own. + /// + procedure WriteWatermark(const AWaterMark: string); + public + /// Creates object to write file AFileName with watermark + /// AWatermark. + constructor Create(const AFileName: string; const AWatermark: string); + /// Object destructor. + destructor Destroy; override; + /// Writes data to file just before the object is destroyed. + /// + procedure BeforeDestruction; override; + /// Writes a line of data with tabbed separated fields. + /// array of string [in] Fields to be written. + /// + procedure WriteLine(const AFields: array of string); + end; + + /// Class that reads UTF8 files beginning with a watermark line + /// followed by lines of tabbed separated values. + /// Any blank lines are ignored. + TTabSeparatedReader = class(TObject) + public + type + /// Type of callback trigged when each line is pardsed. + /// + /// TArray<string> [in] Fields defined + /// in the line. + TLineCallback = reference to procedure(AFields: TArray); + strict private + var + fFileName: string; + fWatermark: string; + fLines: IStringList; + /// Un-escapes any a C style escape sequences in AValue. + /// + function UnEscape(const AValue: string): string; + /// Reads file and splits into lines. + /// ETabSeparatedReader raised if file can't be read. + /// + procedure ReadFile; + /// Removes all blank lines from the data. + procedure PreProcess; + /// Parses the data. See the Read method for details of the + /// ALineCallback parameter. + procedure Parse(const ALineCallback: TLineCallback); + public + /// Creates object to read file AFileName which must begin + /// with watermark AWatermark. + constructor Create(const AFileName: string; const AWatermark: string); + /// Reads all data from the file. + /// TLineCallback [in] Callback called + /// for each line of data read. Passed an array of fields read from the + /// line. Caller must process the fields in this callback. + /// ETabSeparatedReader raised if file can't be read or + /// if watermark is not valid. + procedure Read(const ALineCallback: TLineCallback); + end; + + ETabSeparatedReader = class(ECodeSnip); + +implementation + +uses + // Delphi + Classes, + // Project + UConsts, + UIOUtils, + UStrUtils; + +const + EscapeableChars = TAB + CR + LF; + EscapedChars = 'trn'; + +{ TTabSeparatedFileWriter } + +procedure TTabSeparatedFileWriter.BeforeDestruction; +begin + inherited; + TFileIO.WriteAllText(fFileName, fBuilder.ToString, TEncoding.UTF8, True); +end; + +constructor TTabSeparatedFileWriter.Create(const AFileName, AWatermark: string); +begin + Assert(not StrIsEmpty(AFileName), ClassName + '.Create: AFileName is empty'); + Assert(not StrIsEmpty(AWatermark, True), + ClassName + '.Create: AWatermark is empty'); + + inherited Create; + fFileName := StrTrim(AFileName); + fBuilder := TStringBuilder.Create; + WriteWatermark(AWaterMark); +end; + +destructor TTabSeparatedFileWriter.Destroy; +begin + fBuilder.Free; + inherited; +end; + +function TTabSeparatedFileWriter.Escape(const AValue: string): string; +begin + // Perform character escaping per + // https://en.wikipedia.org/wiki/Tab-separated_values + Result := StrCEscapeStr(AValue, EscapedChars, EscapeableChars); +end; + +procedure TTabSeparatedFileWriter.WriteLine(const AFields: array of string); +var + Data: TStringList; + Item: string; +begin + Data := TStringList.Create; + try + // escape each data item in array + for Item in AFields do + Data.Add(Escape(Item)); + fBuilder.AppendLine(StrJoin(Data, TAB, True)); + finally + Data.Free; + end; +end; + +procedure TTabSeparatedFileWriter.WriteWatermark(const AWaterMark: string); +begin + if StrTrim(AWaterMark) <> '' then + begin + fBuilder.AppendLine(AWaterMark); + fBuilder.AppendLine; + end; +end; + +{ TTabSeparatedReader } + +constructor TTabSeparatedReader.Create(const AFileName, AWatermark: string); +begin + Assert(not StrIsEmpty(AFileName), ClassName + '.Create: AFileName is empty'); + Assert(not StrIsEmpty(AWatermark, True), + ClassName + '.Create: AWatermark is empty'); + + inherited Create; + fFileName := StrTrim(AFileName); + fWatermark := StrTrim(AWatermark); + fLines := TIStringList.Create; +end; + +procedure TTabSeparatedReader.Parse(const ALineCallback: TLineCallback); +resourcestring + sBadFileFormat = 'Invalid tab separated list file format'; +var + Line: string; + Fields: TStringList; + Idx: Integer; +begin + // check for watermark in 1st line + if (fLines.Count <= 1) or (fLines[0] <> fWatermark) then + raise ETabSeparatedReader.Create(sBadFileFormat); + // delete watermark line + fLines.Delete(0); + for Line in fLines do + begin + Fields := TStringList.Create; + try + StrExplode(Line, TAB, Fields); + for Idx := 0 to Pred(Fields.Count) do + Fields[Idx] := UnEscape(Fields[Idx]); + ALineCallback(Fields.ToStringArray); + finally + Fields.Free; + end; + end; +end; + +procedure TTabSeparatedReader.PreProcess; +var + Idx: Integer; +begin + for Idx := Pred(fLines.Count) downto 0 do + if StrIsEmpty(fLines[Idx], True) then + fLines.Delete(Idx); +end; + +procedure TTabSeparatedReader.ReadFile; +begin + try + fLines.SetText( + TFileIO.ReadAllText(fFileName, TEncoding.UTF8, True), CRLF, False, True + ); + except + on E: EStreamError do + raise ETabSeparatedReader.Create(E); + on E: EIOUtils do + raise ETabSeparatedReader.Create(E); + else + raise; + end; +end; + +procedure TTabSeparatedReader.Read(const ALineCallback: TLineCallback); +begin + ReadFile; + Preprocess; + Parse(ALineCallback); +end; + +function TTabSeparatedReader.UnEscape(const AValue: string): string; +begin + // Perform character un-escaping per + // https://en.wikipedia.org/wiki/Tab-separated_values + Result := StrCUnEscapeStr(AValue, EscapedChars, EscapeableChars); +end; + +end. + From 20f4f1256ae96698194e45e569382c052caf9782 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 11 Nov 2024 20:18:46 +0000 Subject: [PATCH 069/222] Add new DBIO.UCategoryIO unit to project This unit defines class that read / write category data from / to a categories file that is stored in tab separated value format, with a leading watermark line. --- Src/CodeSnip.dpr | 3 +- Src/CodeSnip.dproj | 1 + Src/DBIO.UCategoryIO.pas | 163 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 166 insertions(+), 1 deletion(-) create mode 100644 Src/DBIO.UCategoryIO.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index f86338372..32805a495 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -375,7 +375,8 @@ uses ClassHelpers.UGraphics in 'ClassHelpers.UGraphics.pas', ClassHelpers.UActions in 'ClassHelpers.UActions.pas', DB.UCollections in 'DB.UCollections.pas', - UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas'; + UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas', + DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas'; // Include resources {$Resource ExternalObj.tlb} // Type library file diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index ba059b80d..921ecf1e5 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -582,6 +582,7 @@ + Base diff --git a/Src/DBIO.UCategoryIO.pas b/Src/DBIO.UCategoryIO.pas new file mode 100644 index 000000000..4c058c641 --- /dev/null +++ b/Src/DBIO.UCategoryIO.pas @@ -0,0 +1,163 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). + * + * Class that read and write category information from and to files. +} + +unit DBIO.UCategoryIO; + +interface + +uses + // Delphi + SysUtils, + Generics.Collections, + // Project + DB.UCategory, + UExceptions, + UTabSeparatedFileIO; + +type + /// Base class for category reader and writer classes. + TCategoryIO = class abstract(TObject) + strict protected + const + /// Watermark that is present on the first line of a valid + /// categories file. + Watermark = #$25BA + ' CodeSnip Categories v1 ' + #$25C4; + end; + + /// Class used to read category information from a file. + TCategoryReader = class sealed(TCategoryIO) + public + type + /// Key / Value pair associating the category ID (key) with the + /// category data (value). + TCategoryIDAndData = TPair; + strict private + var + /// Object that read data from a tab delimited UTF8 text file. + /// + fFileReader: TTabSeparatedReader; + /// List of category data read from file. + fCatData: TList; + /// Parses fields that have been split out from each text line. + /// + /// ECategoryReader raised if the fields are not valid. + /// + procedure ParseFields(AFields: TArray); + public + /// Creates object to read from file AFileName. + constructor Create(const AFileName: string); + /// Object destructor. + destructor Destroy; override; + /// Reads data about each category defined in file. + /// TArray<TCategoryIDAndData>. Array of category + /// data. + /// ECategoryReader raised if the file can't be read or + /// if its contents are invalid. + function Read: TArray; + end; + + /// Class of exception raised by TCategoryReader. + ECategoryReader = class(ECodeSnip); + + /// Class used to write category information to a file. + TCategoryWriter = class sealed(TCategoryIO) + strict private + var + /// Object that writes data to a tab delimited UTF8 text file. + /// + fFileWriter: TTabSeparatedFileWriter; + public + /// Creates object to write to file AFileName. + constructor Create(const AFileName: string); + /// Object destructor. + destructor Destroy; override; + /// Writes information about each category in ACategoryList + /// + procedure Write(const ACategoryList: TCategoryList); + end; + +implementation + +uses + // Project + UStrUtils; + +{ TCategoryReader } + +constructor TCategoryReader.Create(const AFileName: string); +begin + Assert(not StrIsEmpty(AFileName), ClassName + '.Create: AFileName is empty'); + inherited Create; + fFileReader := TTabSeparatedReader.Create(AFileName, Watermark); + fCatData := TList.Create; +end; + +destructor TCategoryReader.Destroy; +begin + fCatData.Free; + fFileReader.Free; + inherited; +end; + +procedure TCategoryReader.ParseFields(AFields: TArray); +resourcestring + sMalformedLine = 'Malformed line in categories file'; +var + CatID: string; + Data: TCategoryData; +begin + if Length(AFields) <> 2 then + raise ECategoryReader.Create(sMalformedLine); + if StrIsEmpty(AFields[0]) or StrIsEmpty(AFields[1]) then + raise ECategoryReader.Create(sMalformedLine); + CatID := StrTrim(AFields[0]); + Data.Init; + Data.Desc := StrTrim(AFields[1]); + fCatData.Add(TCategoryIDAndData.Create(CatID, Data)); +end; + +function TCategoryReader.Read: TArray; +begin + fCatData.Clear; + try + fFileReader.Read(ParseFields); + except + on E: ETabSeparatedReader do + raise ECategoryReader.Create(E); + else + raise; + end; + Result := fCatData.ToArray; +end; + +{ TCategoryWriter } + +constructor TCategoryWriter.Create(const AFileName: string); +begin + Assert(not StrIsEmpty(AFileName), ClassName + '.Create: AFileName is empty'); + inherited Create; + fFileWriter := TTabSeparatedFileWriter.Create(AFileName, Watermark); +end; + +destructor TCategoryWriter.Destroy; +begin + fFileWriter.Free; + inherited; +end; + +procedure TCategoryWriter.Write(const ACategoryList: TCategoryList); +var + Cat: TCategory; +begin + for Cat in ACategoryList do + fFileWriter.WriteLine(TArray.Create(Cat.ID, Cat.Description)); +end; + +end. From b3f8c537f6732c95b97025d9911f95939be2ba6e Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 11 Nov 2024 21:05:03 +0000 Subject: [PATCH 070/222] Add new TCategory.Update method This method permits a category's properties to be updated. --- Src/DB.UCategory.pas | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index 000565173..6fdb3a3b6 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -79,6 +79,12 @@ TCategory = class(TObject) destructor Destroy; override; {Destructor. Tears down object. } + + /// Updates category properties. + /// TCategoryData [in] Updated category + /// properties. + procedure Update(const Data: TCategoryData); + function IsEqual(const Cat: TCategory): Boolean; {Checks if this category is same as another category. Categories are considered equal if they have the same ID. @@ -280,6 +286,11 @@ procedure TCategory.SetCollectionID(const AValue: TCollectionID); fCollectionID := AValue; end; +procedure TCategory.Update(const Data: TCategoryData); +begin + fDescription := Data.Desc; +end; + { TCategoryEx } class function TCategoryEx.CreateDefault: TCategory; From 9e27f4bdf60c9e9dd8eb82853e1b292c5bd4702b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 12 Nov 2024 00:38:53 +0000 Subject: [PATCH 071/222] Add code to load/save categories to their own file Categories are now loaded and saved to a single global file per user that is separate from the category information stored in collection files. Collection files still store this information, but in future will not store information about empty categories. Therefore this new feature ensures that empty categories are not lost until explicitly deleted. To do this IGlobalCategoryLoader and IGlobalCategorySaver interfaces were added to DB.UDatabaseIO unit, along with implementing private TGlobalCategoryLoader and TGlobalCategorySaver classes and new factory methods to create them. TDatabase.Load and TDatabase.Save were extended to load and save the categories to file. TAppInfo had a new UserCategoriesFileName method added to return the full path to a per-user global categories file. --- Src/DB.UDatabaseIO.pas | 123 ++++++++++++++++++++++++++++++++++++++++- Src/DB.UMain.pas | 19 +++++-- Src/UAppInfo.pas | 10 ++++ 3 files changed, 144 insertions(+), 8 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index df4fc38d5..d92d32dcb 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -53,17 +53,39 @@ interface IDataFormatSaver = interface(IInterface) ['{F46EE2E3-68A7-4877-9E04-192D15D29BB1}'] /// Saves data to storage. - /// TSnippetList [in] Contains information + /// TSnippetList [in] Contains information /// about each snippet to be saved. /// TCategoryList [in] Contains information /// about each category to be saved. /// IDBDataProvider [in] Object used to /// obtain details of the data to be stored. - /// Method of IDataFormatSaver. procedure Save(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); end; + /// Interface to object that can save global category information, + /// regardless of any categories saved with collections. + IGlobalCategoryLoader = interface(IInterface) + ['{0029F641-FAC4-43C8-A412-F70554BDCF28}'] + /// Loads categories data from global storage. + /// TCategoryList [in] Receives information + /// about each category loaded. + /// IDBDataItemFactory [in] Object + /// used to create new categories. + procedure Load(const Categories: TCategoryList; + const DBDataItemFactory: IDBDataItemFactory); + end; + + /// Interface to object that can load global category information, + /// regardless of any categories loaded with collections. + IGlobalCategorySaver = interface(IInterface) + ['{D967E4FC-32FA-47F8-9BE0-4B25C7215CCA}'] + /// Saves category data to global storage. + /// TCategoryList [in] Contains information + /// about each category to be saved. + procedure Save(const Categories: TCategoryList); + end; + { TDatabaseIOFactory: Factory class that can create instances of writer and loader objects for the @@ -72,7 +94,7 @@ interface TDatabaseIOFactory = class(TNoConstructObject) public /// Creates and returns an object to be used to load the given - /// collection's data in the correct format. Nil is returned if no loader + /// collection's data in the correct format. Nil is returned if no loader /// object is supported. class function CreateDBLoader(const Collection: TCollection): IDataFormatLoader; @@ -82,6 +104,15 @@ TDatabaseIOFactory = class(TNoConstructObject) /// object is supported. class function CreateDBSaver(const Collection: TCollection): IDataFormatSaver; + + /// Creates and returns an object to be used to load a list of + /// globally stored categories. + class function CreateGlobalCategoryLoader: IGlobalCategoryLoader; + + /// Creates and returns an object to be used to save a list of + /// categories to global storage. + class function CreateGlobalCategorySaver: IGlobalCategorySaver; + end; { @@ -97,8 +128,10 @@ implementation uses // Delphi SysUtils, + Generics.Collections, IOUtils, // Project + DBIO.UCategoryIO, DBIO.UFileIOIntf, DBIO.UIniData, DBIO.UNulDataReader, @@ -407,6 +440,31 @@ TNativeV4FormatSaver = class(TFormatSaver, const Provider: IDBDataProvider); override; end; + /// Class used to save global category information, regardless of + /// any categories saved with collections. + TGlobalCategoryLoader = class(TInterfacedObject, IGlobalCategoryLoader) + public + /// Loads categories data from global storage. + /// TCategoryList [in] Receives information + /// about each category loaded. + /// IDBDataItemFactory [in] Object + /// used to create new categories. + /// Method of IGlobalCategoryLoader. + procedure Load(const Categories: TCategoryList; + const DBDataItemFactory: IDBDataItemFactory); + end; + + /// Class used to save global category information, regardless of + /// any categories saved with collections. + TGlobalCategorySaver = class(TInterfacedObject, IGlobalCategorySaver) + public + /// Saves category data to global storage. + /// TCategoryList [in] Contains information + /// about each category to be saved. + /// Method of IGlobalCategorySaver. + procedure Save(const Categories: TCategoryList); + end; + { TDatabaseIOFactory } class function TDatabaseIOFactory.CreateDBLoader(const Collection: TCollection): @@ -437,6 +495,18 @@ class function TDatabaseIOFactory.CreateDBSaver( end; end; +class function TDatabaseIOFactory.CreateGlobalCategoryLoader: + IGlobalCategoryLoader; +begin + Result := TGlobalCategoryLoader.Create; +end; + +class function TDatabaseIOFactory.CreateGlobalCategorySaver: + IGlobalCategorySaver; +begin + Result := TGlobalCategorySaver.Create; +end; + { TDatabaseLoader } constructor TDatabaseLoader.Create(const ACollection: TCollection); @@ -842,5 +912,52 @@ procedure TNativeV4FormatSaver.Save(const SnipList: TSnippetList; DoSave(SnipList, Categories, Provider); end; +{ TGlobalCategoryLoader } + +procedure TGlobalCategoryLoader.Load(const Categories: TCategoryList; + const DBDataItemFactory: IDBDataItemFactory); +var + Reader: TCategoryReader; + CatInfo: TCategoryReader.TCategoryIDAndData; + Cat: TCategory; +begin + if not TFile.Exists(TAppInfo.UserCategoriesFileName) then + Exit; + Reader := TCategoryReader.Create(TAppInfo.UserCategoriesFileName); + try + for CatInfo in Reader.Read do + begin + Cat := Categories.Find(CatInfo.Key); + if not Assigned(Cat) then + begin + Categories.Add( + DBDataItemFactory.CreateCategory(CatInfo.Key, TCollectionID.__TMP__UserDBCollectionID, CatInfo.Value) + ) + end + else + begin + if Cat.Description <> CatInfo.Value.Desc then + Cat.Update(CatInfo.Value); + end; + end; + finally + Reader.Free; + end; +end; + +{ TGlobalCategorySaver } + +procedure TGlobalCategorySaver.Save(const Categories: TCategoryList); +var + Writer: TCategoryWriter; +begin + Writer := TCategoryWriter.Create(TAppInfo.UserCategoriesFileName); + try + Writer.Write(Categories); + finally + Writer.Free; + end; +end; + end. diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 14851782e..610bcb3ee 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -325,6 +325,7 @@ implementation Generics.Defaults, // Project DB.UDatabaseIO, + DBIO.UCategoryIO, IntfCommon, UExceptions, UQuery, @@ -1084,6 +1085,7 @@ procedure TDatabase.Load; Loader: IDataFormatLoader; Collections: TCollections; Collection: TCollection; + CatLoader: IGlobalCategoryLoader; begin Clear; @@ -1121,6 +1123,11 @@ procedure TDatabase.Load; Loader.Load(fSnippets, fCategories, Factory); end; + // Read categories from categories file to get any empty categories not + // created by format loaders + CatLoader := TDatabaseIOFactory.CreateGlobalCategoryLoader; + CatLoader.Load(fCategories, Factory); + // Ensure that the default category is present, if it's not already loaded if not Assigned(fCategories.Find(TCategory.DefaultID)) then fCategories.Add(TCategoryEx.CreateDefault); @@ -1145,22 +1152,24 @@ procedure TDatabase.Save; {Saves user defined snippets and all categories to user database. } var - MainProvider, UserProvider: IDBDataProvider; // object that supplies info to writer + MainProvider, UserProvider: IDBDataProvider; MainCollectionIdx, UserCollectionIdx: Integer; Saver: IDataFormatSaver; Collections: TCollections; Collection: TCollection; + CatSaver: IGlobalCategorySaver; begin + // Save categories + CatSaver := TDatabaseIOFactory.CreateGlobalCategorySaver; + CatSaver.Save(fCategories); + Collections := TCollections.Instance; {TODO: -cVault: The following code is a kludge to maintain compatibility with CodeSnip 4. In CodeSnip Vault we should iterate over all collections creating a writer for each one. } - // *** The following code is a stub for later versions. For CodeSnip 4 - // compatibility this code does nothing because there is no writer for - // the "main" collection. TDatabaseIOFactory.CreateDBWriter will return - // nil for this format, so Saver.Write will never be called. + // *** The following code is a stub for later versions. MainCollectionIdx := TCollections.Instance.IndexOfID( TCollectionID.__TMP__MainDBCollectionID ); diff --git a/Src/UAppInfo.pas b/Src/UAppInfo.pas index 67f967565..7b6d1a45b 100644 --- a/Src/UAppInfo.pas +++ b/Src/UAppInfo.pas @@ -81,6 +81,11 @@ TAppInfo = class(TNoConstructObject) class function UserConfigFileName: string; {Returns fully specified name of per-user config file. } + + /// Returns fully specified name of the current user's global + /// categories file. + class function UserCategoriesFileName: string; + class function ProgramReleaseInfo: string; {Gets information about the current program release. Includes any special build information if present in version information. @@ -237,6 +242,11 @@ class function TAppInfo.UserAppDir: string; {$ENDIF} end; +class function TAppInfo.UserCategoriesFileName: string; +begin + Result := UserAppDir + '\Categories'; +end; + class function TAppInfo.UserConfigFileName: string; begin Result := UserAppDir + '\User.config'; From 392ec7b37b4e53148f70ac34c8cc352261ed77b5 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 12 Nov 2024 01:04:36 +0000 Subject: [PATCH 072/222] Change native file format to ignore empty categories The "native" CodeSnip 4 file format (formerly the user database format) no longer saves details of empty categories. Because TNativeV4FormatSaver now behaves exactly the same as TDCSCV2FormatSaver in not writing empty categories, the code that ensures this was pushed up into the parent class and a virtual abstract method and its overrides were able to be removed. --- Src/DB.UDatabaseIO.pas | 45 ++---------------------------------------- 1 file changed, 2 insertions(+), 43 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index d92d32dcb..2b15f3ee4 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -321,16 +321,6 @@ TFormatSaver = class abstract (TInterfacedObject, /// IDataWriter. Required writer object. function CreateWriter: IDataWriter; virtual; abstract; - /// Checks if a category can be written to storage. - /// TCategory [in] The category being - /// queried. - /// IStringList [in] List of the - /// keys of all snippets in the category. - /// Boolean. True if category can be written, False - /// otherwise. - function CanWriteCategory(const ACategory: TCategory; - const ASnippetsInCategory: IStringList): Boolean; virtual; abstract; - /// Collection being saved. property Collection: TCollection read fCollection; @@ -375,16 +365,6 @@ TDCSCV2FormatSaver = class(TFormatSaver, /// IDataWriter. Required writer object. function CreateWriter: IDataWriter; override; - /// Checks if a category can be written to storage. - /// TCategory [in] The category being - /// queried. - /// IStringList [in] List of the - /// keys of all snippets in the category. - /// Boolean. True if category contains snippets, False - /// otherwise. - function CanWriteCategory(const ACategory: TCategory; - const ASnippetsInCategory: IStringList): Boolean; override; - public /// Creates object that can save the given collection. @@ -415,16 +395,6 @@ TNativeV4FormatSaver = class(TFormatSaver, /// IDataWriter. Required writer object. function CreateWriter: IDataWriter; override; - /// Checks if a category can be written to storage. - /// TCategory [in] The category being - /// queried. - /// IStringList [in] List of the - /// keys of all snippets in the category. - /// Boolean. Always True: all categories are written. - /// - function CanWriteCategory(const ACategory: TCategory; - const ASnippetsInCategory: IStringList): Boolean; override; - public /// Saves data to storage. @@ -783,7 +753,8 @@ procedure TFormatSaver.WriteCategories; for Cat in fCategories do begin SnipList := fProvider.GetCategorySnippets(Cat); - if CanWriteCategory(Cat, SnipList) then + // only write category info when not empty + if SnipList.Count > 0 then begin Props := fProvider.GetCategoryProps(Cat); fWriter.WriteCatProps(Cat.ID, Props); @@ -841,12 +812,6 @@ procedure TDCSCV2FormatSaver.Backup; end; end; -function TDCSCV2FormatSaver.CanWriteCategory(const ACategory: TCategory; - const ASnippetsInCategory: IStringList): Boolean; -begin - Result := ASnippetsInCategory.Count > 0 -end; - constructor TDCSCV2FormatSaver.Create(const ACollection: TCollection); begin inherited Create(ACollection); @@ -895,12 +860,6 @@ procedure TDCSCV2FormatSaver.Save(const SnipList: TSnippetList; { TNativeV4FormatSaver } -function TNativeV4FormatSaver.CanWriteCategory(const ACategory: TCategory; - const ASnippetsInCategory: IStringList): Boolean; -begin - Result := True; -end; - function TNativeV4FormatSaver.CreateWriter: IDataWriter; begin Result := TXMLDataWriter.Create(Collection.Location.Directory); From a43345b82f0f9725415e7cb1d0a0d690e932f413 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 12 Nov 2024 01:56:44 +0000 Subject: [PATCH 073/222] Remove unused collection ID property from TCategory Removed redundant and unused TCategory.CollectionID property. Removed collection ID parameter from TCategory constructor. Removed redundant collection ID parameter from IDBDataItemFactory.CreateCategory method and its implementation. Updated all code affected by the changes to TCategory constructor and IDBDataItemFactory.CreateCategory parameter lists. --- Src/DB.UCategory.pas | 23 +++-------------------- Src/DB.UDatabaseIO.pas | 4 ++-- Src/DB.UMain.pas | 18 +++++++----------- 3 files changed, 12 insertions(+), 33 deletions(-) diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index 6fdb3a3b6..5a613c68d 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -52,8 +52,6 @@ TCategory = class(TObject) fSnippets: TSnippetList; // List of snippet objects in category fID: string; // Category id fDescription: string; // Category description - fCollectionID: TCollectionID; - procedure SetCollectionID(const AValue: TCollectionID); function CompareIDTo(const Cat: TCategory): Integer; {Compares this category's ID to that of a given category. The check is not case sensitive. @@ -69,12 +67,9 @@ TCategory = class(TObject) /// Object constructor. Sets up category object with given /// property values. /// CatID [in] Category ID. - /// TCollectionID [in] ID of collection - /// that defines this category. ID must not be null. /// TCategoryData [in] category properties. /// - constructor Create(const CatID: string; const ACollectionID: TCollectionID; - const Data: TCategoryData); + constructor Create(const CatID: string; const Data: TCategoryData); destructor Destroy; override; {Destructor. Tears down object. @@ -110,10 +105,6 @@ TCategory = class(TObject) {Description of category} property Snippets: TSnippetList read fSnippets; {List of snippets in this category} - /// ID of collection that defines this category. - /// ID must not be null. - property CollectionID: TCollectionID - read fCollectionID write SetCollectionID; end; { @@ -246,8 +237,7 @@ function TCategory.CompareIDTo(const Cat: TCategory): Integer; Result := StrCompareText(Self.ID, Cat.ID); end; -constructor TCategory.Create(const CatID: string; - const ACollectionID: TCollectionID; const Data: TCategoryData); +constructor TCategory.Create(const CatID: string; const Data: TCategoryData); begin {TODO -cVault: Add a simpler contructor that takes only the category ID and description and creates does all the convoluted TCategoryData setting! @@ -257,7 +247,6 @@ constructor TCategory.Create(const CatID: string; inherited Create; fID := CatID; fDescription := Data.Desc; - SetCollectionID(ACollectionID); // Create list to store snippets in category fSnippets := TSnippetListEx.Create; end; @@ -280,12 +269,6 @@ function TCategory.IsEqual(const Cat: TCategory): Boolean; Result := CompareIDTo(Cat) = 0; end; -procedure TCategory.SetCollectionID(const AValue: TCollectionID); -begin - Assert(not AValue.IsNull, ClassName + '.SetCollectionID: Value is null'); - fCollectionID := AValue; -end; - procedure TCategory.Update(const Data: TCategoryData); begin fDescription := Data.Desc; @@ -301,7 +284,7 @@ class function TCategoryEx.CreateDefault: TCategory; begin Data.Init; Data.Desc := sDefCatDesc; - Result := Create(DefaultID, TCollectionID.__TMP__UserDBCollectionID, Data); + Result := Create(DefaultID, Data); end; function TCategoryEx.GetEditData: TCategoryData; diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 2b15f3ee4..d265d42cb 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -492,7 +492,7 @@ procedure TDatabaseLoader.CreateCategory(const CatID: string; @param CatData [in] Properties of category. } begin - fCategories.Add(fFactory.CreateCategory(CatID, Collection.UID, CatData)); + fCategories.Add(fFactory.CreateCategory(CatID, CatData)); end; procedure TDatabaseLoader.HandleException(const E: Exception); @@ -890,7 +890,7 @@ procedure TGlobalCategoryLoader.Load(const Categories: TCategoryList; if not Assigned(Cat) then begin Categories.Add( - DBDataItemFactory.CreateCategory(CatInfo.Key, TCollectionID.__TMP__UserDBCollectionID, CatInfo.Value) + DBDataItemFactory.CreateCategory(CatInfo.Key, CatInfo.Value) ) end else diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 610bcb3ee..16c6decf1 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -120,13 +120,11 @@ interface /// Creates a new category object. /// string [in] ID of new category. Must be /// unique. - /// TCollectionID [in] Collection with - /// which the category is associated. /// TCategoryData [in] Record describing /// category's properties. /// TCategory. Instance of new category object. - function CreateCategory(const CatID: string; - const ACollectionID: TCollectionID; const Data: TCategoryData): TCategory; + function CreateCategory(const CatID: string; const Data: TCategoryData): + TCategory; /// Creates a new snippet object. /// string [in] New snippet's key. Must not @@ -347,13 +345,11 @@ TDBDataItemFactory = class(TInterfacedObject, IDBDataItemFactory) /// Creates a new category object. /// string [in] ID of new category. Must be /// unique. - /// TCollectionID [in] Collection with - /// which the category is associated. /// TCategoryData [in] Record describing /// category's properties. /// TCategory. Instance of new category object. - function CreateCategory(const CatID: string; - const ACollectionID: TCollectionID; const Data: TCategoryData): TCategory; + function CreateCategory(const CatID: string; const Data: TCategoryData): + TCategory; /// Creates a new snippet object. /// string [in] New snippet's key. Must not @@ -1031,7 +1027,7 @@ function TDatabase.InternalAddCategory(const CatID: string; @return Reference to new category object. } begin - Result := TCategoryEx.Create(CatID, TCollectionID.__TMP__UserDBCollectionID, Data); + Result := TCategoryEx.Create(CatID, Data); fCategories.Add(Result); end; @@ -1350,9 +1346,9 @@ function TDatabase.TEventInfo.GetKind: TDatabaseChangeEventKind; { TDBDataItemFactory } function TDBDataItemFactory.CreateCategory(const CatID: string; - const ACollectionID: TCollectionID; const Data: TCategoryData): TCategory; + const Data: TCategoryData): TCategory; begin - Result := TCategoryEx.Create(CatID, ACollectionID, Data); + Result := TCategoryEx.Create(CatID, Data); end; function TDBDataItemFactory.CreateSnippet(const Key: string; From ebd04ac07e822eaae02f68eca28e8310aacc3a41 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 12 Nov 2024 02:34:08 +0000 Subject: [PATCH 074/222] Change branding, directories & version for CS Vault Changed per-user and global application directories from CodeSnip.4 to CodeSnip.Vault to avoid changes to file formats when developing Vault from destroying files required to run existing CodeSnip 4 installations. Changed program name to CodeSnip.Vault to make it easy to see that the development version of CodeSnip vault is being run. This change also made in version information. Changed version number to 4.900.0 and build number to 1000. Changed splash screen to one with "Vault" overlaid on it. --- Src/Res/Img/Branding/Splash.gif | Bin 10841 -> 16775 bytes Src/UAppInfo.pas | 11 ++++++----- Src/VersionInfo.vi-inc | 6 +++--- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/Src/Res/Img/Branding/Splash.gif b/Src/Res/Img/Branding/Splash.gif index 6bddefedfae467c08db1f1f0286d6ba8cc168790..496a900db2c678ffaa6852a61e54c003fdbe0b0b 100644 GIT binary patch literal 16775 zcmV(?K-a%VNk%w1VMPI(0B`^REC2ui07U_t0Eh2>BJP1E?t?4vhA-`gGVh5r?Tb6` zh%@eyJn)b|?T$h0l}YfCLF$@W?V45UoLupnRPUfn?WJ1tpZEM)r)%!E zZ0f6c?YVXEyLI)of9}I~ATPBwMZY*lzdA_2K2OFzP{u7n|36g!LsP~{SH?qtMOptz zTmMaB|6gzRQe*d0W&KuZ|5|PTUUB|mZ}Mez^dvI|B;^h zjG^q9r|XTP|BR#XmZ$cWsqvbv@ROwfld1ojt^b>{^_8;!nzsL)x&NiD=%}^ruC?T< zwClCIqrLyDy#KPk`n|-}y~F3H!2hhn|G38XvBv+q#{ad- z|GLiqzR>^7&ClM<#ogD$-q^&~)y~@1%iP$@#mU#s(ALe--rU&M)zsA4*3#0{+uhvU z=g-0B)yL%A#OdF{<=)Kt-NfkH+2h{S;oaHt-qP#g!{^}5=-|rx;mhUV(fH-o#mMK% z&*RL|ck;?CtII=;ZwF;r;dQ=jrp~>;LKR|MBnf z?ehQh^7Q`s^z!!q_W1w*|NjX80AmOoNU)&6g9sBUT*$DY!-o(fN}NcsqQ#3CGiuz( zv7^V2AVZ2AX|a>ZlPFW3^wf!^OHVLkdipf;lg*nqRejQ_s;AGNuT;GnN^~f!SFn;Q zT?$K9Q&~`>%Az%ODy^$nY1PtNtE*S9w!(@XJI+?wacI-3B{z<3IdX8{mYYkrZn<=K z)9Kx-mt8t`fCCF|$F7~>!-(6tQ|zv><9qJzNuE3z-#vVoGi%1DkF&ndpg;H1*RQnc z)BXIV_Q$%l>wo@W|C>#_w(Z-vbL*~cEgM0XDpRsV30&q(<2Z5Z+{yf>(4IkyA}yK} z=~AanvrCmqHLG{7T)W!;`bxIES+i@?vK?2BJ^Q$J@7l%7x9?xUfC=X>TsZM!!;Uou z*<+MhM%iVTW!Bkdp^ercX{V`{+G?)FW+7{^St#3X9Cp|tLBWM+QgJP{WZZGdDYp|( z&H)vjbk;GI6n0N-7gcxPX%$|0U)3_+SYn-po?1k!@Vioh;SlT6P-M**y3|~!YHGRP}OK-p;`6lEI2+Y z+9;9Kx+f`nbSb%HlY2c0n5I&8S|wtjUK!cBSxVL=mz|}$YM5g7bBiDJ*6YU~_x_>p zzWnYh$RGa-BJjWj%VVpDZR#3aoF<+~r%k~M3lyGv8XF^x$!mak4Jv%>iS}>CDd)qR59|5Yej+>e`8P6aDB9#LiWb{#%Z}~a zanH?8Irm4Y``w)C4ZOMM641_k1~^ouYG|iHL-UTdw0td2Ujl<5^&D3W>+L3CDB+$- zG#Dc9Wo}Lnix}tbWU-1NYepL5PRCNGBh`(kb*?*4+t4CEZPAWWa-$oj?1mrx_>fA# z`_z^HAR`&#rE5#3Lf!#Y)em3zVS)8ZS_Av_FQ+~3aR#$sZZLQf?rD#M#4%CUw3eJ; z*~x3g`dZkqlQGhrE=OlWo7xyZs4j}@5qHSz73Cvelz6HPL)W|818UTWZ)wg7qIDFQEHXM%_U7ji41md zjAZ;|_`LQai-iq^+EL*fRT;K2G8LyU2U4+d&U~gIqA5-6sid0SZ;4hwiq-X!?xwqg64_%cR;PDnzOnoqNpvsIM)FSxIK@1`o z4808(yQnY^`pTkR8zK3=iNevP@G2iQ6e~l56P&7ifrc|Ml7R*_=+lUr(5MYUU|CEmZI)`yOzvu;ob+T)xYo5iWmKaZ&5qav z#W6Udj(tB0QhDkqR!ObQowkJ84*N2tnR-fy!Yg7hg_%SHI*2seD1%*}2vnv2JtpVybRwRjVLvnloS; z?~roshdpGgz`G(%ulz!&Bo+GCh4yx^4yD{C5ld0;k0-Kf-7ebsjAMDLAJ9Us1(s_#lAXjw?=(0 zd<7CB!)~%+*i>wtqKZ-J@E5sJQLg$fi`jFc6RgrrX*0D?3vj08ZD(4KA zL;_hkWG|-BXlhI`x(FSw21wkWso$BD=InM;5ec1zF+L=2OF& zd4~Z4V24M81{jgHa$V`rNG$`b4_qFYrco^B+2BgPyfX8dagvI~;&;ty$_95J0017>_ESVbXUUaUHbW z2SGHv;er5!mkEYqFY~tAzoFbjV?1h7=cFg5)~~U?$;OO{(`?}XVPCA-t!K5|Q7$ay z<4et|zwG*Mt)SBPsGQ8&&13-J03dc~##?1cmzUXiUEISR4sn4=JmMCgxKUG#@qxVL zYS|u+s4=IxZQ{vAqcjSCF&0jbjx(gq71=9U4rG+Q=WWz=Den3x&j?3&yM+#*TQmIK zX9xi30Dyo!KvQKa%a#syP3FS?P=`9`s}InQe8l?zh^GU>s1vvN)Q?*2F;~rUT89&i z<%AsYnK6{2v~jA%R(1em)w1bcot;g(Hg(o|QgO%Kb&;H8e0!?bL;Q7@jPZA%TY&I| zx3XPlYcIz;o?nokUc)O7^~y^e#hW)Or#o$R(F4c(65Trgn!T;&Zac+2RaXl{2MhOnk2ir1CvntweV3A zobd&K2LM~35BE?8aj<~OCs0V|2N4*7k_UN{7jc*WXMKZkc~dxbfzWxL$AKW&D`UiQ zqh?=TSX?!Bf@_q5m9>Iu*n$TpOKvEG^tL}W*h5r;gTQBD`NV_x@NaQL zCNnmtWd5@^ee;gS<1@xU0Dxx!z>tra0(1gM8`$7VGj-fcnUxUl*x-{5C$C(0SK@GWNMx~UNc!^fXg{rx2Bj}pP37akeZm9bf@6~?)s9`FH*z?>gB4$tWU(J4ReM4cY61hq7S*y#a&=m$E7Phhl!Jh!`7oda!F6BiE6_N8;G>|9fD zup$_yIl-$EbDI5oau__=5 zSaAv_@UkXw3LfeKA>c~100OTmsJ4I#DgXjL3j!yg2x@VnEPw(b;IlLk3nR&*D{ulK zaI`e=4YqUw*_n=uV6;!W0-=x}?NA6PfC7a;2u~XVE3lYDm#v55&Y`vLK13oP)ON)Q&N0HXghkQOYupdg?K zb3qQXdz>M#2-jJ)QL+LcdINz$2(K9eu}KL3aZh_!NIau1n85{on5l7lqyr!U7*Gau zumKwo2X!C^l-CCof}d1Ml&u;FeA}O~n!Z^I4TC!nI02?8Vz`RCSaIqI&fy5a3UVKs z0#)e(z?!iTiknLDp(bDhHqZheIs%>xn<`)fND!wca22e81RshC#pwYcFnf^e0n=I* zClHrPAOpzB3TSbnARq%vumn_#!Km;SED8cNkisz<0P;JyFgOCi>`2Sm9C=X<_M zImTlQ4Q31t%h-9f`o0eXjixt^%fYMn3#>umzaG$_L{S5;=>kY$tOFdP7nu~7@S&2x zo3BX&-N6bK{4sHA!Ce8ZX|us6P%xG|CzjF-8s$iVKDjnL~$8Gw@AD}G1>H#)j$a0z$Gw_;DfEA5= z!5Q3DwjjxL#0rX_1WAz29zX+Vp{Q-4B(Z?AAutz;dOQE$fU_WAR-+8O9r7 z%CA|r$;*;0X|8FD56s}i01yEZ5C&vGguM)SNUE>H%&%a~wj9@w4xLOFK0KqN?89Gs)<&D1>>$L1KrU>BPf460YEa7upa2*E z2IfCW^^MV!R*_3%lK-m4e~lpcmiD4#pb- zH?YHmaN;N)#IM=bzmtRRNGg1%2YArjZ~zB*aN}|S2h?2$_-J(6Ez$rdaDeR(;a%8! zkPL^7-pj#QAa{E2-4p+I`~i8=&0`3be%uuO9ThF`n&nIj%Uar} zts@66)ngH-lMLIhxttL`;aYv$M)J=XEYPpX1aq(jeg@ejt6p(2SAFC0QKWXY5*5deB2G#;C0Tj-nHUKG~ECYJ(0XGnbpG*ULG0KII!{l(vHFM}SMbS5fwmgFwt-uD3{^*b{ z>D5gKaexMx9&`oZ2J_Gbm>O_ykPrW0T-XFJ>Z1+~rrzW+Ez_Xr6XgfTU-%P2U9qu= z$3vkAu=xR02?G_o6rwHEvOvHFoB|)J0;SW)1Af|vvgQ~}@uABo_#6UGFbN{urgiQC zC@ceA4FV;(;rYA-G~mM_Fb;b$=G?A3LQexHj-8{xAL!0xZG~u;u?=ic_3=yMeh;D%yujy-703S6uj$CO(ACFz0)l!LH+!5uoA?zDq970o@#f$l%F1Sy4w`@Y zfPo6b9h)oAA5TxNH$|z>!>1Y9BhCvXa0!2%}$vn+rFrXVe>pz}T}1FV1vK3fRmumk`BV#cBqAV8d0QjT0X zhD$)$ScD?PK_=wg&NgCKdSxw&Fc~XY8E`nynan4E$mpa(x91@ zCau^%wr$VUx>sQs_z=I7Req}iEE5?l-JBAfm@?=@C zK6v;bOY>&Vv}nol9NKd&TBJ+YLY*45E!M4BkFy0^cIZ{r&g1D+a*+5^TW32s<#r!4gyDF$ZCJWikmTl;yGyVBu`D&qU); zG}2T9(KQiYi;cG1P8_G46jSs~A>f1)?l|N?qA{f9lv63k=%SmhI(M%75j&n*>5jXf zfMO#&WRTLsyz~D8K)`_kpqk1mf3C_3y)5>ShCcezN-Hcd$CTzjGtXozzyt#`@UXrV zJdi=g7JQH~2PmOB?M&)oeLbMA%BS&BPN`tWCw?T|x5K}>YS)@DP|Hb@s@ zaiL0K94^z0WbE|D8=)JOR8vi@4oD$$TF2F11kR@fv(G>ibTmQ>JuNjv zR~vCrbRB&(QllB7G)7D>%4pLXZL}9hnDUK@x_*C5HK(53X|?OFdjT74U3x)S7lv)! zfW2HNUQdf)YZc%QWR#(sV~&rFMw(zk<~vPiPX-)tIq9^vu{>YavodaL)-dOs!$qxU za%(ZSL`Kt9cf}QdV;9~SnYKvY8KV|;>K&!y*GKFA^}2Ol!iGI;WO_lSji(SuyB~e3 z+DBKY446170oqUonYrzjMwz@h&O2}Z`VM*Iz^7lZLF)@Q+|HIGL!3{Tw`Kfh$Oj$Q zXQ2Pho$YeWH{bkSrHyl%(;7XE`Z=oi<*}xmY{JfvUH%84>s}YT*tKB+S=gQKs^Tl( z)e0)ZQ^p-AkcH#bEgH&`M)S%9z3BaodVw39%CLv0?qzFF;H#PV9tXMdg@|&MBav*@ z$37M%jYXaVUFc}UDX87cey7Wy>Q=WCYyfZ$ z5X&M}x}X3D4zC#!3?3|zF-vOPvY%yKOD>lcAO?Lsv(TawfkS6VY#$j5fFj6mVKGHcVm88|M1_>SPU;y4&wc!n+Dwe1QsAn3Ak&6mMcD&{_FEyG0)%03bv+u=mof`UzDhPoGB`Cp# zfy@IbY(jCw#3Rn~Xx2UUcQuKk!i6nNU<1!Enk#ZwT!jOPALKv>7S=(Se{cjy*n+MQ z{_St|CES^OS;{0h1c!;y;W>X8y3?KRVGlc0#g_6J4jh1rdGXy^iMJQcaK?ERUEaOb z_&)^Aaiq1!GEWF0$Zy6p392yGBr93JXVqC+`zsmblMZdo{jqQ(D(en2n~J#A{wxEWM+ z^jshP|NYpRjY6fDD zR2O9_`=Gg8O?e-g=(k;6fFqpJt+f%Pk@=opadX@sNw_H#cxgFou>1!Eh%`!l7hD1btv zfMDQ;|7*S16S+Ic0RAh$14O{K{~)LbY``sKneCAfBgix=5UV5Ww3$mjP-88%da@CT zw^&0pw|c95gOOLWuqx1@7o;m~@*!KBq*KAX9_+z8JFGnWJj9YeZMZtDBfX0Al`FZp z2cm#tXu|)SL@1O()dPSkyh1Egz_+8LF5E(}YA8y`v`ss*F+3reQz3Qh5Yx!Jz1t`e zX+sP90TZdWdwZ*PaUVJ)fmJw;_@N&?yep&&u2Y!_Uw|$i1cp0X#)m6J_{)Yw6us-R zKdSH*tFV%IP=kh1fHcqsZfL?ul*HD%11!K8E&_lt*hEgO3+@TU1`MmoXt_6&g2bu2 zP79Prcme?9M=AIOTCllx|5HQCfrNeJ$0yhXTe!XpqXOx>4Ns_oACO3ilmbeCs~1@X z7QDj;)5BTV1S$Z6B5)3JpoAv?f|CRSDqw|MtBF~d1ym4)n3PHATE=DE22ub8M(6=+ zI4oCCgdX?-ANTzKn+oaBA7)?;{i%|#Y54AAXrOz14AiG$n{ADA>c(*s{#dMh>U!* zOem>5gc>^3fp!>&?}IfUm<6Sy34_D593TdpoXkX^Lq)iTBiKs|3xZkDoryC-E4h+x zAkC)C#HR$uaBMH@ZS0|+p{E6l>Lbf|co#|z5=3bdoM{FV)og1LmXB2XsP zK)l4euvKW3+o*-Q9J(Ly9A5l^7kseg$W0Q^0pfBw9RLS{bBA2Zv>eF1nj{8Bc(Wc5 zPE3o0V_Ph1ypqxE25smD(+mLA498+%O-y`>tBlP|K)G;>Qb z5k$@-@W9kqg$PW%9Pp@dNQLwiHz9zRy?lcBIWrzgjuk}C3o`=m%mi5T0rKoTQ5aDv zONGxQy=%nA_asekkWc!wPj0{kb97DEgaBcgO|=uyt|U@ea83&=0p653-~2QQwXhs0 z0Sw)Q@{t7$|8==qM3Ge3%rL{yRDcn&#I)(`6k$w`N9ea5*h~@thw2~#SWATI0*1o^ z1{Q5m3)_KejHhe7l6WA^KJ^A1g~}bRN~pjBAAOP_4N$u%QX;L=H^V?AQ_zV@x8szu zAkc)+NQEQiOh0l`5(olFNQF?<&Nt&ZM`=_RqykzX2Xa^iS9`N6P@2uGMfssY54th|_JLQx-geMF0nIcm&9NvrS;n1+qrb{DpJq z(-E7`_pksi;8FA-)U}v{AI-$@ss|xe)J2WQPnb(es5{?Gx6c4mDVu_Dq0}b@k>`6e z9!N+L|GCgNqXHBWf-qIpRbAC`*o0SwmxawV9e@SKyOCR!vPbA9UVH?aFo(&UOdohN zQm9EiThrV$-hOJyzb~P>U zA;odaz%smlvoHtM8PS-_DMgJ{m`fgjA(eGeM;Tfv`vKaLlvM@H3xn0*U>bhK zG#$_cY+{alC4o)gCZ;30^Fvl-{e`vEfn(hUWZi~Ec(WroM0}7&ePGZFyVDqT&zJ26 zm?g~-^M*A*$Md)XNfZNfMaQ1?*>(ilhdM=Au-Xgb0dA4kdBqvE<$>|31qp?O)KJ?T z|A2+c8HWhe0Thu?9f%EuI3!Jlg!f5@6NR-ItRFhu0UgPg3X`&5bq8Sh1!N@#Qg|~T zxZCE%hHWrUDI0}t@CCocx`nh;JT1NVyb{EXSsVS+#>H81Hi37vw}z*uHlOA5UWhm|r)C_IG_(O9d6cv+fMkk-8=(*_0t zTYG{x`_)#6TV&N+DT4y%-G=A&Si#MPXw(P4{o4lKfkl*2?v00YU}5j|h8JGk#>E17 zC* z)qzJ?g;h|6EbcMkJOWF}AzKhSOyk|<0M8410txHYS;&S9M%F}lGetmFY@p-krQ2<= z-oF(p6K>CIeNST0R_~SB_l?(N<{Mu(V{Ss0Gt@#O{^7T2g~DC4p23wNNYFH}eG4cv{$s4J0N30zTzBC4nDU1u))7i;(3D{}ajOaODe| z1#Th-!_;MDrCVTl-a5vHQFyaPAYnb$2X^4&K4#`{VBu$m=9%>dZYX2`K;&vx@-%U1@|0S?m_}|ry;xV4G+rZulodTt~lzmPIO(@&$ zRF3OBOsaVaR#@JHc7?U{0Xjacg^pf%raKDBeX99y8< z6Hx^gL}eW~f?0qUMGBofK zH=6=wUgr0Vhj2g#vWDgwjb<1Y=_g@iG^vLLcmuhH9=c|n`y%4J?$@KOD88n-zkahH z*yPg)XbUp})Ie-ep5l8xk?r2vROqpZtO7`oh1+7~9J;3D;Kejfjx)9}kzBK0HP$(v zV>p&FMp)<$&W3H^WfItdJeKHBe$k5a<3A1uj3(=6F6$SLW{>s;To4v)UY2P%fB+b7 z4l?fKPVUWpQdLkbJvuAE7HqY8TFS|8#cmW1Cjp-G>F7q-gbfb&*_5TB&Q9r7AP5z} zwpeazU=jdXWW5Gp2=dgHGGFdsI?e`cSj!;DV@0HB)wXES|MUlp#%Oe~^4ykY-Ztc@ zmHCipu-&K zT1gqHM7l%K$);YV0_BirS?DI1Xy6=(+aM2SV4z!9Kyvxp28WiiNC0rGJ75co?a)-p zE3xe=Pw=ufYu=vbrA z(Mg9@*h^SWj$7s?cc54cBLX3(Z_!>}Y)JAXr(-C1GjeG1603Pn|7u3O5__QXdAIT_ z-)L!8hmO|w3vlbXpof1)kAPP%GKXot?s`v4H&`%d&eQ}|_-iT%f=k;3artCT0})D? z%N%$G5z*8YkD*5p&ezQxa`@?cZgy%)1SM@#fEFBV?}r~{N{O{m%sid0Vw#X(YJ<6{{a1a#`liK_tj5LZcv8*|KfRLE<1n9X}T4(1Gxw4pZXDO(bWLT)B%F$%W&XE?l^CBF~{K*$tgH zbltqMY}t|1F(00{7)4a}VIVD98rjN8AU^u`FF8Q@L5ph}lART|@I3|UfX$)akt zD%Gl5X>sK`RqE6t566;4xT#hxT4~c7|0(PCAf#Hh=F+v*_U&6LDybkl`CCx^H!W2u9-C(;LHj0=TB$9me$jvTmaIh+MPn}YPIWD zuj0Xq_s;dmYlJ*rrR|Eg7LW8fGS#hb>qlePnf~r2H_rbmuDMmkVTYvyNqVq7#!fp7 ziuDjUn7MP=EMw(x4KUbzwvA{8A(VqaAr4eZf(ZS<%0wyJwqi!*oKp^NBK2m{Z^IGC z5==4~#hi0G`2^2W^e{k^QQ2+R{}fbFWp&keT5W}uc~R0rNqmFl@Pu0Ky@%El9=er- z5wzH6-(7AQQRYFZ{P&k%8Ic2v5RE-jPC5pb^N4_M6){d^4YtGC4wz+TnLC?|HAIG@ zkw(f`K8UDVHc^zALloi2rs9ehr9;j+oSH+2~dB9=?C9t$S!h@FxmB2$4tF-rCmTIB3N|%f^#4IdwjX91j z+;+Q35Dg_H#3thyvCu+7@a0!ueOZ)IDnf`0n?h5_VrQL*rIX4OKM1G;5LC?4AY=r$ zQv?tR1M!5Q6K0kP4n9cy|AQiE^Tq}vRXjcEyCa)b`n>L5fUm(G@AZMJRN z5l0+>MAD2UrDP6pHoAnPajyd4z!%Q-1e8!i5_$Ady!QIfuTm0AY_U_t&*gf~$b<(LX--yY=3gCZ7 zHaLR}`Y9;lnz{2ChMT#`lBa;CNRKP`#FgYU>u1Dtzz^+R(-JR6MN8O%xYh|fCTFY}S*L${TJ9gRL zR&O@9ZS&<{yX~_3|L%Vn;f=T6iP5SYgm+PfjU-qt3=h;Mv8+#CA(mJY}av3-N{ll%}z zDEm!_aT+4c{`mK(|7BwoV~Iim4TwNYjm|coN{2W;qMI?UZY32&)$5GIvsS^xIJx5n zJVJ;x02F`&L%EKTwv)mY9?v{3eBleV<~$fmPlhy{OAQlg!?yV+hx`#=U)t0|@)anE zK};X}iU_|={~|GQ4Rc2}Km$enK}w2{`dFmKVu=D0u$7mh$SXl-8#l$wMIHeOI%w7# zobl3iY2+C<*r>*#!K4~S`&}J{G6oao5lO`3W7K8=NI7$I$Z-RIqZ3v9yQ+HIk8VWW*dV zGAKw?7r~Uc4jrqqATZTL2AhGjQi}(KB|u}A zDVW(Z{~RCLjV^n$4s@8K8|w(pI$ZKl*%b#K5_Kak3@}GJa-b}JU znn+K2O>9OldfRO2^|JR(x5-q8Eqa$t&u2a%4l#X=cI=-4JoVDbk-XQB)d7)M!DJP@C z0rUUuT=P28;Ziee7B(qg`#dVkW=K&Lg^SvV+nL6GKUw z(1a$ll-uk;Dse^mZV{?oEG?&kj5-$?)Eq@7)mH-yoCFmHeOVvbuM&-6z zxmUl17ODk_VZB-t%!b@Bhv}k7G!K@r{NW+46MNI__D!8DZeJ%|yytkjgT^$T98&+; zi{k>GgU3Ct$bAKB5z~Td(x^+FZdPlOuWr>F1QzfGW$VV-U9`%j_9#?Xt!lk`+0`-( z^YoU>QZqvr#QnLo_ik-iHy5aUi4o#X+4;W6<{7BNR@`Nc3TR|28S>~ z>z3HWiv2g8y!+T+13P}gE-$f*4VqAa61aqEqA#qSDSQ^_g~8l(^}iQU4GwTi*%hgboQF?L?k-lE;C+uCfyyrpmG14 zPWfd&9Pj+e~Cfa!T!N;pFK+7tz6uXP4_mR zb>4fQZ+!1iZh$Wzul<{2MaHj%SBs4oj2&E1jRw<&5>nk*)HRjVWuD4(%4l`O#Vrsy zRN4mK(x`wPfQ_HGc^lcWL%F-9SuVMHHD;fuI#q&{lEV2(AR{#g=gh zg9^r8%c)e%r4+o04Xni=z1^K)or!)1~6OGkc1(G zjUgJo;FzVN8QNY99ugZak{j|}+^kvO3E%JuAc_qgWEGv_DG|~U+aLzxJq#l;7UMAD z!#&`GGA<)C;)6aoqdr8VH0nb?P$M<=12$%(Hu^(9_=7io<3Im=V+VH1X>Fa6W!w0f z!&ae$I-&z9z9YJsqAJqdJSG>-wc-rEqD$ppt+C6R=@2>9VI}n&I^`k}6&;=#ot^<= zDKyHCCfGZsRwGq&J2mC5oQLnIl(?UrLe+Jhmiv zJcWIXS$(J?KF*N!$RMr7V%zv*I91o&^qh$S9i8do;kAgQANXCPZQJVO9T{@&B*!|bo6@yEw&Ys6C27*zneF3;)u62b_*r2}u48D5CRC7SE8gUpbyyqD zB_rXR?>$oR`JY~rkH4XhU;gDT`k^OLR&EC4Lqeot#wTL}r$$!gMoK1D<|lGmrazF* zI9B2ng5ZoyCp?a(b><#UYUl2urfP0aT}Dz4#^DbB-_I4^P|hY#b<*G^=z;$Nmfa;NYR+JTs@eXD6NHLWUi#c? z3SOKEop%A@E)v}GC18gRqG9r8MEYhj&Zk8N=Wv$jiFPB3hGaOtL-&c^#w}-nt|VH@ zXc*Gyfp(L2&YCyrWIxK{9I}brl$bygqyRFOE(YP@Y$)TASMv!YluqQ7is&7E|lixnoIBBr2myO(O`C7PqZ$mz=kTd z7Hkhq(nbhr-}qpP9VEEk=43g{#Cm9;hA6rkDrB;2yKd>P`olZ$kcu{^nAWQm?vBd3 z9m_UrTyAHlK9|?p(6q|bblqDxwHc|Js+}@y`V?NBA*pyJWG@=rpH}Q{&MJt?=dEI- zx?bsU7N?@Vt3OyKF>u|N>I>C&rltR0?aC#IT)J%6eiPX4=$rQFT^_9eP3W5~?6#gK zQTl9#0_{7&SYgU)p!z1da%_DnZM*vFNRA}bZlK8;6o5|Zy(;eF>MMg{kIQ=Pc1muo z-QXMcXe}D-&GKN{-s$={Y(CyVuh#hp(^qkpRW-hLb?;5O32U}X5B(* zVrDE<7AlGMt%+tM>$a}zmZUk7ZzX=+i=OYfG42h)V!-+?@5L`I!eQmMh)){tkP@HZ zU8vh8AM=JQhmNZt3NU=yt?B<#DFRdFp<<);pXQ@5^a3fm@b4hpQkaJly8QyQ?wB5n3Auzva~4->;-bl?}6 zBLz=t;vVq|Ch-!_@x6uEsOlRCk5A4DX}{eek#-l`Ua<;da7 z(ne+ugDmUzaNw3C`NA&WL~!|z9~@g52GcPIH*vKZ7GB~SBn2M{`!Tn&Ehc@dAct4n zzUt_@=Kx#m>27QSBkIylvIBcBolxQ$8?Nk5Y9}Lc`hv1*0`CVu@pl?*EoLhpmvE{U zY4QRg@-goL%CZ&{VIu!qY?OkrBcraa>hg&;u=i53X@M_*>PxYnY*`j_93L|>ujWj> zp(wMabp@$wW^MrHRL}0Oo)&V@2Jmjyatu@Ne2Q^olCir2ZtHp}Fkdnevnbe|tP#WW zmBqk3Q!5Vc-5uXxMnEVWR#%-4-z}OjzztxM-kD%7>5CmQ3?uSE*Xj&MW%cgup_23V zIy5DRV=zGQqv{J-ZXFRD*&AbYJZiKu57rGfwb=4s_keUBM=>f(sPSs50$*#t8Jrd5G!wRC<>|u`GHt^XPzho;m+rZ$cT`4p(thl3Z#X6Y3wL}6Mc|qN zUjd;0I4LqNo0<0f(jiUBO==rBG()pFRcHWmtBv#THLLKBBc%c=<%HAf^d4=MKC*jL zwmI`>PdB-frzMnMZiL3^PxjyMS=T8KZ+7om;1OTLru6!F?&rd?U@qiK|EYNc`C@{z z^%^P;7kQ$V@rDO?oHvD>&-s(nb%0a3h#}S~x27JOGGL#ozhSjjZ#9_n?;!WdgNN=c zKPdrAq;3iAYjKV0GdK~U?kp3Q?V{5KyIl`j4f#4$HCGUa@ zvQdh+Wo#&UyKt;_u{SFtq~r3sPP$q5D%19QS_}8D2YaVK1+iO1iw9}nWcl5wmy@$+ zcfu}~P^QxfS9?*uvXXvvk8?AvD>B}yxfpkBn;*HaH$0Os#ip}+z9tF9SG>hvJjQ3d u#&0~wcf7}cJjjQ<$d5e9m%PcJJj$oM%C9`jx4g^0Jj}_SH?VsX-8cH3uo)@6CyYkJmee%pF_$#H(xU~lqZaP?w!{$+XpYI*c( zeg18L+;f1|bcEY?h~IdJ+kA@KZGr!BhvamMf`ev#yPkm!Ap|A36!hLqommfwq*-+_$mfQ|5lmE?q)>xq=@i<;zzl=gy?|AwCM zhMND0mhp&}|A?RPikttGp5&9A>yn=Hke&aGpzMsI@QkAWlAz?3rtFuf?3$|UlBe*K zr2mwu@RO&by?xd~orLyd;wBxF@>aMx(qqOm&wEw2K^P#%?pt}E}y#J-S|E9eA zrM~~Gw)3d9{j9q1s=NNRyWz9D=(E1@u)hDi!_>XS*{8t&slorP!TYSj|E0qwL+Q;Mcw7+Oy)> zyXoAs>fXEX-lOo}sqx^S@8GTO;I!@GyYk?p@!_lS;A}tS!Oi~5(B#X~>ciCj%hU79*8R`e^~>7+(bVG5)#%mP<<;5j+uY>Y-0INR z^w8J&)Y|mX-Tm3$^4;O=)!_f#;_}+${@>{TKY+=IHJ0?Cjy@^5yCC+qZ7P z$(>6VoVdGq^Xk1jt}ng6fCCE-Y_D+Pdx#S&UYxJ7GLd2qn^3iX6v1=V+Wm0JLzrQx_9@! z3jDY5uf+uj)^W)dxZGRK)dk&x(pBf+U)LR`U3T4Z_Z@iTWvF3!1EJ@kX=q*NK1v5?CN|2ga4)Tnj?i;DgmgXwQTcR`}S3l5ObZ zllz#b5*k!ec^-%&!bD!t?x`4e*aWKUpNIBZ=%T>J;^?CtqBQBTm0Bv| zmhWvUU#GNvN~WlzPE~4f!l9b#s;tI2r(Li{=hv))8ENaSkIl2IuD-S#EU?3JCgrj8 zCVSeYBsLr0v(VZHYN%#b>)W-QoT{x@ZgM+KtKWtz?sVkRdfmC(Id;#w?6!O8yYR-V z*}U{lYHx`6wx_R8DXPe#QPScUaJ2*%obAB~tEw=2Co*W48|Y`m zx5(O=@OzP4qIM*Cz*JDuU6yPhCavh9k!dkC%!7{?zbH5j!srsML*}mKcMZCFgd>DDkqFDZ$bNgDK1$R!xvDquzczC`46?5NAF57PwxS#8|pf zJHxPME$LYQNlVJ2o8HVLIQ6zS8{Tkg!<5Y^TVzaA_J*CQG~+uL7SDz?@@$X%hBdGG zCv3jLmfG~^Kf6f~lMFOHo%Ccd0jWcDrZazqBx5_>`Oar{kDhEq+dUUUkBv^Uqksab z#zZQMk>0VSEdeKplo!80I*XXm3!^&MiAoR-XqB_8XbGbUOWf^LF+O#oN3ofTRP^(O zMJ=i>cPS7MU1_Pm+#(mtNxyRzQ>s5SoJ=DcyJqr8t4GACBfnbBu!3T&9W^U1(VA9S z#E`8ffU9JeIzcUcvWp27rPZ$1(5XJOs?5Y{Ru3dk0d|#ugylt8#R}Aps$!^$YQ>^t zyQs$hrWK$8jqGG6TiFqjlcjcz>a-mC*}X0kkrPd$8U>5duWEF)hiz?HU+b$x$+i{O zjRkgVYulpYmLP1{EnItR+21-(p_{#*5A!<4G}*|ie(e@u8OdBFVka>@T`g-r>RRd! ziWP*qE_MYxVC}}j72S1(E517rnTVIXzBTW8HS5yV!Ss~Mgs*6eINzIc^|UD5sVMZz z+OmE$6{_$rEC9@k?GE_GFIF&u5nNOSuNAUciYtUM#U+Gh7AUAo9bPX?RpTC)rXp1C zJU?7duip0_qKLA7O-$t!6G|1V$TEz#JYX5iSQcJ>ERG?(V;z1u^tNyxNYm2sY(Xi-t~?Wz-?eN z$D;MMr(xuAY-Ia%+01_JptG!xT}ZnX)XuoI8;tFys%G2s?luLU`o(es;N1TIDy6ys z!0t1-8vrwicgX3T1lZ}D-(%4czyToe0udYl21gLWKb+GD(WBuG-zdZbP3Tb&`X2f? zg|stH?HiA|<9^gOw`=f(C)i*C-5$Y@fgCuKqnxvNU3tr8v<3)RKr8YNfEngKgOvlI z3uPqBz5&qhu;@JCZ~A%AeYDkZN%KJwayrtJ4RL2X{qgXS%%Q2CaWP*V>lDNk$e+*} z3(#8(XhyG5%#Q9-UPA3|#!B3`5&?7P`{sPlxy^Ro^W+FV*h4owh^J{7TqwTbj9<3n zACC>m7bU;{_deUOlUAr}B(5EUz@gx#hD zQ(*?)W(G26f2_xE`!{nW5EgqEast2vX|Z!)D28bvfo>rIGxq{?G6UQ;0NyqPc5-+Q zQW)XTf-0zVEQo^MQE}KMbuxwuG$>>1unvrtTQ^ZzIY=VVCrnfSKyN?c2Kl!DBQOFK zKyPa>dggW%`G)`{Py!XuiB8yU3-F06hX7L%2`-R-R!DzXs1dn1Xy3d??m}kr8#Ra0;iOV5lI7gII{`V0DnSi1KJM(B~5-7XUzUi2y(W^DzS4 zMgf|5ax4>fgU}RUkbhYK6)Oh(VwRba+i#Qh+AfSN3$Za#A z799xy5s-{P=N47KZ3;jadZ3cj_=by6Cv;ecrBIW2cx)U0B?^1!boEe<=y(c(xQ^^d zb?)enmKTrnn3S2ad9QJgKoNIqKz5H1cL8~Bk`Q;eF_I;qkn2_zBMAf$$!!uzk+A4` zVPOeLuxcbQeHs~iXDI*xAOIf;b84{(a5(@tBZ17w1$ChS+?EOAP>tCbBr{nZwNR6# z5DGUbW!9vVWz~Y;uq62altL+#L|K&Xc!-Fol#AFJOz9I!KyQQ~2HjQwrfHf_Se2ZG zl}>R3=EjvQR~03|Z6y$v05F#I_ZuQGeal2^A%_5M*>_(9mjJ*A)39?PsTRZujNKrC z(a3?&S%KUZlhr7PGP#Y_aSe!RlPHLjjj3!XI1Eewq7Uy-nUzUxn2DL1Nf4ZwgYN-y zQ}7zLSOA1zax+J7s;LyLX^^jZdR<8svk3sTITaCkg*CErFmNMJ7=Pv#oPHM#D`%X@ z8G!}2FwS|O-A0| z0`*C6m6)SB>H<|cCi}@0u6c5>xptTkpaY5t1?q}h(FNV+2hUKA2oPt_zy}Tb413pi zW&xK1kO{{Ll52675ZIi`*bQ(v04G3}ekr!p*Jc0O8vFH!-tIi#{lo3@FYuZR_= zsG!`&2Vp^_C+DC8VhLJ0m&u71n^2~CIi`LI0C;djYzhDzI)WY=7;&1bbNYDUXia!J z3Tp!ylEJ5_U=GIWr+-?MM=7X-TBy;-ZCbz+TA+^rFakjVcKb*lN`MrQ$`n6(kldD# z{u!G9%5A4cpkisDSkVP`=LMcBjb2!#d)I{nGLj%Lmn0yP+;*>SA%R4olF`7DbRrJ3 zTC3W4HjO|ExhkjIS*OV6n2$FP-JuWpkfO(WtjSuGnz@-U>a3VGgxKe8{1_CWNpBZ0 z0vB+7NI{zQcN?AfiR#B~3lJlySFQm6aITz?q!USR*XM0DcOz?Ae>3m}wm7O*+HD{J z10X=00zhY7y00^^v~NgfX~=CS@D|ZH03bk&ewl%5+NK@aWDn8|p5O@!tE)9hr@!~G zsUQkYXAKoXo|SpAbZe{`yRifT2ukU(J{AZ=NQ5>T8#Vxi-39|lk$)B7t@nulQc<&0 z5uiA$vxIAIc(+VD>uo&?uU|NC0$`kT8FIe{Pt`a8c;FU?5RLOD0pL=w*D1Eu5e~i( zyJw5G=*X*V>vXrEBo$Yzb=$jl>!JeTtOv!nXT}p0aGIt$0!jclYp`kScLTI>1J_pq ziW>l-czpY>fB#%$ciLj11y$i!7-#)ZQsg zrB^rX$U4lZl<>1HJED$CQ%P1|&2)$-K)Y2}E z%U~SFs4~WnY{tHf#?{dby|C52kkjxS48K4OVqFYlJq+^j({cL_LJiWUtPX#iTSxuE zNv$G5#?&mW$gN{7F@tY>B~cF@$%QA;4ss1#UD&_S)nc94ioMvw(Ad_182Su@yMPXq zjSg!~&29bG1OXH#J=X`l)OLN>419n(o>)$Pn=)gcaBEex*x+OSOwubtS!Alr@I z*wkkQa|h1G)r+t{7m z*?rr%O%3S(!rQ)G48c9#`m989oh>0)KKkSQa#nuEnn14U%&hp z+TGu<&E4JY-MbCS`4HZ}UEbw=-tF+#xz*msO%!z_5% z$cxO#*K!6JaO6jh2)Z0!X@LlczzL9ydx71$RA2yBZsi+r4JH2HCm!I`kPUpo+r#kU zWFFo#4%{`a*#m*&pN-H$-~kwL00(g8a*hEsa0V<*;T8VHY4QVCZskgj!+u2t8UW%} z4&n{}paCsF18x%5LJ;5bP1@Ij0e{W_OHM>W5b3S{=MCWK)y-9!(CSCv-C7(PXO0f)P3r8e<2t@sG_dNs{^tkK2d3BD&b`+R@aGtC>pP+W*)HiS;OqJ=(c_@& ze_jRKUF^o5>B+9ol7S7({^{wE4rk8bxkc@d0K))(>RP-3=g#T}(CwZTQ->4oSH1#* z?my;!@K;U+g!k)$?dN}<0bDNcUY_Yk!s#uJ4J4oMWWMkFUf%vr5Ch-x0I%E+K=G3Q zz5>JL#TNeDeIV&h5b*`#0WyE+jh?_5KgkgD1Ch=EC}0b&?eW~5=}sRG6Qbmrx1skCD3r*zv(*d;}_sG!#lHLG)FhXv@3@zXUeGg5l&EJF%;D(>+x}EsEtq+UO z_>FJ%#sK;I9_^HG`6|5vt-b@CpXVDC`l3%p4sYeQZrW?%?pE#uYN2EuPV|8PQTv5| z`_$kJd!p?6a1D#!_*DP+!td|7W&Gg01+6Xw>Q(dJZqCo$713`1;~rW&V*Lhy2mmon zU^jvV3xY$KP$5Eb4IMs&=y2Rbdh~D&!!Kr8(%FM&M$` zi1-?4z}VpAg`CP1RspWzGb}VVeBSVbQABYQ$7#~EC(mlu95E)Ub0o$8F^|WVq&Tbs zOEi?dTmDw5Z&*y3H*fCL>GS7N=FOc0Rk~E_bm~ooJT|bQ>vpeUy<-xjf&q4`7`C*P z8+S~H@#HbAczi~%;5HuGlV>1=@nXl16;GRtvViYmSi=!3iMyyFoQ z9X2G-02SOy?=AR(L=utt{^I0FB(2h5KY<{uDoOwYBxoTG3Z#Nc@)}^~p@}pJQbGzJ zO94piu<$KJmPRa5rV~-b2|1tQfiX|#WTdfANhCP~I}dd1ipTH&Yu+P!mZHr1a8&7O*@>p%x$|PX&o43M0r2ctI5-Uh)8yJVR1)(wTglxNEPy z=Bkf_`Pzceg&D@=2kdrei!F++VnD7Pu*2XCPCCIG?`rw-OE3?x)8LZ7q9J^mK>1Rc zvBR-zfDwbf1s6LfNb^$XiMU~xmkb_D1XZGo#x8|QoCyad9kA;F>ZnK5hU#mwvHI2) zweFYeuW$d8&@CQ2K*zJcVoQ(>TWGtj4cmYVkqt3;D{tp%c&rb>r~o{$!l&uas>B(a z`^zvoUFhwq&LB-3wfVAKoXmN#P{PkYx8gAtnsLUO4?B=o^?F(7#&y_ZuL+)Lx2xzB z%YZt99$zr9qu*VkE#fl(28!1fj8z2+a1oXP7$AxNyEzYU&!`{+=CdWf#0@Zni-tfx zg+3_>q*Ot2LN_1>4k|UEeBzM8W2i8Z^(Epl8F=64knk8iIO7%{y2oDlGOwuRV?_GU zM*pamjsL}NfVES~0kz1Lzwsqu#%f^kHWaZ5j-`SI*a2KNvV@GtEX%;K!F1?#17 z8Y{F)131w_f%Jh~nwlY%G;qVyp>G_GSYQ13l7k=;jf7QUfHRzdM3XelDokA6OSrK~ z|5Z_6S0rE-x46YK>R=KLL|a>~qrft{<&0^ZON83!#_Ux|Fd1Zk69j<>UY^W8*l7VD z7sHH4KE?^(y2N8>a6_CKKoibbA1{vZm?bp-vKj3o2_^4g$*N#-f5O?M6!AqxPtpmL zx+>r(wOC42I&gx`6hbTCa>fgC0)L9?pc|hdM+5W?Fwsg>1D+wwfpi0p1>(d)sK*y9 z+^~k2i{|F|k_T&ACuMtIh75FiNL74am;lwGtB>T1)Zb zaz^BFVnccHU?%``zMKgLph(gHA_#gVf-LkgnNdgrt#XO-MWcq%L{!PCA8%B6iAv}p+?k<-AOQAvPNV!Sk{gP|6* zATKP?GZa!x86a185+vL&)S#pB4C8TR$;24;^LNZzmXu%%)iY24wOd&PAVGj9%gJ{0%F&wZa z2bS24$o2*ckLf{WHF?>ug4H;kMX6H2qD54m5d%Fk?O0H&TDd5-Dl2%)YvHC(z|_(J z8W2ov-#e)vc;GNXpu#2kx)@G%!%Hnl2q%up%%ElNbJOGt60BLw2Q;@g_q2*3xH=4J zTvnvS(QG-ffnBm{x1H@QB-{i6yzsVVyhKXRhMeWv2(kAsAwF+>WmdB5?N>_uE#`X@ z!q3T-&r6;2+~<_b7d=#zLk>RwNmiFAU41|!iqsuvhL6Kx7e(j8?cCi_OI$pDG62PL zdkpj5BHs<>Z9W_F=U+kwHx$~qh5hYDj(?C4o>qmaJ}%+V-q$`#G?J?5)8;)6YJli+ z)yWpV@ar;MMX^$uIaarTzZb*dl=^~U=y`M{1NlKh(z|1&hh)g9EA;2x4aIG@GMjEY3 zjdVs19>W_X#>^^({^m>n4vpw28ynes^6;|3I~GW&31Wg^%Nc~gp79kA!rGI|7Q8Kp zxO5_e2KZQDoB*V6(+6~YFcv%kMRM% zbIgO86df5|u(<{RXq;#a+`W$W#vLmfle@AFpK$>>j#(*Cc?119f zp+d(y!B0qHKnG{9-jc#y!o%Fh-21UPq!5u1_x^yu6Sbzk`C^42N|NMtR}%va0Sy#3 z-tmri`qMGIXzMQhx>toZ(he8reH>J24$PV%70h%05lLlGNY}}S z=UgxNF^YJfBrEa%Q~VSH8jOE@@KG3fV#kE?mA5=LXaUO1Z+^?oei8-{L0(Rr5lIZ7 z8Rns5i^QwrzPJSyP62w4>LC@+9wfE8dA?aL|Cvx*hSpi`RVt^rpt67SzGhmPVU;q!0j}mU?lpHKW8W=1|WkLSi)uT zfGdze8Kl7)v_Z^LwEqJ@%R8s$^TEwKgG|iCOEbbFT&*@}gC|tG*bGvmjPq_J`PN20cn3PFI zq{%k3N#nyw&Nx zlndb`PHZ&J#8gejRL+TT1gCV)=ez?SkWcx{1ZSYmyTnV}%uVeqr|wh=@dQw^B+v3J z&Z0a{f8a)K7Qh&&u=9qzKRqrAFZ#P6Az$^F+^XOi3YSFMUxe>MZXpQ{X&PG)>bwTGMS*Odfqx(-?<2rPIo+ zO(I=OJ$=zWCDT78%qJaG94*vUJ5)qfP>LAGMy*p7z06j_&Le%%7?n{=#m7Ju)Jz>5 z5H-|Jtx_wc2zuxSmK4>7Bvrgz%Tq;F{_M@aWK~ae)mMepkla)^Q_RJzRku{sijdZ6 zrPgY#2z$WRYz;Id@~9{B)_p+606Efw%PtHp)*21eWIfFsP0jRl(?m55Yn4}P%~oyQ z);0;YC)$U6XfrGsS8}bgN@dk!ElqV53|VDUDt%U^jMsT}SZS?SY`s_id=0p7eTOde zS9dfifNc&xZBl~uNQ3=Qgq>9cU09Ti)`xZ2h()qM>sD_a5ugx;8p~K^#5#^O3Xc^} zkR?TtRnukVRCj&X9!*)5omZBfSXjx|m<3mw6<2q}*<@3SylGXQwNalPS)dJClO0;3 zy;Y-?SENl^{i)b*ZCc5AT4jt{gi8vmb=!i)+MiWRKBCp+{M2y(+prbev3*&X1qyyu zwf=(IwSBayeOrQ!+r!jaX06++iKn0r0rY3-G_@s+nVLSjU`;7h>pX>)WlWX zxux62t;IKmQ@o8_$&J{tr57eM+kKc>faDaL?Oa}IThMhL(LGE5WF*}iGu;_N-PB!O z)~#391rgYdU6B;rN4#C!H37HfT>|yp-_2a1Jzdl-+Ty*|)^%Nv`Y6i<3g&HI{(Ih> zRf_4I-s-hpQ*BenecZ3*UW}UDiLKn&-3Q>UT^l^#qKFRlO6=#4c_2pMM_(&Vbz`A?mb@Q zz26cB3Kag~O$y?F8Db*#P$NF#8Kz;cwc#5UVZM!GeIN?|Do$Y_zTz0kVl6gJE^c2A zPGThn<1mg~9ERdDCJK1i4-Q5&3a;Q5c4NbY<2Xj*IUZi(ZDJ?3*AZS?Dc*+@zTWZ; zsTF47HXda2EM!9t-Y>4>MP_7)&0`Wa<1?OQIJ2-d779VmHPKsdu*3Q3k>#k?#_zT|0c z<=|Uqb}r^@*5+*%V`a8qdN$>8CTDJl=3nM#E%xXCeIRo@Y{K4v&83aB662Hi3~Q>5>*EigxFuJZ6l}Xi>i9 zvej3khzEr(Uvoa^ht6Q(!|7MlX?IR!A64l)W@(o#V{j&lqQ2*t#)p{}X(*+^re@re zM(LiO>b$k(pcZPZo@wm*>Y>C_u^wx(_EfWG;&^`IQO4!AMz-i6QvH+bDeYtfhG)Fa zYj56bzIHUf{_DWzWV)VZ?e*!O&S4$iVewUL4vP*w&;!TzY?#JosE%qy24(s+=!53y z%%-xLj3ogQtezUxI!YqfTh28Lud)gII6@a^9Q?%)>g;U@0lHtyp_?&MbP j89@Lw(jf3?(Ej??dI<34hR4{LLDs$ diff --git a/Src/UAppInfo.pas b/Src/UAppInfo.pas index 7b6d1a45b..e27ab1ae2 100644 --- a/Src/UAppInfo.pas +++ b/Src/UAppInfo.pas @@ -36,9 +36,10 @@ TAppInfo = class(TNoConstructObject) const ProgramName = 'CodeSnip-p'; {$ENDIF} {Name of program} - const FullProgramName = CompanyName + ' CodeSnip'; + const FullProgramName = CompanyName + ' CodeSnip.Vault'; {Full name of program, including company name} const ProgramID = 'codesnip'; + {TODO -cVault: Remove unused ProgramID const} {Machine readable identifier of program} class function UserAppDir: string; {Gets the CodeSnip data directory stored within the user's application @@ -162,9 +163,9 @@ class function TAppInfo.CommonAppDir: string; } begin {$IFNDEF PORTABLE} - Result := TSystemFolders.CommonAppData + '\DelphiDabbler\CodeSnip.4'; + Result := TSystemFolders.CommonAppData + '\DelphiDabbler\CodeSnip.Vault'; {$ELSE} - Result := AppExeDir + '\AppData'; + Result := AppExeDir + '\AppData.Vault'; {$ENDIF} end; @@ -195,7 +196,7 @@ class function TAppInfo.ProgramCaption: string; begin ProductVer := TVersionInfo.ProductVerNum; Result := Format( - 'CodeSnip v%d.%d.%d', [ProductVer.V1, ProductVer.V2, ProductVer.V3] + 'CodeSnip.Vault v%d.%d.%d', [ProductVer.V1, ProductVer.V2, ProductVer.V3] ); {$IFDEF PORTABLE} Result := Result + ' (Portable Edition)' @@ -236,7 +237,7 @@ class function TAppInfo.UserAppDir: string; } begin {$IFNDEF PORTABLE} - Result := TSystemFolders.PerUserAppData + '\DelphiDabbler\CodeSnip.4'; + Result := TSystemFolders.PerUserAppData + '\DelphiDabbler\CodeSnip.Vault'; {$ELSE} Result := CommonAppDir; {$ENDIF} diff --git a/Src/VersionInfo.vi-inc b/Src/VersionInfo.vi-inc index 70615f76f..c673ba417 100644 --- a/Src/VersionInfo.vi-inc +++ b/Src/VersionInfo.vi-inc @@ -1,12 +1,12 @@ # CodeSnip Version Information Macros for Including in .vi files # Version & build numbers -version=4.24.0 -build=272 +version=4.900.0 +build=1000 # String file information copyright=Copyright © P.D.Johnson, 2005-. description=Code Snippets Repository company=DelphiDabbler -name=CodeSnip +name=CodeSnip.Vault license=Released under the terms of the Mozilla Public License v2.0 (https://www.mozilla.org/MPL/2.0/) From e0242eea124dd94b9af1d6daca331334fabd5003 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 12 Nov 2024 08:56:53 +0000 Subject: [PATCH 075/222] Enable snippets from "main database" to be edited Several files were altered in order to do this: * ExternalObj.ridl, external.js & UWBExternal.pas were all modified so that the external object's EditSnippet method could take an additional parameter containing a hex representation of a collection ID so that the Edit Snippet link in the Details pane would work for > 1 collection. * IntfNotifier & UNotifiers had their EditSnippet method modfied to take a second collection ID parameter. * UUserDBMgr had several sections of code altered to (a) permit "main" snippets to be edited and (b) to handle snippet collections. * TEditSnippetAction was overhauled to expose a snippet ID property instead of a Key property to enable both the snippet key and collection ID to be passed along. * DB.UMain was modified to permit "main" snippets to be edited. * UDetailPageHTML, FmMain and FmDuplicateSnippetDlg were all modified to work with the code changes above. --- Src/DB.UMain.pas | 2 -- Src/ExternalObj.ridl | 4 +++- Src/FmDuplicateSnippetDlg.pas | 17 ++++++++++++++--- Src/FmMain.pas | 23 +++++++++++------------ Src/IntfNotifier.pas | 8 ++++---- Src/Res/Scripts/external.js | 11 ++++++----- Src/UDetailPageHTML.pas | 4 +++- Src/UEditSnippetAction.pas | 18 ++++++++---------- Src/UNotifier.pas | 18 +++++++++++------- Src/UUserDBMgr.pas | 26 +++++++++++--------------- Src/UWBExternal.pas | 17 ++++++++++++----- 11 files changed, 83 insertions(+), 65 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 16c6decf1..4045f7d87 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -946,8 +946,6 @@ function TDatabase.GetEditableSnippetInfo( @return Required data. } begin - Assert(not Assigned(Snippet) or (Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID), - ClassName + '.GetEditableSnippetInfo: Snippet is not user-defined'); if Assigned(Snippet) then Result := (Snippet as TSnippetEx).GetEditData else diff --git a/Src/ExternalObj.ridl b/Src/ExternalObj.ridl index 22c549d50..b60a9553e 100644 --- a/Src/ExternalObj.ridl +++ b/Src/ExternalObj.ridl @@ -63,9 +63,11 @@ library ExternalObj /* * Edits the snippet identified by its key. * @param Key [in] Key of snippet to edit. Must be user defined. + * @param CollectionIDAsHex [in] Hex representation of snippet's + * collection ID. */ [id(0x0000006C)] - HRESULT _stdcall EditSnippet([in] BSTR Key); + HRESULT _stdcall EditSnippet([in] BSTR Key, [in] BSTR CollectionIDAsHex); /* * Display identified category. diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index b43e946cd..7628dcd56 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -77,8 +77,17 @@ implementation // Delphi Math, // Project - DB.UCategory, DB.UMain, UCtrlArranger, UExceptions, UMessageBox, USettings, - USnippetValidator, UStructs, UStrUtils, UUserDBMgr; + DB.UCategory, + DB.UMain, + UCtrlArranger, + UExceptions, + UMessageBox, + USettings, + USnippetIDs, + USnippetValidator, + UStructs, + UStrUtils, + UUserDBMgr; {$R *.dfm} @@ -217,7 +226,9 @@ procedure TDuplicateSnippetDlg.FormCreate(Sender: TObject); procedure TDuplicateSnippetDlg.FormDestroy(Sender: TObject); begin if (ModalResult = mrOK) and chkEdit.Checked then - TUserDBMgr.EditSnippet(fSnippetKey); + TUserDBMgr.EditSnippet( + TSnippetID.Create(fSnippetKey, SelectedCollectionID) + ); fOptions.EditSnippetOnClose := chkEdit.Checked; inherited; fOptions.Free; diff --git a/Src/FmMain.pas b/Src/FmMain.pas index 606a035a1..00293661c 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -528,10 +528,10 @@ TMainForm = class(THelpAwareForm) /// Displays view item from history list given by TViewItemAction /// instance referenced by Sender. procedure ActViewHistoryItemExecute(Sender: TObject); - /// Opens a named user defined snippet in Snippets Editor for - /// editing. The snippet name is provided by the TEditSnippetAction - /// instance referenced by Sender. - procedure ActEditSnippetByNameExecute(Sender: TObject); + /// Opens snippet in Snippets Editor for editing. The snippet ID + /// is provided by the TEditSnippetAction instance referenced by Sender. + /// + procedure ActEditSnippetByIDExecute(Sender: TObject); /// Selects a tab in the details pane where the tab is provided by /// the TDetailTabAction instance referenced by Sender. procedure ActSelectDetailTabExecute(Sender: TObject); @@ -760,18 +760,19 @@ procedure TMainForm.ActEditDeleteSnippetUpdate(Sender: TObject); TUserDBMgr.CanEdit(fMainDisplayMgr.CurrentView); end; -procedure TMainForm.ActEditSnippetByNameExecute(Sender: TObject); +procedure TMainForm.ActEditSnippetByIDExecute(Sender: TObject); begin - TUserDBMgr.EditSnippet((Sender as TEditSnippetAction).Key); + TUserDBMgr.EditSnippet((Sender as TEditSnippetAction).ID); end; procedure TMainForm.actEditSnippetExecute(Sender: TObject); +var + Snippet: TSnippet; begin Assert(TUserDBMgr.CanEdit(fMainDisplayMgr.CurrentView), ClassName + '.actEditSnippetExecute: Can''t edit current view item'); - fNotifier.EditSnippet( - (fMainDisplayMgr.CurrentView as ISnippetView).Snippet.Key - ); + Snippet := (fMainDisplayMgr.CurrentView as ISnippetView).Snippet; + fNotifier.EditSnippet(Snippet.Key, Snippet.CollectionID); // display of updated snippet is handled by snippets change event handler end; @@ -1415,9 +1416,7 @@ procedure TMainForm.InitForm; TActionFactory.CreateDetailTabAction(Self, ActSelectDetailTabExecute) ); ActionSetter.SetEditSnippetAction( - TActionFactory.CreateEditSnippetAction( - Self, ActEditSnippetByNameExecute - ) + TActionFactory.CreateEditSnippetAction(Self, ActEditSnippetByIDExecute) ); ActionSetter.SetNewSnippetAction(actAddSnippet); ActionSetter.SetNewsAction(actBlog); diff --git a/Src/IntfNotifier.pas b/Src/IntfNotifier.pas index 5269ef3a2..c24d19c40 100644 --- a/Src/IntfNotifier.pas +++ b/Src/IntfNotifier.pas @@ -69,10 +69,10 @@ interface /// Edits a snippet in Snippets Editor. /// WideString [in] Snippet's key. - /// Snippet must be user defined. - procedure EditSnippet(const Key: WideString); - {TODO -cVault: lift restriction on being user-defined. Provide 2nd param - containing snippet's collection ID?} + /// TCollectionID [in] ID of the snippet's + /// collection. + procedure EditSnippet(const Key: WideString; + const ACollectionID: TCollectionID); /// Opens Snippets Editor ready to create a new snippet. procedure NewSnippet; diff --git a/Src/Res/Scripts/external.js b/Src/Res/Scripts/external.js index ffaf18be5..faf53d1f8 100644 --- a/Src/Res/Scripts/external.js +++ b/Src/Res/Scripts/external.js @@ -46,8 +46,8 @@ function displaySnippet(snippet, userdefined) { /* * Calls external object to get host application to display a named snippet. - * @param string snippet [in] Name of snippet to be displayed. - * @param boolean collectionId [in] Hex string representation of collection + * @param string snippet [in] Key of snippet to be displayed. + * @param string collectionId [in] Hex string representation of collection * to which the snippet belongs. * @return False. */ @@ -70,12 +70,13 @@ function displayCategory(catid) { /* * Calls external object to get host application to edit a named snippet. - * @param string snippet [in] Name of snippet to be edited. Must be user + * @param string snippet [in] Key of snippet to be edited. Must be user * defined. + * @param string collectionId [in] Hex string representation of collection * @return False. */ -function editSnippet(snippet) { - external.EditSnippet(snippet); +function editSnippet(snippet, collectionId) { + external.EditSnippet(snippet, collectionId); return false; } diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 1710e1e02..91abcffc0 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -535,7 +535,9 @@ procedure TSnippetInfoPageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); ); Tplt.ResolvePlaceholderText( 'EditEventHandler', - TJavaScript.LiteralFunc('editSnippet', [GetSnippet.Key]) + TJavaScript.LiteralFunc( + 'editSnippet', [GetSnippet.Key, GetSnippet.CollectionID.ToHexString] + ) ); SnippetHTML := TSnippetHTML.Create(GetSnippet); try diff --git a/Src/UEditSnippetAction.pas b/Src/UEditSnippetAction.pas index 8763da475..54c6f0df5 100644 --- a/Src/UEditSnippetAction.pas +++ b/Src/UEditSnippetAction.pas @@ -17,24 +17,22 @@ interface uses // Delphi - Classes; + Classes, + // Project + USnippetIDs; -{TODO -cCollections: Add a collection ID property, or change Key property to ID of - type TSnippetID.} - type - /// - /// Custom action used to request that a user defined snippet is edited. + /// Custom action used to request that a snippet is edited. /// TEditSnippetAction = class(TBasicAction) strict private var - /// Value of Key property. - fKey: string; + /// Value of ID property. + fID: TSnippetID; public - /// Key of snippet to be edited. - property Key: string read fKey write fKey; + /// ID of snippet to be edited. + property ID: TSnippetID read fID write fID; end; diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index e4fc727b1..cc8dc7c23 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -116,11 +116,11 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) /// Edits a snippet in Snippets Editor. /// WideString [in] Snippet's key. - /// - /// Snippet must be user defined. - /// Methods of INotifier. - /// - procedure EditSnippet(const Key: WideString); + /// TCollectionID [in] ID of the snippet's + /// collection. + /// Method of INotifier. + procedure EditSnippet(const Key: WideString; + const ACollectionID: TCollectionID); /// Opens Snippets Editor ready to create a new snippet. /// Methods of INotifier. @@ -216,6 +216,7 @@ implementation UDetailTabAction, UEditSnippetAction, USnippetAction, + USnippetIDs, UViewItemAction; @@ -266,11 +267,14 @@ procedure TNotifier.DisplaySnippet(const Key: WideString; end; end; -procedure TNotifier.EditSnippet(const Key: WideString); +procedure TNotifier.EditSnippet(const Key: WideString; + const ACollectionID: TCollectionID); begin if Assigned(fEditSnippetAction) then begin - (fEditSnippetAction as TEditSnippetAction).Key := Key; + (fEditSnippetAction as TEditSnippetAction).ID := TSnippetID.Create( + Key, ACollectionID + ); fEditSnippetAction.Execute; end; end; diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 743f027b2..8c27ec6f1 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -19,7 +19,10 @@ interface // Delphi Classes, // Project - DB.UCategory, UBaseObjects, UView; + DB.UCategory, + UBaseObjects, + USnippetIDs, + UView; type @@ -46,10 +49,9 @@ TUserDBMgr = class(TNoConstructObject) /// Enables user to adds a new user defined snippet to the /// database using the snippets editor. class procedure AddSnippet; - /// Enables user to edit the snippet with the given key using the + /// Enables user to edit the snippet with the given ID using the /// snippets editor. - /// The snippet must be user defined. - class procedure EditSnippet(const SnippetKey: string); + class procedure EditSnippet(const ASnippetID: TSnippetID); /// Duplicates the snippet specified by the given view as a user /// defined snippet with name specified by user. class procedure DuplicateSnippet(ViewItem: IView); @@ -110,7 +112,7 @@ implementation FmDeleteUserDBDlg, FmWaitDlg, UAppInfo, UConsts, UExceptions, UIStringList, UMessageBox, UOpenDialogEx, - UOpenDialogHelper, USaveDialogEx, USnippetIDs, + UOpenDialogHelper, USaveDialogEx, UUserDBBackup, UWaitForThreadUI; type @@ -279,13 +281,9 @@ class function TUserDBMgr.CanDuplicate(ViewItem: IView): Boolean; end; class function TUserDBMgr.CanEdit(ViewItem: IView): Boolean; -var - SnippetView: ISnippetView; // ViewItem as snippet view if supported begin Assert(Assigned(ViewItem), ClassName + '.CanEdit: ViewItem is nil'); - Result := Assigned(ViewItem) - and Supports(ViewItem, ISnippetView, SnippetView) - and (SnippetView.Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID); + Result := Supports(ViewItem, ISnippetView); end; class procedure TUserDBMgr.CanOpenDialogClose(Sender: TObject; @@ -439,15 +437,13 @@ class procedure TUserDBMgr.DuplicateSnippet(ViewItem: IView); TDuplicateSnippetDlg.Execute(nil, (ViewItem as ISnippetView).Snippet); end; -class procedure TUserDBMgr.EditSnippet(const SnippetKey: string); - {TODO -cVault: lift restriction on being user defined. Change to take a - collection ID as 2nd param?} +class procedure TUserDBMgr.EditSnippet(const ASnippetID: TSnippetID); var Snippet: TSnippet; // reference to snippet to be edited begin - Snippet := Database.Snippets.Find(SnippetKey, TCollectionID.__TMP__UserDBCollectionID); + Snippet := Database.Snippets.Find(ASnippetID); if not Assigned(Snippet) then - raise EBug.Create(ClassName + '.EditSnippet: Snippet not in user database'); + raise EBug.Create(ClassName + '.EditSnippet: Snippet not found'); TSnippetsEditorDlg.EditSnippet(nil, Snippet); end; diff --git a/Src/UWBExternal.pas b/Src/UWBExternal.pas index a8f82be92..10995e94e 100644 --- a/Src/UWBExternal.pas +++ b/Src/UWBExternal.pas @@ -71,13 +71,17 @@ TWBExternal = class(TAutoIntfObject, IWBExternal15, ISetNotifier) /// Method of IWBExternal15. procedure ConfigCompilers; safecall; - /// Edits the snippet identified by its key. - /// WideString [in] Key of snippet to edit. + /// Edits the snippet identified by its key and collection ID. + /// + /// WideString [in] Snippet's key. + /// WideString [in] Hex representation of + /// snippet's collection ID. /// /// The snippet must be user defined. /// Method of IWBExternal15. /// - procedure EditSnippet(const Key: WideString); safecall; + procedure EditSnippet(const Key: WideString; + const CollectionIDAsHex: WideString); safecall; /// Displays a named category. /// WideString [in] ID of category to be displayed. @@ -168,13 +172,16 @@ procedure TWBExternal.DisplaySnippet(const Key, CollectionIDAsHex: WideString; end; end; -procedure TWBExternal.EditSnippet(const Key: WideString); +procedure TWBExternal.EditSnippet(const Key: WideString; + const CollectionIDAsHex: WideString); {TODO -cVault: change to take a collection ID as hex string as 2nd param & lift restriction on having to be user defined.} begin try if Assigned(fNotifier) then - fNotifier.EditSnippet(Key); + fNotifier.EditSnippet( + Key, TCollectionID.CreateFromHexString(CollectionIDAsHex) + ); except HandleException; end; From 547e085eeb1f9e49a7b1be898dd550bcca00c918 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 12 Nov 2024 16:48:50 +0000 Subject: [PATCH 076/222] Enable "main database" snippets to be deleted. Removed assertions that prevent "main database" snippets from being deleted. --- Src/DB.UMain.pas | 2 -- Src/UUserDBMgr.pas | 2 -- 2 files changed, 4 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 4045f7d87..fced065ae 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -828,8 +828,6 @@ procedure TDatabase.DeleteSnippet(const Snippet: TSnippet); Referrer: TSnippet; // loops thru snippets that cross references Snippet Referrers: TSnippetList; // list of referencing snippets begin - Assert(Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, - ClassName + '.DeleteSnippet: Snippet is not user-defined'); Assert(fSnippets.Contains(Snippet), ClassName + '.DeleteSnippet: Snippet is not in the database'); TriggerEvent(evChangeBegin); diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 8c27ec6f1..a02e62759 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -399,8 +399,6 @@ class procedure TUserDBMgr.DeleteSnippet(ViewItem: IView); Assert(Supports(ViewItem, ISnippetView), ClassName + '.Delete: Current view is not a snippet'); Snippet := (ViewItem as ISnippetView).Snippet; - Assert(Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, - ClassName + '.Delete: Snippet must be user defined'); // Check if snippet has dependents: don't allow deletion if so Dependents := (Database as IDatabaseEdit).GetDependents(Snippet); if Dependents.Count > 0 then From 88fcb9412a3b787638297eb55b5e0bf1ee71a792 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 12 Nov 2024 15:02:45 +0000 Subject: [PATCH 077/222] Add UCollectionListAdapter unit to project This unit provides class TCollectionListAdapter that provides an alternative interface to a TStrings based UI control by providing a list of collections, sorted on name. --- Src/CodeSnip.dpr | 3 +- Src/CodeSnip.dproj | 1 + Src/UCollectionListAdapter.pas | 117 +++++++++++++++++++++++++++++++++ 3 files changed, 120 insertions(+), 1 deletion(-) create mode 100644 Src/UCollectionListAdapter.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 32805a495..e345c810e 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -376,7 +376,8 @@ uses ClassHelpers.UActions in 'ClassHelpers.UActions.pas', DB.UCollections in 'DB.UCollections.pas', UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas', - DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas'; + DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas', + UCollectionListAdapter in 'UCollectionListAdapter.pas'; // Include resources {$Resource ExternalObj.tlb} // Type library file diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 921ecf1e5..3524fb160 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -583,6 +583,7 @@ + Base diff --git a/Src/UCollectionListAdapter.pas b/Src/UCollectionListAdapter.pas new file mode 100644 index 000000000..7d8dd1e97 --- /dev/null +++ b/Src/UCollectionListAdapter.pas @@ -0,0 +1,117 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). + * + * Implements a class that adapts a list of snippet collections by providing an + * alternative interface to the list, sorted by description. Designed for use + * with GUI controls. +} + +unit UCollectionListAdapter; + +interface + +uses + // Delphi + Classes, + // Project + DB.UCollections, + UContainers; + +type + + /// Class that adapts a list of snippet collections by providing an + /// alternative interface to the list, sorted by description. Designed for + /// use with GUI controls. + TCollectionListAdapter = class(TObject) + strict private + var + fCollectionList: TSortedList; + + public + + /// Object constructor. Sets up object with sorted list of + /// collections. + constructor Create; + + /// Object destructor. Tears down object. + destructor Destroy; override; + + /// Copies collection descriptions to a string list. + /// TStrings [in] String list that receives + /// collection descriptions. + procedure ToStrings(const AStrings: TStrings); + + /// Gets the collection at a specified index in the sorted list. + /// + /// Integer [in] Index of required collection. + /// + /// TCollection. Required collection. + function Collection(const AIndex: Integer): TCollection; + + /// Gets list index of the collection with the specified UID. + /// + function IndexOfUID(const AUID: TCollectionID): Integer; + end; + +implementation + +uses + // Delphi +// Windows {for inlining}, + Generics.Defaults, + // Project + UStrUtils; + +{ TCollectionListAdapter } + +function TCollectionListAdapter.Collection(const AIndex: Integer): TCollection; +begin + Result := fCollectionList[AIndex]; +end; + +constructor TCollectionListAdapter.Create; +var + Collection: TCollection; +begin + inherited Create; + fCollectionList := TSortedList.Create( + TDelegatedComparer.Create( + function (const Left, Right: TCollection): Integer + begin + Result := StrCompareText(Left.Name, Right.Name) + end + ) + ); + for Collection in TCollections.Instance do + fCollectionList.Add(Collection); +end; + +destructor TCollectionListAdapter.Destroy; +begin + fCollectionList.Free; + inherited; +end; + +function TCollectionListAdapter.IndexOfUID(const AUID: TCollectionID): Integer; +var + Idx: Integer; +begin + Result := -1; + for Idx := 0 to Pred(fCollectionList.Count) do + if fCollectionList[Idx].UID = AUID then + Exit(Idx); +end; + +procedure TCollectionListAdapter.ToStrings(const AStrings: TStrings); +var + Collection: TCollection; +begin + for Collection in fCollectionList do + AStrings.Add(Collection.Name); +end; + +end. From 79b82d3c3920d80e516425e166db6d12b939c870 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 12 Nov 2024 15:08:05 +0000 Subject: [PATCH 078/222] Update Duplicate Snippet dlg with collection list Added a drop down list to the Duplicate Snippet dialogue box where user must choose a collection to receive the duplicated snippet. --- Src/FmDuplicateSnippetDlg.dfm | 23 ++++++++++++-- Src/FmDuplicateSnippetDlg.pas | 58 +++++++++++++++++++++++++++-------- 2 files changed, 66 insertions(+), 15 deletions(-) diff --git a/Src/FmDuplicateSnippetDlg.dfm b/Src/FmDuplicateSnippetDlg.dfm index 001fc6109..f1d4bc692 100644 --- a/Src/FmDuplicateSnippetDlg.dfm +++ b/Src/FmDuplicateSnippetDlg.dfm @@ -20,11 +20,19 @@ inherited DuplicateSnippetDlg: TDuplicateSnippetDlg object lblDisplayName: TLabel Left = 0 Top = 2 - Width = 67 + Width = 36 Height = 13 - Caption = '&Display name:' + Caption = '&Snippet' FocusControl = edDisplayName end + object lblCollection: TLabel + Left = 0 + Top = 116 + Width = 50 + Height = 13 + Caption = '&Collection:' + FocusControl = cbCollection + end object cbCategory: TComboBox Left = 0 Top = 77 @@ -44,13 +52,22 @@ inherited DuplicateSnippetDlg: TDuplicateSnippetDlg end object chkEdit: TCheckBox Left = 0 - Top = 114 + Top = 162 Width = 222 Height = 17 Anchors = [akLeft, akTop, akRight] Caption = '&Edit in Snippets Editor' TabOrder = 2 end + object cbCollection: TComboBox + Left = 0 + Top = 135 + Width = 222 + Height = 21 + Style = csDropDownList + Anchors = [akLeft, akTop, akRight] + TabOrder = 3 + end end inherited btnHelp: TButton Left = 313 diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 7628dcd56..f874b197a 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -21,6 +21,7 @@ interface // Project DB.UCollections, DB.USnippet, FmGenericOKDlg, UBaseObjects, UCategoryListAdapter, + UCollectionListAdapter, UIStringList; @@ -31,6 +32,8 @@ TDuplicateSnippetDlg = class(TGenericOKDlg, INoPublicConstruct) edDisplayName: TEdit; lblCategory: TLabel; lblDisplayName: TLabel; + lblCollection: TLabel; + cbCollection: TComboBox; procedure btnOKClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); @@ -50,10 +53,14 @@ TPersistentOptions = class(TObject) var fSnippet: TSnippet; fCatList: TCategoryListAdapter; + fCollList: TCollectionListAdapter; fOptions: TPersistentOptions; fSnippetKey: string; - /// ID of collection to receive the duplicated snippet. + /// Returns the ID of the collection selected in the collections + /// drop down list, or the null collection ID if no collection is selected. + /// function SelectedCollectionID: TCollectionID; + function SelectedCategoryID: string; procedure ValidateData; procedure HandleException(const E: Exception); procedure UpdateDatabase; @@ -101,7 +108,12 @@ procedure TDuplicateSnippetDlg.ArrangeForm; TCtrlArranger.SetLabelHeights(Self); TCtrlArranger.AlignLefts( - [lblDisplayName, lblCategory, edDisplayName, cbCategory, chkEdit], + [ + lblDisplayName, edDisplayName, + lblCategory, cbCategory, + lblCollection, cbCollection, + chkEdit + ], 0 ); @@ -109,7 +121,9 @@ procedure TDuplicateSnippetDlg.ArrangeForm; TCtrlArranger.MoveBelow(lblDisplayName, edDisplayName, 4); TCtrlArranger.MoveBelow(edDisplayName, lblCategory, 8); TCtrlArranger.MoveBelow(lblCategory, cbCategory, 4); - TCtrlArranger.MoveBelow(cbCategory, chkEdit, 20); + TCtrlArranger.MoveBelow(cbCategory, lblCollection, 8); + TCtrlArranger.MoveBelow(lblCollection, cbCollection, 4); + TCtrlArranger.MoveBelow(cbCollection, chkEdit, 20); pnlBody.ClientWidth := Max( TCtrlArranger.TotalControlWidth(pnlBody) + 8, @@ -123,10 +137,10 @@ procedure TDuplicateSnippetDlg.ArrangeForm; procedure TDuplicateSnippetDlg.btnOKClick(Sender: TObject); begin try + ValidateData; fSnippetKey := (Database as IDatabaseEdit).GetUniqueSnippetKey( SelectedCollectionID ); - ValidateData; UpdateDatabase; except on E: Exception do @@ -175,23 +189,38 @@ procedure TDuplicateSnippetDlg.HandleException(const E: Exception); procedure TDuplicateSnippetDlg.InitForm; var SnippetCat: TCategory; + SnippetColl: TCollection; begin inherited; edDisplayName.Text := fSnippet.DisplayName; + fCatList.ToStrings(cbCategory.Items); + fCollList.ToStrings(cbCollection.Items); + Assert(cbCategory.Items.Count > 0, ClassName + '.InitForm: no categories'); + Assert(cbCollection.Items.Count > 0, ClassName + '.InitForm: no collections'); + SnippetCat := Database.Categories.Find(fSnippet.Category); - if Assigned(SnippetCat) then - cbCategory.ItemIndex := cbCategory.Items.IndexOf(SnippetCat.Description) - else - cbCategory.ItemIndex := -1; + Assert(Assigned(SnippetCat), ClassName + '.InitForm: invalid category'); + cbCategory.ItemIndex := cbCategory.Items.IndexOf(SnippetCat.Description); + + SnippetColl := TCollections.Instance.GetCollection(fSnippet.CollectionID); + cbCollection.ItemIndex := cbCollection.Items.IndexOf(SnippetColl.Name); + chkEdit.Checked := fOptions.EditSnippetOnClose; end; +function TDuplicateSnippetDlg.SelectedCategoryID: string; +begin + Assert(cbCategory.ItemIndex >= 0, + ClassName + '.SelectedCategoryID: no category selected'); + Result := fCatList.CatID(cbCategory.ItemIndex); +end; + function TDuplicateSnippetDlg.SelectedCollectionID: TCollectionID; begin - {TODO -cCollections: change the following to return the ID of a collection - chosen by the user.} - Result := TCollectionID.__TMP__UserDBCollectionID; + Assert(cbCollection.ItemIndex >= 0, + ClassName + '.SelectedCollectionID: no collection selected'); + Result := fCollList.Collection(cbCollection.ItemIndex).UID; end; procedure TDuplicateSnippetDlg.UpdateDatabase; @@ -201,25 +230,29 @@ procedure TDuplicateSnippetDlg.UpdateDatabase; fSnippetKey, SelectedCollectionID, StrTrim(edDisplayName.Text), - fCatList.CatID(cbCategory.ItemIndex) + SelectedCategoryID ); end; procedure TDuplicateSnippetDlg.ValidateData; resourcestring sNoCategory = 'You must choose a category'; + sNoCollection = 'You must choose a collection'; sNoDisplayName = 'You must provide a display name'; begin if StrTrim(edDisplayName.Text) = '' then raise EDataEntry.Create(sNoDisplayName, edDisplayName); if cbCategory.ItemIndex = -1 then raise EDataEntry.Create(sNoCategory, cbCategory); + if cbCollection.ItemIndex = -1 then + raise EDataEntry.Create(sNoCollection, cbCollection); end; procedure TDuplicateSnippetDlg.FormCreate(Sender: TObject); begin inherited; fCatList := TCategoryListAdapter.Create(Database.Categories); + fCollList := TCollectionListAdapter.Create; fOptions := TPersistentOptions.Create; end; @@ -232,6 +265,7 @@ procedure TDuplicateSnippetDlg.FormDestroy(Sender: TObject); fOptions.EditSnippetOnClose := chkEdit.Checked; inherited; fOptions.Free; + fCollList.Free; fCatList.Free; end; From 8bae24b20a1e450df5b945871012a3904cfb5dde Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 12 Nov 2024 19:43:20 +0000 Subject: [PATCH 079/222] Enable snippets from all collections to be exported Adapted code the writes export XML file to always use a new key that is unique within the default collection (formerly "user database"). This was done because snippets from different collections can now be exported and such snippets can, in theory, have the same key. Also changed XML so that the snippet display name is always written to avoid having a new- style key used for display name when importing. Modified Code Export dialogue code to always select snippet passed to TCodeExportDlg.SelectSnippet, regardless of which collection it is from. Modified TSelectUserSnippetsFrame to display all snippets rather just those from the default "user" collection. This makes this frame identical to TSelectSnippetFrame: left TODOs suggesting how to refactor this. --- Src/FmCodeExportDlg.pas | 48 +++++++++++++++++++----------------- Src/FrSelectUserSnippets.pas | 20 ++++++++++++--- Src/UCodeImportExport.pas | 23 ++++++++++++++--- 3 files changed, 60 insertions(+), 31 deletions(-) diff --git a/Src/FmCodeExportDlg.pas b/Src/FmCodeExportDlg.pas index 948f109a4..37ea3c549 100644 --- a/Src/FmCodeExportDlg.pas +++ b/Src/FmCodeExportDlg.pas @@ -34,17 +34,20 @@ interface TCodeExportDlg = class(TGenericOKDlg, INoPublicConstruct) btnBrowse: TButton; edFile: TEdit; + {TODO -cRefactor: Change type of frmSnippets to TSelectSnippetsFrame - + TSelectSnippetsFrame and TSelectUserSnippetsFrame are now + functionally identical.} frmSnippets: TSelectUserSnippetsFrame; lblFile: TLabel; lblSnippets: TLabel; procedure btnBrowseClick(Sender: TObject); procedure btnOKClick(Sender: TObject); strict private + /// Selects a snippet in the snippets check list. + /// TSnippet [in] Snippet to be selected. + /// If nil then no snippet is selected. procedure SelectSnippet(const Snippet: TSnippet); - {Selects a snippet in the snippets check list. - @param Snippet [in] Snippet to be selected. If nil, or not user-defined, - no snippet is selected. - } + procedure WriteOutputFile; {Writes export file. } @@ -55,13 +58,14 @@ TCodeExportDlg = class(TGenericOKDlg, INoPublicConstruct) controls that depend on UI font. } public + /// Displays export dialog box and writes export file containing + /// user's selected snippets. + /// TComponent [in] Reference to control that + /// owns the dialogue box. + /// TSnippet [in] Reference to a snippet to + /// pre-select in the snippets check list box. If nil then no + /// snippet is pre-selected. class procedure Execute(const AOwner: TComponent; const Snippet: TSnippet); - {Displays export dialog box and writes export file if user OKs entries. - @param AOwner [in] Reference to control that owns the dialog box. - @param Snippet [in] Reference to a snippet to pre-select in snippets - check list box. If nil or not user-defined then no snippet is pre- - selected. - } end; @@ -185,11 +189,12 @@ procedure TCodeExportDlg.ConfigForm; class procedure TCodeExportDlg.Execute(const AOwner: TComponent; const Snippet: TSnippet); - {Displays export dialog box and writes export file if user OKs entries. - @param AOwner [in] Reference to control that owns the dialog box. - @param Snippet [in] Reference to a snippet to pre-select in snippets check - list box. If nil or not user-defined then no snippet is pre-selected. - } + {TODO -cVault: Add parameter to receive snippet selection per current search + display only those snippets (maybe filtering out unwanted snippets by + handling an event triggered by the snippet list frame. As now, select + only the snippet specified by the Snippet parameter.} + {TODO -cVault: Add check box to use to causes all snippets depended upon by + each exported snippet to also be exported.} var Dlg: TCodeExportDlg; begin @@ -203,20 +208,17 @@ class procedure TCodeExportDlg.Execute(const AOwner: TComponent; end; procedure TCodeExportDlg.SelectSnippet(const Snippet: TSnippet); - {Selects a snippet in the snippets check list. - @param Snippet [in] Snippet to be selected. If nil, or not user-defined, no - snippet is selected. - } var List: TSnippetList; // list containing only the provided snippet begin - if not Assigned(Snippet) or (Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID) then - // Snippet is nil or not user-defined: select nothing + if not Assigned(Snippet) then + // Snippet is nil: select nothing frmSnippets.SelectedSnippets := nil else begin - // Snippet is user-defined. We make a snippet list containing only this - // snippet because frmSnippets requires a list of snippets to select. + // Snippet is not nil: we make a snippet list containing only this snippet. + // A list is required because frmSnippets requires a list of snippets to + // select. List := TSnippetList.Create; try List.Add(Snippet); diff --git a/Src/FrSelectUserSnippets.pas b/Src/FrSelectUserSnippets.pas index b29044d09..dd616fbdc 100644 --- a/Src/FrSelectUserSnippets.pas +++ b/Src/FrSelectUserSnippets.pas @@ -58,6 +58,20 @@ implementation {$R *.dfm} +{TODO -cRefactor: TSelectUserSnippetsFrame is now identical to + TSelectSnippetsFrame, so both can be collapsed into base class, + TSelectSnippetsBaseFrame. + + Add an event that the owning form can handle to filter out any unwanted + snippets from being displayed. + + TSelectUserSnippetsFrame and TSelectSnippetsFrame should then be removed + and TSelectSnippetsBaseFrame should be renamed as TSelectSnippetsFrame. + + Finally FrSelectUserSnippets and FrSelectSnippets units can be removed + and FrSelectSnippetsBase can be renamed as FrSelectSnippets. +} + { TSelectUserSnippetsFrame } function TSelectUserSnippetsFrame.CanAddCatNode(const Cat: TCategory): Boolean; @@ -66,9 +80,7 @@ function TSelectUserSnippetsFrame.CanAddCatNode(const Cat: TCategory): Boolean; @return True if category contains any user-defined snippets. } begin - Result := not Cat.Snippets.IsEmpty( - TCollectionID.__TMP__UserDBCollectionID - ); + Result := not Cat.Snippets.IsEmpty; end; function TSelectUserSnippetsFrame.CanAddSnippetNode( @@ -78,7 +90,7 @@ function TSelectUserSnippetsFrame.CanAddSnippetNode( @return True if snippet is user-defined. } begin - Result := Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID; + Result := True; end; end. diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index 18446c944..e422bf338 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -182,6 +182,7 @@ implementation USnippetExtraHelper, USnippetIDs, UStructs, + UStrUtils, UXMLDocConsts; @@ -294,7 +295,18 @@ procedure TCodeExporter.WriteSnippet(const ParentNode: IXMLNode; begin // Create snippet node with attribute that specifies snippet key SnippetNode := fXMLDoc.CreateElement(ParentNode, cSnippetNode); - SnippetNode.Attributes[cSnippetNameAttr] := Snippet.Key; + (Database as IDatabaseEdit).GetUniqueSnippetKey(TCollectionID.__TMP__UserDBCollectionID); + // Export snippet under a new unique key within the default collection + // we use default collection because code importer assumes snippet id from + // that collection. We create new unique key because more than one snippet + // could be exported that have the same key but are in different collections. + SnippetNode.Attributes[cSnippetNameAttr] := + (Database as IDatabaseEdit).GetUniqueSnippetKey( + {TODO -cVault: Replace following __TMP__ method call with a call to get + default collection, which should be common to databases used by + every user} + TCollectionID.__TMP__UserDBCollectionID + ); // Add nodes for properties: (ignore category and xrefs) // description node is written even if empty (which it shouldn't be) fXMLDoc.CreateElement( @@ -302,9 +314,12 @@ procedure TCodeExporter.WriteSnippet(const ParentNode: IXMLNode; cDescriptionNode, TSnippetExtraHelper.BuildREMLMarkup(Snippet.Description) ); - // Snippet's display name is only written if different to Snippet's key - if Snippet.Key <> Snippet.DisplayName then - fXMLDoc.CreateElement(SnippetNode, cDisplayNameNode, Snippet.DisplayName); + // Snippet's display name always written: if display name is specified we use + // it, otherwise we use the original snippet key. + if not StrIsEmpty(Snippet.DisplayName, True) then + fXMLDoc.CreateElement(SnippetNode, cDisplayNameNode, Snippet.DisplayName) + else + fXMLDoc.CreateElement(SnippetNode, cDisplayNameNode, Snippet.Key); // source code is stored directly in XML, not in external file fXMLDoc.CreateElement(SnippetNode, cSourceCodeTextNode, Snippet.SourceCode); // write highlight source flag From efb6ddea375ddf298157276c0b560290e515e3d1 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 13 Nov 2024 08:26:34 +0000 Subject: [PATCH 080/222] Enable collection selection in code import wizard Added a new page to the Code Import wizard where the user can choose the collection into which to import snippets. --- Src/FmCodeImportDlg.dfm | 25 +++++++++++++ Src/FmCodeImportDlg.pas | 78 ++++++++++++++++++++++++++++++----------- 2 files changed, 83 insertions(+), 20 deletions(-) diff --git a/Src/FmCodeImportDlg.dfm b/Src/FmCodeImportDlg.dfm index 5182ac866..8c3dfde69 100644 --- a/Src/FmCodeImportDlg.dfm +++ b/Src/FmCodeImportDlg.dfm @@ -67,6 +67,31 @@ inherited CodeImportDlg: TCodeImportDlg TabOrder = 1 end end + object tsCollection: TTabSheet + Caption = 'tsCollection' + ImageIndex = 4 + TabVisible = False + DesignSize = ( + 369 + 278) + object lblCollection: TLabel + Left = 0 + Top = 8 + Width = 254 + Height = 13 + Caption = 'Choose a &collection to receive the imported snippets:' + FocusControl = cbCollection + end + object cbCollection: TComboBox + Left = 0 + Top = 38 + Width = 369 + Height = 21 + Style = csDropDownList + Anchors = [akLeft, akTop, akRight] + TabOrder = 0 + end + end object tsUpdate: TTabSheet Caption = 'tsUpdate' ImageIndex = 3 diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index 4bdd74688..1a131ce41 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -28,7 +28,8 @@ interface DB.UCollections, FmWizardDlg, UBaseObjects, - UCodeImportMgr; + UCodeImportMgr, + UCollectionListAdapter; type /// @@ -53,31 +54,37 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) lblModifyInstructions: TLabel; lblFinish: TLabel; sbFinish: TScrollBox; + tsCollection: TTabSheet; + lblCollection: TLabel; + cbCollection: TComboBox; /// Handles clicks on list view check boxes. procedure lvImportsItemChecked(Sender: TObject; Item: TListItem); /// Handles request to display open file dialog box to get import /// file name. procedure actBrowseExecute(Sender: TObject); - /// Frees objects stored in list view items' Data properties. - /// + /// Frees field objects and objects stored in list view items' + /// Data properties. procedure FormDestroy(Sender: TObject); + /// Creates field objects. + procedure FormCreate(Sender: TObject); strict private const - {TODO -cCollections: Insert a new page to get collection to receive - imports from user after cFilePage and before cUpdatePage. That way - we can be sure that the collection won't change after selecting - snippets.} // Indices of wizard pages - cIntroPage = 0; - cFilePage = 1; - cUpdatePage = 2; - cFinishPage = 3; + cIntroPage = 0; + cFilePage = 1; + cCollectionPage = 2; + cUpdatePage = 3; + cFinishPage = 4; // Index of subitems in list view cLVActionIdx = 0; var /// Reference to import manager object used to perform import /// operations. fImportMgr: TCodeImportMgr; + /// Object that populates cbCollection with an + /// alphabetical list of collection names and manages interaction with + /// it. + fCollList: TCollectionListAdapter; /// Validates entries on wizard pages indetified by the page /// index. procedure ValidatePage(const PageIdx: Integer); @@ -118,6 +125,9 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) /// manager object. constructor InternalCreate(AOwner: TComponent; const ImportMgr: TCodeImportMgr); reintroduce; + /// Initialises form fields and controls. + /// Overridden method called from ancestor class. + procedure InitForm; override; /// Aligns and arranges controls in each tab sheet and sizes /// dialog box to accomodate controls. /// Overridden method called from ancestor class. @@ -211,6 +221,10 @@ procedure TCodeImportDlg.ArrangeForm; ); lblLoadFile.Top := TCtrlArranger.BottomOf([edFile, btnBrowse], 12); + // tsCollection + cbCollection.Top := TCtrlArranger.BottomOf(lblCollection, 6); + cbCollection.Width := tsCollection.Width; + // tsUpdate lblImportList.Top := TCtrlArranger.BottomOf(lblModifyInstructions, 8); lvImports.Top := TCtrlArranger.BottomOf(lblImportList, 6); @@ -274,11 +288,18 @@ class function TCodeImportDlg.Execute(AOwner: TComponent; end; end; +procedure TCodeImportDlg.FormCreate(Sender: TObject); +begin + inherited; + fCollList := TCollectionListAdapter.Create; +end; + procedure TCodeImportDlg.FormDestroy(Sender: TObject); var Idx: Integer; begin inherited; + fCollList.Free; // Free the TBox<> objects stored in list item data pointer for Idx := Pred(lvImports.Items.Count) downto 0 do TObject(lvImports.Items[Idx].Data).Free; @@ -286,11 +307,9 @@ procedure TCodeImportDlg.FormDestroy(Sender: TObject); function TCodeImportDlg.GetCollectionID: TCollectionID; begin - {TODO -cCollections: Add code to get user's choice of collection into which - snippets are to be imported. Will need a drop down list of available - collections. At present, only the "user" collection is permitted. - } - Result := TCollectionID.__TMP__UserDBCollectionID; + Assert(cbCollection.ItemIndex >= 0, + ClassName + '.GetCollectionID: no collection selected'); + Result := fCollList.Collection(cbCollection.ItemIndex).UID; end; function TCodeImportDlg.GetFileNameFromEditCtrl: string; @@ -303,17 +322,36 @@ function TCodeImportDlg.HeadingText(const PageIdx: Integer): string; // Page headings sIntroPageheading = 'Import snippets from a file'; sFilePage = 'Choose import file'; + sCollectionPage = 'Choose a collection'; sUpdatePage = 'Edit import and update database'; sFinishPage = 'Import complete'; begin case PageIdx of - cIntroPage: Result := sIntroPageheading; - cFilePage: Result := sFilePage; - cUpdatePage: Result := sUpdatePage; - cFinishPage: Result := sFinishPage; + cIntroPage: Result := sIntroPageheading; + cFilePage: Result := sFilePage; + cCollectionPage: Result := sCollectionPage; + cUpdatePage: Result := sUpdatePage; + cFinishPage: Result := sFinishPage; end; end; +procedure TCodeImportDlg.InitForm; +begin + fCollList.ToStrings(cbCollection.Items); + Assert(cbCollection.Items.Count > 0, ClassName + '.InitForm: no collections'); + {TODO -cCollections: Replace following __TMP__ method calls with a calls to + TCollections.DefaultCollection or similar.} + Assert(TCollections.Instance.ContainsID(TCollectionID.__TMP__UserDBCollectionID), + ClassName + '.InitForm: default collection not found'); + cbCollection.ItemIndex := cbCollection.Items.IndexOf( + TCollections.Instance.GetCollection(TCollectionID.__TMP__UserDBCollectionID).Name + ); + Assert(cbCollection.ItemIndex >= 0, + ClassName + '.InitForm: default collection name not in cbCollection'); + + inherited; +end; + procedure TCodeImportDlg.InitImportInfo; /// Creates a new list view items containing given information. From d5b5a16d887ed4b3c740f5c532f222f7b6c56d22 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 13 Nov 2024 09:04:34 +0000 Subject: [PATCH 081/222] Enable collection selection in snippet select dlg Replaced the two buttons in the snippet selection dialogue that selected all snippets in the "main" or "user" databases with a single button that lets the user select all snippets in a collection. The button drops down a menu of all collections for the user to choose from. --- Src/FmSelectionSearchDlg.dfm | 61 +++++++++++--------- Src/FmSelectionSearchDlg.pas | 108 ++++++++++++++++++++++++++--------- 2 files changed, 115 insertions(+), 54 deletions(-) diff --git a/Src/FmSelectionSearchDlg.dfm b/Src/FmSelectionSearchDlg.dfm index 17136ec70..9373a5513 100644 --- a/Src/FmSelectionSearchDlg.dfm +++ b/Src/FmSelectionSearchDlg.dfm @@ -5,15 +5,15 @@ inherited SelectionSearchDlg: TSelectionSearchDlg PixelsPerInch = 96 TextHeight = 13 inherited pnlBody: TPanel - Width = 371 + Width = 379 Height = 293 - ExplicitWidth = 371 + ExplicitWidth = 379 ExplicitHeight = 293 object lblOverwriteSearch: TLabel AlignWithMargins = True Left = 0 Top = 280 - Width = 371 + Width = 379 Height = 13 Margins.Left = 0 Margins.Top = 8 @@ -45,7 +45,7 @@ inherited SelectionSearchDlg: TSelectionSearchDlg object btnSelectAll: TButton Left = 287 Top = 1 - Width = 83 + Width = 91 Height = 25 Caption = '&Select All' TabOrder = 1 @@ -54,50 +54,57 @@ inherited SelectionSearchDlg: TSelectionSearchDlg object btnClearAll: TButton Left = 287 Top = 32 - Width = 83 + Width = 91 Height = 25 Caption = '&Clear All' TabOrder = 2 OnClick = btnClearAllClick end - object btnUserDB: TButton - Left = 287 - Top = 63 - Width = 83 - Height = 25 - Caption = '&User Defined' - TabOrder = 3 - OnClick = btnUserDBClick - end - object btnMainDB: TButton - Left = 287 - Top = 94 - Width = 83 - Height = 25 - Caption = '&Main' - TabOrder = 4 - OnClick = btnMainDBClick - end object btnExpandAll: TButton Left = 287 Top = 174 - Width = 82 + Width = 91 Height = 25 Caption = 'E&xpand All' - TabOrder = 5 + TabOrder = 4 OnClick = btnExpandAllClick end object btnCollapseAll: TButton Left = 287 Top = 205 - Width = 82 + Width = 91 Height = 25 Caption = 'C&ollapse All' - TabOrder = 6 + TabOrder = 5 OnClick = btnCollapseAllClick end + object btnCollection: TBitBtn + Left = 287 + Top = 63 + Width = 91 + Height = 25 + Caption = 'Collectio&n' + DoubleBuffered = True + Glyph.Data = { + F6000000424DF600000000000000760000002800000010000000100000000100 + 0400000000008000000000000000000000001000000010000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00FFF + FFFFFFFFFF0000FFFFFFFFFFF000000FFFFFFFFF00000000FFFFFFF000000000 + 0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF} + Layout = blGlyphRight + ParentDoubleBuffered = False + TabOrder = 3 + OnClick = btnCollectionClick + end end inherited btnOK: TButton OnClick = btnOKClick end + object mnuCollections: TPopupMenu + Left = 72 + Top = 72 + end end diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index dae1bc8ce..37c0eed18 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -18,7 +18,7 @@ interface uses // Delphi - Forms, StdCtrls, Controls, ExtCtrls, Classes, + Forms, StdCtrls, Controls, ExtCtrls, Classes, Buttons, Menus, // Project DB.UCollections, DB.USnippet, FmGenericOKDlg, FrCheckedTV, FrSelectSnippets, @@ -35,18 +35,17 @@ interface } TSelectionSearchDlg = class(TGenericOKDlg, INoPublicConstruct) btnClearAll: TButton; - btnMainDB: TButton; btnSelectAll: TButton; - btnUserDB: TButton; frmSelect: TSelectSnippetsFrame; btnExpandAll: TButton; btnCollapseAll: TButton; lblOverwriteSearch: TLabel; + btnCollection: TBitBtn; + mnuCollections: TPopupMenu; procedure btnClearAllClick(Sender: TObject); - procedure btnMainDBClick(Sender: TObject); procedure btnOKClick(Sender: TObject); procedure btnSelectAllClick(Sender: TObject); - procedure btnUserDBClick(Sender: TObject); + procedure btnCollectionClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnExpandAllClick(Sender: TObject); procedure btnCollapseAllClick(Sender: TObject); @@ -68,13 +67,21 @@ TSelectionSearchDlg = class(TGenericOKDlg, INoPublicConstruct) /// collection. procedure SelectDB(const ACollectionID: TCollectionID); + /// Populates collections pop-up menu with menu items. + procedure PopulateCollectionsMenu; + + /// Handles clicks on collection menu items. Selects snippets + /// belonging to the selected collection. + procedure CollectionMenuClick(Sender: TObject); + strict protected procedure ConfigForm; override; + + /// Initialises form. Populates collections menu and collapses + /// treeview. procedure InitForm; override; - {Initialises form. Disables User Defined button if there are no user - defined snippets in database. - } + procedure AfterShowForm; override; {Restores default cursor after form shown. } @@ -98,6 +105,7 @@ implementation uses // Delphi SysUtils, + Types, // Project DB.UMain, UCtrlArranger, @@ -107,6 +115,29 @@ implementation {$R *.dfm} +type + /// Custom menu item with additional property to store a compiler + /// version. + TCollectionMenuItem = class(TMenuItem) + strict private + var + /// Value of CompilerVer property + fCollection: TCollection; + public + /// Constructs a menu item with all required properties and event + /// handlers. + /// TComponent [in] Menu item's owner. + /// TCollection [in] Collection whose name + /// is displayed in menu item. + /// TNotifyEvent [in] Reference to an event + /// handler for menu item's OnClick event. + constructor Create(AOwner: TComponent; const ACollection: TCollection; + const AClickHandler: TNotifyEvent); reintroduce; + /// Version number of compiler whose name is displayed in menu + /// item's caption. + property Collection: TCollection read fCollection write fCollection; + end; + { TSelectionSearchDlg } procedure TSelectionSearchDlg.AfterShowForm; @@ -132,17 +163,19 @@ procedure TSelectionSearchDlg.btnCollapseAllClick(Sender: TObject); frmSelect.CollapseTree; end; -procedure TSelectionSearchDlg.btnExpandAllClick(Sender: TObject); +procedure TSelectionSearchDlg.btnCollectionClick(Sender: TObject); +var + PopupPos: TPoint; // place where menu pops up begin - frmSelect.ExpandTree; + PopupPos := ClientToScreen( + Point(btnCollection.Left, btnCollection.Top + btnCollection.Height) + ); + mnuCollections.Popup(PopupPos.X, PopupPos.Y); end; -procedure TSelectionSearchDlg.btnMainDBClick(Sender: TObject); - {Main button click handler. Selects all snippets in main database. - @param Sender [in] Not used. - } +procedure TSelectionSearchDlg.btnExpandAllClick(Sender: TObject); begin - SelectDB(TCollectionID.__TMP__MainDBCollectionID); + frmSelect.ExpandTree; end; procedure TSelectionSearchDlg.btnOKClick(Sender: TObject); @@ -171,13 +204,9 @@ procedure TSelectionSearchDlg.btnSelectAllClick(Sender: TObject); frmSelect.SelectedSnippets := Database.Snippets; end; -procedure TSelectionSearchDlg.btnUserDBClick(Sender: TObject); - {User Defined button click handler. Selects all user defined snippets in - database. - @param Sender [in] Not used. - } +procedure TSelectionSearchDlg.CollectionMenuClick(Sender: TObject); begin - SelectDB(TCollectionID.__TMP__UserDBCollectionID); + SelectDB((Sender as TCollectionMenuItem).Collection.UID); end; procedure TSelectionSearchDlg.ConfigForm; @@ -224,15 +253,29 @@ procedure TSelectionSearchDlg.FormCreate(Sender: TObject); end; procedure TSelectionSearchDlg.InitForm; - {Initialises form. Disables User Defined button if there are no user defined - snippets in database. - } begin inherited; frmSelect.CollapseTree; - btnUserDB.Enabled := not Database.Snippets.IsEmpty( - TCollectionID.__TMP__UserDBCollectionID - ); + PopulateCollectionsMenu; +end; + +procedure TSelectionSearchDlg.PopulateCollectionsMenu; + + /// Adds a menu item for given collection to the pop-up menu. + procedure AddMenuItem(const ACollection: TCollection); + begin + mnuCollections.Items.Add( + TCollectionMenuItem.Create( + mnuCollections, ACollection, CollectionMenuClick + ) + ); + end; + +var + Collection: TCollection; +begin + for Collection in TCollections.Instance do + AddMenuItem(Collection); end; procedure TSelectionSearchDlg.SelectDB(const ACollectionID: TCollectionID); @@ -269,5 +312,16 @@ procedure TSelectionSearchDlg.SetSelectedSnippets(const Value: TSnippetList); frmSelect.SelectedSnippets := Value; end; +{ TCollectionMenuItem } + +constructor TCollectionMenuItem.Create(AOwner: TComponent; + const ACollection: TCollection; const AClickHandler: TNotifyEvent); +begin + inherited Create(AOwner); + Caption := ACollection.Name; + Collection := ACollection; + OnClick := AClickHandler; +end; + end. From 738f54c4f23b18cea011af0e6a3eed2518d72b14 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 13 Nov 2024 10:02:58 +0000 Subject: [PATCH 082/222] Enable collection selection in SWAG import wizard The user can now specify the collection into which SWAG snippets will be imported. A collection drop down list box was added to the wizard's update page for this purpose. --- Src/FmSWAGImportDlg.dfm | 44 +++++++++++++++++++++++------ Src/FmSWAGImportDlg.pas | 61 +++++++++++++++++++++++++++++++++++------ 2 files changed, 87 insertions(+), 18 deletions(-) diff --git a/Src/FmSWAGImportDlg.dfm b/Src/FmSWAGImportDlg.dfm index 534e58ae8..027a4b723 100644 --- a/Src/FmSWAGImportDlg.dfm +++ b/Src/FmSWAGImportDlg.dfm @@ -19,7 +19,7 @@ inherited SWAGImportDlg: TSWAGImportDlg inherited pcWizard: TPageControl Width = 671 Height = 456 - ActivePage = tsFinish + ActivePage = tsIntro ExplicitWidth = 671 ExplicitHeight = 456 object tsIntro: TTabSheet @@ -184,7 +184,7 @@ inherited SWAGImportDlg: TSWAGImportDlg Caption = 'tsUpdate' ImageIndex = 2 TabVisible = False - object lblUpdateDesc: TLabel + object lblUpdateDesc1: TLabel Left = 0 Top = 3 Width = 649 @@ -194,15 +194,33 @@ inherited SWAGImportDlg: TSWAGImportDlg 'You have chosen to import the following SWAG packets as CodeSnip' + ' snippets with the given Display Names. You can change these nam' + 'es later, if you wish, using the Snippets Editor. To modify your' + - ' selection go back to the previous page. When you are ready to i' + - 'mport the packets click "Import". This step can'#39't be undone.' + ' selection go back to the previous page.' WordWrap = True end + object lblUpdateDesc2: TLabel + Left = 0 + Top = 41 + Width = 649 + Height = 36 + AutoSize = False + Caption = + 'When you are ready to import the packets select the collection i' + + 'nto which you want to import them then click "Import". This step' + + ' can'#39't be undone.' + WordWrap = True + end + object lblCollection: TLabel + Left = 0 + Top = 83 + Width = 80 + Height = 13 + Caption = 'Select &collection:' + end object lvImports: TListView Left = 0 - Top = 51 + Top = 107 Width = 660 - Height = 317 + Height = 288 Columns = < item Caption = 'Packet Title '#8594' Snippet Display Name' @@ -214,9 +232,17 @@ inherited SWAGImportDlg: TSWAGImportDlg ReadOnly = True RowSelect = True SortType = stText - TabOrder = 0 + TabOrder = 1 ViewStyle = vsReport end + object cbCollection: TComboBox + Left = 86 + Top = 80 + Width = 289 + Height = 21 + Style = csDropDownList + TabOrder = 0 + end end object tsFinish: TTabSheet Caption = 'tsFinish' @@ -257,8 +283,8 @@ inherited SWAGImportDlg: TSWAGImportDlg end end object alWizard: TActionList - Left = 336 - Top = 256 + Left = 224 + Top = 248 object actDisplayCategory: TAction Caption = 'S&how Packets In Category' OnExecute = actDisplayCategoryExecute diff --git a/Src/FmSWAGImportDlg.pas b/Src/FmSWAGImportDlg.pas index a6e3db4eb..873f9bb71 100644 --- a/Src/FmSWAGImportDlg.pas +++ b/Src/FmSWAGImportDlg.pas @@ -35,6 +35,7 @@ interface FrHTMLDlg, FrHTMLTpltDlg, UBaseObjects, + UCollectionListAdapter, UContainers, UCSSBuilder, SWAG.UCommon, @@ -56,7 +57,7 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) clbSelectPackets: TCheckListBox; tsUpdate: TTabSheet; lvImports: TListView; - lblUpdateDesc: TLabel; + lblUpdateDesc1: TLabel; tsFinish: TTabSheet; frmOutro: THTMLTpltDlgFrame; btnDisplayCategory: TButton; @@ -73,6 +74,9 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) frmIntro: THTMLTpltDlgFrame; lblVersionNumber: TLabel; lblFolderPageInfo1: TLabel; + lblUpdateDesc2: TLabel; + lblCollection: TLabel; + cbCollection: TComboBox; /// Handles clicks on the check boxes next to packets in the /// packet selection list box by selecting and deselecting packets for /// inclusion in the import. @@ -106,6 +110,8 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) procedure actDisplayPacketExecute(Sender: TObject); /// Updates enabled state of display packet category. procedure actDisplayPacketUpdate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); strict private const {TODO -cCollections: Add combo box to select collection into which to add @@ -142,6 +148,10 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) /// ID of currently selected category. /// Set to zero if no category is selected. fCurrentCatID: Cardinal; + /// Object that populates cbCollection with an + /// alphabetical list of collection names and manages interaction with + /// it. + fCollList: TCollectionListAdapter; /// Retrieves import directory name from edit control where it is /// entered. function GetDirNameFromEditCtrl: string; @@ -359,11 +369,19 @@ procedure TSWAGImportDlg.ArrangeForm; TCtrlArranger.AlignHCentresTo([clbSelectPackets], [btnDisplayPacket]); // tsUpdate - lblUpdateDesc.Width := tsUpdate.ClientWidth; - lblUpdateDesc.Top := 3; + TCtrlArranger.AlignLefts( + [lblUpdateDesc1, lblUpdateDesc2, lblCollection, lvImports], 0 + ); + lblUpdateDesc1.Width := tsUpdate.ClientWidth; + lblUpdateDesc2.Width := tsUpdate.ClientWidth; lvImports.Width := tsUpdate.ClientWidth; - TCtrlArranger.AlignLefts([lblUpdateDesc, lvImports], 0); - TCtrlArranger.MoveBelow(lblUpdateDesc, lvImports, 12); + lblUpdateDesc1.Top := 3; + TCtrlArranger.MoveBelow(lblUpdateDesc1, lblUpdateDesc2, 4); + TCtrlArranger.AlignVCentres( + TCtrlArranger.BottomOf(lblUpdateDesc2, 8), [lblCollection, cbCollection] + ); + TCtrlArranger.MoveToRightOf(lblCollection, cbCollection, 4); + TCtrlArranger.MoveBelow([lblCollection, cbCollection], lvImports, 12); // tsFinish frmOutro.Height := frmOutro.DocHeight; @@ -512,6 +530,20 @@ procedure TSWAGImportDlg.ConfigForm; ); end ); + + // Set up collection list + fCollList.ToStrings(cbCollection.Items); + Assert(cbCollection.Items.Count > 0, + ClassName + '.ConfigForm: no collections'); + {TODO -cCollections: Replace following __TMP__ method calls with a calls to + TCollections.DefaultCollection or similar.} + Assert(TCollections.Instance.ContainsID(TCollectionID.__TMP__UserDBCollectionID), + ClassName + '.ConfigForm: default collection not found'); + cbCollection.ItemIndex := cbCollection.Items.IndexOf( + TCollections.Instance.GetCollection(TCollectionID.__TMP__UserDBCollectionID).Name + ); + Assert(cbCollection.ItemIndex >= 0, + ClassName + '.ConfigForm: default collection name not in cbCollection'); end; destructor TSWAGImportDlg.Destroy; @@ -588,6 +620,18 @@ class function TSWAGImportDlg.Execute(const AOwner: TComponent): Boolean; end; end; +procedure TSWAGImportDlg.FormCreate(Sender: TObject); +begin + inherited; + fCollList := TCollectionListAdapter.Create; +end; + +procedure TSWAGImportDlg.FormDestroy(Sender: TObject); +begin + fCollList.Free; + inherited; +end; + function TSWAGImportDlg.GetDirNameFromEditCtrl: string; begin Result := StrTrim(edPath.Text); @@ -833,10 +877,9 @@ procedure TSWAGImportDlg.PreviewSelectedPacket; function TSWAGImportDlg.SelectedCollectionID: TCollectionID; begin - {TODO -cCollections: Replace the following __TMP__ method with collection ID - selected by user from a combo box. DO NOT permit this choice when - editing an existing snippet.} - Result := TCollectionID.__TMP__UserDBCollectionID; + Assert(cbCollection.ItemIndex >= 0, + ClassName + '.SelectedCollectionID: no collection selected'); + Result := fCollList.Collection(cbCollection.ItemIndex).UID; end; procedure TSWAGImportDlg.UpdateButtons(const PageIdx: Integer); From 483166d8e51348b945e7c633a734e8f7869f6924 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 13 Nov 2024 11:39:30 +0000 Subject: [PATCH 083/222] Revised Favourites file format to record collections The Favourites file format was redefined to be able to store a snippet's collection ID in hex format, along with the snippet's key and the date the favourite was last viewed. The date format used to store the last viewed date was changed from local to international YYYY-MM-DD HH:MM:DD format. The saving and loading code in TFavouritesPersist was rewritten to use the TTabSeparatedReader and TTabSeparatedFileWriter classes from UTabSeparatedFileIO to perform the reading, low level parsing, and writing of the favourites file. A new TAppInfo.UserFavouritesFileName method was added to return the full path to the current user's favourites file, meaning that the file name is no longer hard wired in TFavouritesPersist. --- Src/Favourites.UPersist.pas | 140 ++++++++++++++++++------------------ Src/UAppInfo.pas | 9 +++ 2 files changed, 81 insertions(+), 68 deletions(-) diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index 4d914bf08..8de05b152 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -17,8 +17,11 @@ interface uses + // Delphi + SysUtils, // Project - Favourites.UFavourites, UExceptions; + Favourites.UFavourites, + UExceptions; type @@ -33,10 +36,10 @@ TFavouritesPersist = record const /// Watermark that is present one the first line of a valid /// favourites file. - Watermark = #$25BA + ' CodeSnip Favourites v1 ' + #$25C4; - strict private - /// Returns fully specified name of the favourites file. - class function FavouritesFileName: string; static; + Watermark = #$25BA + ' CodeSnip Favourites v2 ' + #$25C4; + /// Returns date format settings to be used when writing and + /// reading the Favourites file. + class function DateFormatSettings: TFormatSettings; static; public /// Saves all favourites from given favourites list to file. /// @@ -52,7 +55,6 @@ implementation uses // Delphi - SysUtils, IOUtils, Classes, /// Project @@ -63,97 +65,99 @@ implementation UIOUtils, UIStringList, USnippetIDs, - UStrUtils; + UStrUtils, + UTabSeparatedFileIO; { TFavouritesPersist } -class function TFavouritesPersist.FavouritesFileName: string; +class function TFavouritesPersist.DateFormatSettings: TFormatSettings; begin - Result := IncludeTrailingPathDelimiter(TAppInfo.UserAppDir) - + 'Favourites'; + // We use YYYY-MM-DD HH:MM:SS date format in Favourites file + Result := TFormatSettings.Create; + Result.DateSeparator := '-'; + Result.TimeSeparator := ':'; + Result.ShortDateFormat := 'yyyy/mm/dd'; + Result.ShortTimeFormat := 'hh:nn:ss'; end; class procedure TFavouritesPersist.Load(Favourites: TFavourites); var - Lines: IStringList; - Line: string; - Fields: IStringList; - SnippetName: string; - LastAccess: TDateTime; - CollectionID: TCollectionID; + TSVReader: TTabSeparatedReader; resourcestring - sBadFormat = 'Invalid favourites file format'; + sBadFormat = 'Invalid favourites file format (v2)'; begin - if not TFile.Exists(FavouritesFileName, False) then + if not TFile.Exists(TAppInfo.UserFavouritesFileName, False) then Exit; + try - Lines := TIStringList.Create( - TFileIO.ReadAllLines(FavouritesFileName, TEncoding.UTF8, True) + TSVReader := TTabSeparatedReader.Create( + TAppInfo.UserFavouritesFileName, Watermark ); + try + TSVReader.Read( + procedure (AFields: TArray) + var + Key: string; + CollectionID: TCollectionID; + LastAccess: TDateTime; + begin + if Length(AFields) <> 3 then + raise EFavouritesPersist.Create(sBadFormat); + Key := StrTrim(AFields[0]); + CollectionID := TCollectionID.CreateFromHexString( + StrTrim(AFields[1]) + ); + LastAccess := StrToDateTime(StrTrim(AFields[2]), DateFormatSettings); + if Database.Snippets.Find(Key, CollectionID) <> nil then + Favourites.Add(TSnippetID.Create(Key, CollectionID), LastAccess); + end + ); + finally + TSVReader.Free; + end; + except - on E: EStreamError do + on E: EConvertError do raise EFavouritesPersist.Create(E); - on E: EIOUtils do + on E: ETabSeparatedReader do raise EFavouritesPersist.Create(E); else raise; end; - Line := Lines[0]; - if Line <> Watermark then - raise EFavouritesPersist.Create(sBadFormat); - Lines.Delete(0); - for Line in Lines do - begin - if StrTrim(Line) = '' then - Continue; - Fields := TIStringList.Create(Line, TAB, False, True); - if Fields.Count <> 3 then - raise EFavouritesPersist.Create(sBadFormat); - SnippetName := Fields[0]; - // accept any text as user collection, except "false" - CollectionID := TCollectionID.__TMP__UserDBCollectionID; - if StrSameText(Fields[1], 'false') then - // we have "false" so main collection - CollectionID := TCollectionID.__TMP__MainDBCollectionID; - if not TryStrToDateTime(Fields[2], LastAccess) then - raise EFavouritesPersist.Create(sBadFormat); - // only add to favourites if snippet in database - if Database.Snippets.Find(SnippetName, CollectionID) <> nil then - Favourites.Add(TSnippetID.Create(SnippetName, CollectionID), LastAccess); - end; end; class procedure TFavouritesPersist.Save(Favourites: TFavourites); var - SB: TStringBuilder; Fav: TFavourite; + TSVWriter: TTabSeparatedFileWriter; begin - SB := TStringBuilder.Create; + TDirectory.CreateDirectory( + TPath.GetDirectoryName(TAppInfo.UserFavouritesFileName) + ); try - SB.AppendLine(Watermark); - for Fav in Favourites do - begin - SB.Append(Fav.SnippetID.Key); - SB.Append(TAB); - SB.Append(BoolToStr(Fav.SnippetID.CollectionID <> TCollectionID.__TMP__MainDBCollectionID, True)); - SB.Append(TAB); - SB.Append(DateTimeToStr(Fav.LastAccessed)); - SB.AppendLine; - end; - TDirectory.CreateDirectory(TPath.GetDirectoryName(FavouritesFileName)); + TSVWriter := TTabSeparatedFileWriter.Create( + TAppInfo.UserFavouritesFileName, Watermark + ); try - TFileIO.WriteAllText( - FavouritesFileName, SB.ToString, TEncoding.UTF8, True - ); - except - on E: EStreamError do - raise EFavouritesPersist.Create(E); - else - raise; + for Fav in Favourites do + begin + TSVWriter.WriteLine( + [ + Fav.SnippetID.Key, + Fav.SnippetID.CollectionID.ToHexString, + DateTimeToStr(Fav.LastAccessed, DateFormatSettings) + ] + ); + end; + finally + TSVWriter.Free; end; - finally - SB.Free; + except + on E: EStreamError do + raise EFavouritesPersist.Create(E); + else + raise; end; end; diff --git a/Src/UAppInfo.pas b/Src/UAppInfo.pas index e27ab1ae2..aad6fdcf5 100644 --- a/Src/UAppInfo.pas +++ b/Src/UAppInfo.pas @@ -87,6 +87,10 @@ TAppInfo = class(TNoConstructObject) /// categories file. class function UserCategoriesFileName: string; + /// Returns fully specified name of the current user's favourites + /// file. + class function UserFavouritesFileName: string; + class function ProgramReleaseInfo: string; {Gets information about the current program release. Includes any special build information if present in version information. @@ -274,5 +278,10 @@ class function TAppInfo.UserDataDir: string; {$ENDIF} end; +class function TAppInfo.UserFavouritesFileName: string; +begin + Result := UserAppDir + '\Favourites'; +end; + end. From c9850a24d546c83132b5d6de0d4df9e7022700af Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 13 Nov 2024 17:03:36 +0000 Subject: [PATCH 084/222] Update status bar snippet count display Total number of snippets are still displayed, but the number of snippets in the "main" and "user" databases has been replaced by the number of collections. --- Src/UStatusBarMgr.pas | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/Src/UStatusBarMgr.pas b/Src/UStatusBarMgr.pas index f6aa4fa1d..5d9f219a1 100644 --- a/Src/UStatusBarMgr.pas +++ b/Src/UStatusBarMgr.pas @@ -350,30 +350,29 @@ procedure TStatusBarMgr.ShowSnippetsInfo; } var TotalSnippets: Integer; // number of snippets in database - TotalUserSnippets: Integer; // number of snippets in user database - TotalMainSnippets: Integer; // number of snippets in main database + TotalCollections: Integer; // number of collections in database resourcestring // status bar message strings sSnippet = 'snippet'; sSnippets = 'snippets'; - sStats = '%0:d %1:s (%2:d main / %3:d user defined)'; + sCollection = 'collection'; + sCollections = 'collections'; + sStats = '%0:d %1:s in %2:d %3:s'; const SnippetsStr: array[Boolean] of string = (sSnippet, sSnippets); + CollectionsStr: array[Boolean] of string = (sCollection, sCollections); begin // Calculate database stats TotalSnippets := Database.Snippets.Count; - TotalUserSnippets := Database.Snippets.Count( - TCollectionID.__TMP__UserDBCollectionID - ); - TotalMainSnippets := TotalSnippets - TotalUserSnippets; + TotalCollections := TCollections.Instance.Count; // Build display text and display it fStatusBar.Panels[cDBPanel].Text := Format( sStats, [ TotalSnippets, SnippetsStr[TotalSnippets <> 1], - TotalMainSnippets, - TotalUserSnippets + TotalCollections, + CollectionsStr[TotalCollections <> 1] ] ); end; From 57bfa5fb6d67f3cba83b42cc33fc6cb30f393c2d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 13 Nov 2024 20:27:34 +0000 Subject: [PATCH 085/222] Revised snippet selection file format re collections The Snippet Selection file format was redefined to be able to store a snippet's collection ID in hex format, along with the snippet's key. The saving and loading code in TSnippetIDListFileReader and TSnippetIDListFileWriter was rewritten to use the TTabSeparatedReader and TTabSeparatedFileWriter classes from UTabSeparatedFileIO to perform the reading, low level parsing, and writing of file. The file watermark was updated to v2. --- Src/USelectionIOMgr.pas | 2 +- Src/USnippetIDListIOHandler.pas | 118 ++++++++++++-------------------- 2 files changed, 44 insertions(+), 76 deletions(-) diff --git a/Src/USelectionIOMgr.pas b/Src/USelectionIOMgr.pas index 90f1061c1..effdd96db 100644 --- a/Src/USelectionIOMgr.pas +++ b/Src/USelectionIOMgr.pas @@ -51,7 +51,7 @@ implementation const /// Watermark for selection files. Uses characters that will be /// interpreted wrongly if the file is not in UTF8 format. - SelectionFileWatermark = #$25BA + ' CodeSnip Selections v1 ' + #$25C4; + SelectionFileWatermark = #$25BA + ' CodeSnip Selections v2 ' + #$25C4; { TSelectionIOMgr } diff --git a/Src/USnippetIDListIOHandler.pas b/Src/USnippetIDListIOHandler.pas index 64c47eeb9..82c8eb5ac 100644 --- a/Src/USnippetIDListIOHandler.pas +++ b/Src/USnippetIDListIOHandler.pas @@ -16,8 +16,11 @@ interface uses + // Delphi SysUtils, - UExceptions, UIStringList, USnippetIDs; + // Project + UExceptions, + USnippetIDs; type @@ -27,10 +30,7 @@ TSnippetIDListFileReader = class(TObject) var fWatermark: string; fSnippetIDs: ISnippetIDList; - /// Lines of text from file. - /// Must be stripped of blank lines. - fLines: IStringList; - procedure Parse; + procedure ParseLine(AFields: TArray); public constructor Create(const Watermark: string); function ReadFile(const FileName: string): ISnippetIDLIst; @@ -47,7 +47,6 @@ TSnippetIDListFileWriter = class(TObject) var fWatermark: string; fBuilder: TStringBuilder; - procedure CreateContent(const SnippetIDs: ISnippetIDList); public constructor Create(const Watermark: string); destructor Destroy; override; @@ -67,9 +66,8 @@ implementation Classes, // Project DB.UCollections, - UConsts, - UIOUtils, - UStrUtils; + UStrUtils, + UTabSeparatedFileIO; { TSnippetIDListFileReader } @@ -78,69 +76,48 @@ constructor TSnippetIDListFileReader.Create(const Watermark: string); begin inherited Create; fSnippetIDs := TSnippetIDList.Create; - fLines := TIStringList.Create; fWatermark := Watermark; end; -procedure TSnippetIDListFileReader.Parse; +procedure TSnippetIDListFileReader.ParseLine(AFields: TArray); resourcestring sBadFileFormat = 'Invalid snippet ID list file format'; - sMissingName = 'Snippet name missing on line' + EOL2 + '"%s"'; - sMissingUserDef = 'Snippet database specifier missing on line' - + EOL2 + '"%s"'; - sBadUserDef = 'Unknown snippet database specifier on line' - + EOL2 + '"%s"'; var - Line: string; // each line in fLines - Name: string; // name of each snippet - UserDefStr: string; // user defined value of each snippet as string - UserDefInt: Integer; // user defined value of each snippet as integer + Key: string; + CollectionHex: string; CollectionID: TCollectionID; begin - fSnippetIDs.Clear; - if (fLines.Count <= 1) or (fLines[0] <> fWatermark) then + Key := StrTrim(AFields[0]); + if Key = '' then raise ESnippetIDListFileReader.Create(sBadFileFormat); - fLines.Delete(0); - for Line in fLines do - begin - StrSplit(Line, TAB, Name, UserDefStr); - Name := StrTrim(Name); - UserDefStr := StrTrim(UserDefStr); - if Name = '' then - raise ESnippetIDListFileReader.CreateFmt(sMissingName, [Line]); - if UserDefStr = '' then - raise ESnippetIDListFileReader.CreateFmt(sMissingUserDef, [Line]); - if not TryStrToInt(UserDefStr, UserDefInt) then - raise ESnippetIDListFileReader.CreateFmt(sBadUserDef, [Line]); - case UserDefInt of - 0: CollectionID := TCollectionID.__TMP__MainDBCollectionID; - 1: CollectionID := TCollectionID.__TMP__UserDBCollectionID; - else - raise ESnippetIDListFileReader.CreateFmt(sBadUserDef, [Line]); - end; - fSnippetIDs.Add(TSnippetID.Create(Name, CollectionID)); - end; + CollectionHex := StrTrim(AFields[1]); + if CollectionHex = '' then + raise ESnippetIDListFileReader.Create(sBadFileFormat); + CollectionID := TCollectionID.CreateFromHexString(CollectionHex); + fSnippetIDs.Add(TSnippetID.Create(Key, CollectionID)); end; function TSnippetIDListFileReader.ReadFile(const FileName: string): ISnippetIDLIst; +var + TSVReader: TTabSeparatedReader; begin + fSnippetIDs.Clear; + TSVReader := TTabSeparatedReader.Create(FileName, fWatermark); try - fLines.SetText( - TFileIO.ReadAllText(FileName, TEncoding.UTF8, True), - CRLF, - False, - True - ); - except - on E: EStreamError do - raise ESnippetIDListFileReader.Create(E); - on E: EIOUtils do - raise ESnippetIDListFileReader.Create(E); - else - raise; + try + TSVReader.Read(ParseLine); + except + on E: ETabSeparatedReader do + raise ESnippetIDListFileReader.Create(E); + on E: ECollectionID do + raise ESnippetIDListFileReader.Create(E); + else + raise; + end; + finally + TSVReader.Free; end; - Parse; Result := fSnippetIDs; end; @@ -149,26 +126,9 @@ function TSnippetIDListFileReader.ReadFile(const FileName: string): constructor TSnippetIDListFileWriter.Create(const Watermark: string); begin inherited Create; - fBuilder := TStringBuilder.Create; fWatermark := Watermark; end; -procedure TSnippetIDListFileWriter.CreateContent( - const SnippetIDs: ISnippetIDList); -var - SnippetID: TSnippetID; -begin - fBuilder.Clear; - fBuilder.AppendLine(fWatermark); - for SnippetID in SnippetIDs do - begin - fBuilder.Append(SnippetID.Key); - fBuilder.Append(TAB); - fBuilder.Append(Ord(SnippetID.CollectionID <> TCollectionID.__TMP__MainDBCollectionID)); - fBuilder.AppendLine; - end; -end; - destructor TSnippetIDListFileWriter.Destroy; begin fBuilder.Free; @@ -177,10 +137,18 @@ destructor TSnippetIDListFileWriter.Destroy; procedure TSnippetIDListFileWriter.WriteFile(const FileName: string; SnippetIDs: ISnippetIDList); +var + TSVWriter: TTabSeparatedFileWriter; + SnippetID: TSnippetID; begin - CreateContent(SnippetIDs); + TSVWriter := TTabSeparatedFileWriter.Create(FileName, fWaterMark); try - TFileIO.WriteAllText(FileName, fBuilder.ToString, TEncoding.UTF8, True); + try + for SnippetID in SnippetIDs do + TSVWriter.WriteLine([SnippetID.Key, SnippetID.CollectionID.ToHexString]); + finally + TSVWriter.Free; + end; except on E: EStreamError do raise ESnippetIDListFileWriter.Create(E); From e46c14618f13fdf485c53d3e4501615ab8902be7 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 13 Nov 2024 21:59:07 +0000 Subject: [PATCH 086/222] Update welcome screen to display collections Details of the "main" and "user" database sections were removed from the Welcome page displayed in the Details pane. They were replaced by a single new "Collections" section that lists the available collections. Also changed the welcome page heading from "CodeSnip 4 by DelphiDabbler" to "CodeSnip Vault by DelphiDabbler (experimental)". A CSS new style for the "Collections" section caption was added and redundant CSS styles were deleted. Redundant HTML placeholder resolutions were removed. The welcome screen shown in the details pane --- Src/Res/CSS/detail.css | 6 +--- Src/Res/HTML/welcome-tplt.html | 63 +++++----------------------------- Src/UDetailPageHTML.pas | 42 ++++++++++------------- 3 files changed, 27 insertions(+), 84 deletions(-) diff --git a/Src/Res/CSS/detail.css b/Src/Res/CSS/detail.css index bea2dc732..47e097417 100644 --- a/Src/Res/CSS/detail.css +++ b/Src/Res/CSS/detail.css @@ -130,11 +130,7 @@ pre { border-bottom: 1px solid silver; } -#user-db .caption { - background-color: #D5E0FF; -} - -#main-db .caption { +#collections .caption { background-color: #DBD1FF; } diff --git a/Src/Res/HTML/welcome-tplt.html b/Src/Res/HTML/welcome-tplt.html index 189d82951..efa372d16 100644 --- a/Src/Res/HTML/welcome-tplt.html +++ b/Src/Res/HTML/welcome-tplt.html @@ -27,72 +27,25 @@

- CodeSnip 4 by DelphiDabbler + CodeSnip Vault by DelphiDabbler (experimental)

-
+
- Local User database + Collections
-
+
- There are <%UserDBCount%> snippets in the local user - database. + There are <%CollectionCount%> collections in the database:
- Add another snippet -
-
-
-
- No user defined snippets have been created yet. -
-
- Learn how to create your own snippets -
-
-
- -
-
- DelphiDabbler Code Snippets database -
-
-
- There are <%MainDBCount%> snippets in the DelphiDabbler - Code Snippets database. -
-
-
-
- The DelphiDabbler Code Snippets Database has not been - installed. - Learn more -
-
- Install it now +
    + <%CollectionList%> +
-
diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 91abcffc0..84f6a9d9f 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -419,8 +419,9 @@ function TWelcomePageHTML.GetTemplateResName: string; procedure TWelcomePageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); var - UserDBCount: Integer; - MainDBCount: Integer; + Collection: TCollection; + CollectionCount: Integer; + CollectionList: TStringBuilder; Compilers: ICompilers; Compiler: ICompiler; CompilerList: TStringBuilder; @@ -430,31 +431,24 @@ procedure TWelcomePageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); 'externalScript', TJavaScript.LoadScript('external.js', etWindows1252) ); - UserDBCount := Database.Snippets.Count( - TCollectionID.__TMP__UserDBCollectionID - ); - Tplt.ResolvePlaceholderHTML( - 'HaveUserDB', TCSS.BlockDisplayProp(UserDBCount > 0) - ); + CollectionCount := TCollections.Instance.Count; Tplt.ResolvePlaceholderHTML( - 'NoUserDB', TCSS.BlockDisplayProp(UserDBCount <= 0) - ); - Tplt.ResolvePlaceholderText( - 'UserDBCount', IntToStr(UserDBCount) + 'CollectionCount', IntToStr(CollectionCount) ); - MainDBCount := Database.Snippets.Count( - TCollectionID.__TMP__MainDBCollectionID - ); - Tplt.ResolvePlaceholderHTML( - 'HaveMainDB', TCSS.BlockDisplayProp(MainDBCount > 0) - ); - Tplt.ResolvePlaceholderHTML( - 'NoMainDB', TCSS.BlockDisplayProp(MainDBCount <= 0) - ); - Tplt.ResolvePlaceholderText( - 'MainDBCount', IntToStr(MainDBCount) - ); + CollectionList := TStringBuilder.Create; + try + for Collection in TCollections.Instance do + CollectionList.AppendLine( + THTML.CompoundTag( + 'li', + THTML.Entities(Collection.Name) + ) + ); + Tplt.ResolvePlaceholderHTML('CollectionList', CollectionList.ToString); + finally + CollectionList.Free; + end; Compilers := TCompilersFactory.CreateAndLoadCompilers; Tplt.ResolvePlaceholderHTML( From e3848f4ed485b14e5f3c5d50320877f440a8c9d5 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 13 Nov 2024 22:15:42 +0000 Subject: [PATCH 087/222] Remove redundant external object methods UpdateDbase and NewSnippet methods were removed from the browser's external object. Remove JavaScript functions that called the removed external object methods and Pascal implemention of external object in UWBExternal unit. Various associated INotifier methods and their implementations were removed, along with associated actions that are no longer required as a result of these changes. Also removed a commented out function from external.js --- Src/ExternalObj.ridl | 11 --------- Src/FmMain.pas | 2 -- Src/IntfNotifier.pas | 15 ------------ Src/Res/Scripts/external.js | 33 -------------------------- Src/UNotifier.pas | 47 ------------------------------------- Src/UWBExternal.pas | 28 ---------------------- 6 files changed, 136 deletions(-) diff --git a/Src/ExternalObj.ridl b/Src/ExternalObj.ridl index b60a9553e..b4f29f734 100644 --- a/Src/ExternalObj.ridl +++ b/Src/ExternalObj.ridl @@ -38,11 +38,6 @@ library ExternalObj ] interface IWBExternal15: IDispatch { - /* - * Update database from internet. - */ - [id(0x00000065)] - HRESULT _stdcall UpdateDbase(void); /* * Display snippet identified by key and collection ID. @@ -76,12 +71,6 @@ library ExternalObj [id(0x0000006E)] HRESULT _stdcall DisplayCategory([in] BSTR CatID, [in] VARIANT_BOOL NewTab); - /* - * Open Snippets Editor ready to create a new snippet. - */ - [id(0x0000006F)] - HRESULT _stdcall NewSnippet(void); - /* * Show news items from CodeSnip news feed. */ diff --git a/Src/FmMain.pas b/Src/FmMain.pas index 00293661c..25e81385b 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -1398,7 +1398,6 @@ procedure TMainForm.InitForm; // note that actions created on fly are automatically freed fNotifier := TNotifier.Create; ActionSetter := fNotifier as ISetActions; - ActionSetter.SetUpdateDbaseAction(actUpdateDbase); ActionSetter.SetDisplaySnippetAction( TActionFactory.CreateSnippetAction(Self) ); @@ -1418,7 +1417,6 @@ procedure TMainForm.InitForm; ActionSetter.SetEditSnippetAction( TActionFactory.CreateEditSnippetAction(Self, ActEditSnippetByIDExecute) ); - ActionSetter.SetNewSnippetAction(actAddSnippet); ActionSetter.SetNewsAction(actBlog); ActionSetter.SetAboutBoxAction(actAbout); diff --git a/Src/IntfNotifier.pas b/Src/IntfNotifier.pas index c24d19c40..5e07ab102 100644 --- a/Src/IntfNotifier.pas +++ b/Src/IntfNotifier.pas @@ -30,9 +30,6 @@ interface INotifier = interface(IInterface) ['{13962DE4-784A-4B70-9D3F-FD434FAE4F4F}'] - /// Requests a database update. - procedure UpdateDbase; - /// Displays a snippet. /// WideString [in] Required snippet's key. /// @@ -74,9 +71,6 @@ interface procedure EditSnippet(const Key: WideString; const ACollectionID: TCollectionID); - /// Opens Snippets Editor ready to create a new snippet. - procedure NewSnippet; - /// Displays news items from the CodeSnip news feed. procedure ShowNews; @@ -93,10 +87,6 @@ interface ISetActions = interface(IInterface) ['{A4B7AFE2-EE6C-4D39-BEA6-B52CC8AAC1DE}'] - /// Sets action used to request a database update. - /// TBasicAction [in] Required action. - procedure SetUpdateDbaseAction(const Action: TBasicAction); - /// Sets action used to display a snippet. /// TBasicAction [in] Required action. procedure SetDisplaySnippetAction(const Action: TBasicAction); @@ -133,11 +123,6 @@ interface /// TBasicAction [in] Required action. procedure SetDisplayCategoryAction(const Action: TBasicAction); - /// Sets action used to open snippets editor to create a new - /// snippet. - /// TBasicAction [in] Required action. - procedure SetNewSnippetAction(const Action: TBasicAction); - /// Sets action used to display news items from the CodeSnip news /// feed. /// TBasicAction [in] Required action. diff --git a/Src/Res/Scripts/external.js b/Src/Res/Scripts/external.js index faf53d1f8..09a050cf6 100644 --- a/Src/Res/Scripts/external.js +++ b/Src/Res/Scripts/external.js @@ -21,29 +21,6 @@ function configCompilers() { return false; } -/* - * Calls external object to get host application to display Update Database - * dialog box. - * @return False. - */ -function updateDbase() { - external.UpdateDbase(); - return false; -} - -/* - * Calls external object to get host application to display a named snippet. - * @param string snippet [in] Name of snippet to be displayed. - * @param boolean userdefined [in] Whether snippet is user defined. - * @return False. - * -function displaySnippet(snippet, userdefined) { - var e = window.event; - external.DisplaySnippet(snippet, userdefined, e.ctrlKey); - return false; -} -*/ - /* * Calls external object to get host application to display a named snippet. * @param string snippet [in] Key of snippet to be displayed. @@ -80,16 +57,6 @@ function editSnippet(snippet, collectionId) { return false; } -/* - * Calls external object to get host application to start Snippets Editor ready - * for a new snippet to be entered. - * @return False. - */ -function newSnippet() { - external.NewSnippet(); - return false; -} - /* * Calls external object to get host application to display the CodeSnip news * blog. diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index cc8dc7c23..a5d4174e2 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -37,8 +37,6 @@ interface TNotifier = class(TInterfacedObject, INotifier, ISetActions) strict private var - /// Action that triggers a database update. - fUpdateDbaseAction: TBasicAction; /// Action that causes a named snippet to be displayed. /// fDisplaySnippetAction: TBasicAction; @@ -58,9 +56,6 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) fEditSnippetAction: TBasicAction; /// Action that causes a category to be displayed. fDisplayCategoryAction: TBasicAction; - /// Action that causes the Snippets Editor to be opened ready to - /// create a new snippet. - fNewSnippetAction: TBasicAction; /// Action that causes news items from CodeSnip news feed to be /// displayed. fNewsAction: TBasicAction; @@ -69,10 +64,6 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) public - /// Requests a database update. - /// Methods of INotifier. - procedure UpdateDbase; - /// Displays a snippet. /// WideString [in] Required snippet's key. /// @@ -122,10 +113,6 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) procedure EditSnippet(const Key: WideString; const ACollectionID: TCollectionID); - /// Opens Snippets Editor ready to create a new snippet. - /// Methods of INotifier. - procedure NewSnippet; - /// Displays news items from the CodeSnip news feed. /// Methods of INotifier. procedure ShowNews; @@ -134,11 +121,6 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) /// Methods of INotifier. procedure ShowAboutBox; - /// Sets action used to request a database update. - /// TBasicAction [in] Required action. - /// Methods of ISetActions. - procedure SetUpdateDbaseAction(const Action: TBasicAction); - /// Sets action used to display a snippet. /// TBasicAction [in] Required action. /// Methods of ISetActions. @@ -184,12 +166,6 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) /// Methods of ISetActions. procedure SetDisplayCategoryAction(const Action: TBasicAction); - /// Sets action used to open snippets editor to create a new - /// snippet. - /// TBasicAction [in] Required action. - /// Methods of ISetActions. - procedure SetNewSnippetAction(const Action: TBasicAction); - /// Sets action used to display news items from the CodeSnip news /// feed. /// TBasicAction [in] Required action. @@ -279,12 +255,6 @@ procedure TNotifier.EditSnippet(const Key: WideString; end; end; -procedure TNotifier.NewSnippet; -begin - if Assigned(fNewSnippetAction) then - fNewSnippetAction.Execute; -end; - procedure TNotifier.SetAboutBoxAction(const Action: TBasicAction); begin fAboutBoxAction := Action; @@ -335,11 +305,6 @@ procedure TNotifier.SetNewsAction(const Action: TBasicAction); fNewsAction := Action; end; -procedure TNotifier.SetNewSnippetAction(const Action: TBasicAction); -begin - fNewSnippetAction := Action; -end; - procedure TNotifier.SetOverviewStyleChangeActions( const Actions: array of TBasicAction); var @@ -355,12 +320,6 @@ procedure TNotifier.SetShowViewItemAction(const Action: TBasicAction); fShowViewItemAction := Action; end; -procedure TNotifier.SetUpdateDbaseAction( - const Action: TBasicAction); -begin - fUpdateDbaseAction := Action; -end; - procedure TNotifier.ShowAboutBox; begin if Assigned(fAboutBoxAction) then @@ -383,11 +342,5 @@ procedure TNotifier.ShowViewItem(ViewItem: IView; const NewTab: Boolean); end; end; -procedure TNotifier.UpdateDbase; -begin - if Assigned(fUpdateDbaseAction) then - fUpdateDbaseAction.Execute; -end; - end. diff --git a/Src/UWBExternal.pas b/Src/UWBExternal.pas index 10995e94e..851b1e93a 100644 --- a/Src/UWBExternal.pas +++ b/Src/UWBExternal.pas @@ -53,10 +53,6 @@ TWBExternal = class(TAutoIntfObject, IWBExternal15, ISetNotifier) /// library.
 constructor Create; - /// Updates database from internet. - /// Method of IWBExternal15. - procedure UpdateDbase; safecall; - /// Display snippet identified by key and collection ID. /// WideString [in] Snippet's key. /// WideString [in] Hex representation of @@ -92,10 +88,6 @@ TWBExternal = class(TAutoIntfObject, IWBExternal15, ISetNotifier) procedure DisplayCategory(const CatID: WideString; NewTab: WordBool); safecall; - /// Opens Snippet Editor ready to create a new snippet. - /// Method of IWBExternal15. - procedure NewSnippet; safecall; - /// Shows latest news items from CodeSnip news feed. /// Method of IWBExternal15. procedure ShowNews; safecall; @@ -192,16 +184,6 @@ procedure TWBExternal.HandleException; Application.HandleException(ExceptObject); end; -procedure TWBExternal.NewSnippet; -begin - try - if Assigned(fNotifier) then - fNotifier.NewSnippet; - except - HandleException; - end; -end; - procedure TWBExternal.SetNotifier(const Notifier: INotifier); begin fNotifier := Notifier; @@ -227,15 +209,5 @@ procedure TWBExternal.ShowNews; end; end; -procedure TWBExternal.UpdateDbase; -begin - try - if Assigned(fNotifier) then - fNotifier.UpdateDbase; - except - HandleException; - end; -end; - end. From 860faa378260b4fbb44f9f282b1a31584978f3ae Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 14 Nov 2024 19:32:20 +0000 Subject: [PATCH 088/222] Add TCollectionID.TComparer and TCollectionID.Hash Added a new Hash method to TCollectionID. Added a new TComparer nested class to TCollectionID that implements IComparer and IEqualityComparer. This provides Compare, Equals and GetHashCode methods. The GetHashCode method calls the new TCollectionID.Hash method. --- Src/DB.UCollections.pas | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 3e321aa42..4a575c1e6 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -18,6 +18,7 @@ interface uses SysUtils, Generics.Collections, + Generics.Defaults, UEncodings, UExceptions, USettings, @@ -81,6 +82,17 @@ TCollectionID = record var fID: TBytes; public + type + TComparer = class(TInterfacedObject, + IComparer, IEqualityComparer + ) + public + function Compare(const Left, Right: TCollectionID): Integer; + function Equals(const Left, Right: TCollectionID): Boolean; + reintroduce; + function GetHashCode(const Value: TCollectionID): Integer; + reintroduce; + end; const DCSC_v2_ID: TGUID = '{9F3A4A8A-0A2B-4088-B7C9-AE1D32D3FF9A}'; SWAG_v1_ID: TGUID = '{ADA985E0-0929-4986-A3FE-B2C981D430F1}'; @@ -96,6 +108,7 @@ TCollectionID = record function ToHexString: string; function IsBuiltInID: Boolean; function IsNull: Boolean; + function Hash: Integer; class function Compare(Left, Right: TCollectionID): Integer; static; class operator Equal(Left, Right: TCollectionID): Boolean; class operator NotEqual(Left, Right: TCollectionID): Boolean; @@ -239,9 +252,11 @@ TCollectionsPersist = record implementation uses + // Delphi RTLConsts, IOUtils, Math, + // Project UAppInfo, // TODO -cVault: needed only for v4 emulation UStrUtils, UUtils; @@ -528,6 +543,11 @@ class function TCollectionID.CreateNull: TCollectionID; Result := IsEqualBytes(Left.fID, Right.fID); end; +function TCollectionID.Hash: Integer; +begin + Result := BobJenkinsHash(fID[0], Length(fID), 0); +end; + function TCollectionID.IsBuiltInID: Boolean; begin Result := (TCollectionID.Create(DCSC_v2_ID) = Self) @@ -565,6 +585,26 @@ class function TCollectionID.__TMP__UserDBCollectionID: TCollectionID; Result := TCollectionID.Create(Native_v4_ID); end; +{ TCollectionID.TComparer } + +function TCollectionID.TComparer.Compare(const Left, + Right: TCollectionID): Integer; +begin + Result := TCollectionID.Compare(Left, Right); +end; + +function TCollectionID.TComparer.Equals(const Left, + Right: TCollectionID): Boolean; +begin + Result := Left = Right; +end; + +function TCollectionID.TComparer.GetHashCode( + const Value: TCollectionID): Integer; +begin + Result := Value.Hash; +end; + { TCollectionsPersist } class procedure TCollectionsPersist.Load( From a2c16aa1acb28ac0bef8e6c2a45095fc53f4e516 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 15 Nov 2024 09:14:54 +0000 Subject: [PATCH 089/222] Revise display preferences re collections Updated display preferences stored in config file by removing settings for the old "main" and "user" database snippet colours and replacing them with separate settings for snippet heading colours for each collection and a different colour setting for group headings. Heavily revised the Display page of the Preferences dialogue box to allow the user to enter and edit the new colour preferences. Replaced default colours for "main" and "user" snippets with default colours for snippet and group headings. Made minimal changes to code that uses the changed preferences to display snippet headings and tree nodes in the colour assigned to their collection and/or to display group headings in the colour assigned to them. It most cases preferences method calls on one or two lines were all that was required. In other cases more significant changes were required. --- Src/FmDependenciesDlg.pas | 4 +- Src/FmFavouritesDlg.pas | 4 +- Src/FmFindXRefsDlg.pas | 2 +- Src/FmTestCompileDlg.pas | 2 +- Src/FrDetailView.pas | 34 +++- Src/FrDisplayPrefs.dfm | 54 ++--- Src/FrDisplayPrefs.pas | 247 ++++++++++++++++++----- Src/UColours.pas | 10 +- Src/UDetailPageHTML.pas | 2 +- Src/UPreferences.pas | 379 +++++++++++++++++++++--------------- Src/URTFCategoryDoc.pas | 6 +- Src/URTFSnippetDoc.pas | 6 +- Src/USnippetsChkListMgr.pas | 2 +- Src/USnippetsTVDraw.pas | 4 +- 14 files changed, 507 insertions(+), 249 deletions(-) diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index 5a7c32bb4..cc723100b 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -419,7 +419,9 @@ procedure TDependenciesDlg.lbDependentsDrawItem(Control: TWinControl; LB := Control as TListBox; Canvas := LB.Canvas; if not (odSelected in State) then - Canvas.Font.Color := Preferences.GetDBHeadingColour(ExtractCollectionItem); + Canvas.Font.Color := Preferences.GetSnippetHeadingColour( + ExtractCollectionItem + ); Canvas.TextRect( Rect, Rect.Left + 2, diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index 06f92d52f..5148b5252 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -583,7 +583,9 @@ procedure TFavouritesDlg.LVCustomDrawItem(Sender: TCustomListView; CollectionID: TCollectionID; begin CollectionID := (Item as TFavouriteListItem).Favourite.SnippetID.CollectionID; - fLVFavs.Canvas.Font.Color := Preferences.GetDBHeadingColour(CollectionID); + fLVFavs.Canvas.Font.Color := Preferences.GetSnippetHeadingColour( + CollectionID + ); end; procedure TFavouritesDlg.LVCustomDrawSubItem(Sender: TCustomListView; diff --git a/Src/FmFindXRefsDlg.pas b/Src/FmFindXRefsDlg.pas index b85259741..829cf9873 100644 --- a/Src/FmFindXRefsDlg.pas +++ b/Src/FmFindXRefsDlg.pas @@ -235,7 +235,7 @@ procedure TFindXRefsDlg.ConfigForm; // Set label font styles and colours lblSnippetName.Font.Style := [fsBold]; lblSnippetName.Font.Color := - Preferences.GetDBHeadingColour(fSnippet.CollectionID); + Preferences.GetSnippetHeadingColour(fSnippet.CollectionID); // Display selected snippet name in appropriate controls lblSnippetName.Caption := fSnippet.DisplayName; chkIncludeSnippet.Caption := Format( diff --git a/Src/FmTestCompileDlg.pas b/Src/FmTestCompileDlg.pas index c35ea4c24..359c09892 100644 --- a/Src/FmTestCompileDlg.pas +++ b/Src/FmTestCompileDlg.pas @@ -289,7 +289,7 @@ procedure TTestCompileDlg.ConfigForm; // Set required label fonts and captions TFontHelper.SetDefaultBaseFont(lblSnippetName.Font); lblSnippetName.Font.Color := - Preferences.GetDBHeadingColour(fSnippet.CollectionID); + Preferences.GetSnippetHeadingColour(fSnippet.CollectionID); lblSnippetName.Caption := fSnippet.DisplayName; end; diff --git a/Src/FrDetailView.pas b/Src/FrDetailView.pas index 65411bf8f..e8e8cbff5 100644 --- a/Src/FrDetailView.pas +++ b/Src/FrDetailView.pas @@ -17,7 +17,7 @@ interface uses // Delphi - OleCtrls, SHDocVw, Classes, Controls, ExtCtrls, Windows, ActiveX, + OleCtrls, SHDocVw, Classes, Controls, ExtCtrls, Windows, ActiveX, Graphics, // Project FrBrowserBase, IntfFrameMgrs, UCommandBars, UCSSBuilder, UDetailPageLoader, USearch, UView, UWBPopupMenus; @@ -44,6 +44,14 @@ TDetailViewFrame = class {sealed}(TBrowserBaseFrame, /// Generates and loads HTML representing a view into browser /// control. fPageLoader: TDetailPageLoader; + /// Records colour to be defined when defining CSS classes to + /// display page heading. + fHeadingColour: TColor; + /// Calculates colour of page heading, according to the type of + /// view being displayed. + /// IView [in] View for which heading colour is + /// required. + function GetHeadingColour(AView: IView): TColor; /// Handles web browser UI manager's OnMenuPopup event. Pops up /// relevant menu if appropriate. /// TObject [in] Not used. @@ -107,7 +115,7 @@ implementation uses // Delphi - SysUtils, Graphics, Menus, Math, + SysUtils, Menus, Math, // Project ActiveText.UHTMLRenderer, Browser.UHighlighter, DB.UCollections, @@ -228,10 +236,13 @@ procedure TDetailViewFrame.BuildCSS(const CSSBuilder: TCSSBuilder); .AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); // Heading colours for user & main databases + {TODO -vault: replace all following classes with single ".heading" class} CSSBuilder.AddSelector('.userdb') - .AddProperty(TCSS.ColorProp(Preferences.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID))); + .AddProperty(TCSS.ColorProp(fHeadingColour)); CSSBuilder.AddSelector('.maindb') - .AddProperty(TCSS.ColorProp(Preferences.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID))); + .AddProperty(TCSS.ColorProp(fHeadingColour)); + CSSBuilder.AddSelector('.group-heading') + .AddProperty(TCSS.ColorProp(fHeadingColour)); // Sets CSS for style of New Tab text CSSFont.Assign(ContentFont); @@ -356,6 +367,8 @@ procedure TDetailViewFrame.Display(View: IView); var Filter: ITextSearchFilter; // text search filter containing criteria begin + fHeadingColour := GetHeadingColour(View); + // Load view's HTML into browser control fPageLoader.LoadPage(View); // Clear any existing text selection @@ -366,6 +379,19 @@ procedure TDetailViewFrame.Display(View: IView); Supports(Query.LatestSearch.Filter, ITextSearchFilter, Filter) then HighlightSearchResults(Filter); + +end; + +function TDetailViewFrame.GetHeadingColour(AView: IView): TColor; +var + SnippetView: ISnippetView; +begin + if Supports(AView, ISnippetView, SnippetView) then + Result := Preferences.GetSnippetHeadingColour( + SnippetView.Snippet.CollectionID + ) + else + Result := Preferences.GroupHeadingColour; end; procedure TDetailViewFrame.HighlightSearchResults( diff --git a/Src/FrDisplayPrefs.dfm b/Src/FrDisplayPrefs.dfm index 80a7370ef..d34c1c858 100644 --- a/Src/FrDisplayPrefs.dfm +++ b/Src/FrDisplayPrefs.dfm @@ -1,8 +1,8 @@ inherited DisplayPrefsFrame: TDisplayPrefsFrame - Width = 397 - Height = 311 - ExplicitWidth = 397 - ExplicitHeight = 311 + Width = 438 + Height = 347 + ExplicitWidth = 438 + ExplicitHeight = 347 object lblOverviewTree: TLabel Left = 16 Top = 6 @@ -11,30 +11,31 @@ inherited DisplayPrefsFrame: TDisplayPrefsFrame Caption = 'Start &overview pane treeview as:' FocusControl = cbOverviewTree end - object lblMainColour: TLabel + object lblGroupHeadingColour: TLabel Left = 16 - Top = 96 - Width = 193 + Top = 112 + Width = 191 Height = 13 - Caption = 'Heading colour for &main database items:' + Caption = '&Group heading colour in overview pane:' end - object lblUserColour: TLabel + object lblCollectionColours: TLabel Left = 16 - Top = 115 - Width = 192 + Top = 139 + Width = 240 Height = 13 - Caption = 'Heading colour for &user database items:' + Caption = 'Heading colour snippets from different &collections:' + FocusControl = cbCollection end object lblSourceBGColour: TLabel Left = 16 - Top = 134 + Top = 200 Width = 170 Height = 13 Caption = 'Background colour for &source code:' end object lblOverviewFontSize: TLabel Left = 16 - Top = 200 + Top = 253 Width = 145 Height = 13 Caption = 'Overview tree view &font size: ' @@ -42,7 +43,7 @@ inherited DisplayPrefsFrame: TDisplayPrefsFrame end object lblDetailFontSize: TLabel Left = 16 - Top = 232 + Top = 280 Width = 105 Height = 13 Caption = 'Detail pane font si&ze: ' @@ -50,9 +51,9 @@ inherited DisplayPrefsFrame: TDisplayPrefsFrame end object lblHiliterInfo: TLabel Left = 16 - Top = 256 - Width = 370 - Height = 36 + Top = 304 + Width = 358 + Height = 26 Caption = 'To change the size of the source code font use the the Syntax Hi' + 'ghlighter options page.' @@ -88,16 +89,16 @@ inherited DisplayPrefsFrame: TDisplayPrefsFrame end object btnDefColours: TButton Left = 16 - Top = 156 + Top = 219 Width = 192 Height = 25 - Caption = 'Use Default &Colours' + Caption = 'Use &Default Colours' TabOrder = 3 OnClick = btnDefColoursClick end object cbOverviewFontSize: TComboBox Left = 192 - Top = 197 + Top = 250 Width = 57 Height = 21 TabOrder = 4 @@ -105,10 +106,19 @@ inherited DisplayPrefsFrame: TDisplayPrefsFrame end object cbDetailFontSize: TComboBox Left = 192 - Top = 229 + Top = 277 Width = 57 Height = 21 TabOrder = 5 OnChange = FontSizeChange end + object cbCollection: TComboBox + Left = 16 + Top = 158 + Width = 170 + Height = 21 + Style = csDropDownList + TabOrder = 6 + OnChange = cbCollectionChange + end end diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index 3f0433599..926c561a5 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -19,9 +19,18 @@ interface uses // Delphi - Controls, StdCtrls, Classes, + Controls, + StdCtrls, + Classes, + Graphics, + Generics.Collections, // Project - FrPrefsBase, UColorBoxEx, UColorDialogEx, UPreferences; + DB.UCollections, + FrPrefsBase, + UCollectionListAdapter, + UColorBoxEx, + UColorDialogEx, + UPreferences; type @@ -31,8 +40,8 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) cbOverviewTree: TComboBox; chkHideEmptySections: TCheckBox; chkSnippetsInNewTab: TCheckBox; - lblMainColour: TLabel; - lblUserColour: TLabel; + lblGroupHeadingColour: TLabel; + lblCollectionColours: TLabel; btnDefColours: TButton; lblSourceBGColour: TLabel; lblOverviewFontSize: TLabel; @@ -40,19 +49,29 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) lblDetailFontSize: TLabel; cbDetailFontSize: TComboBox; lblHiliterInfo: TLabel; + cbCollection: TComboBox; procedure chkHideEmptySectionsClick(Sender: TObject); procedure btnDefColoursClick(Sender: TObject); procedure FontSizeChange(Sender: TObject); + procedure cbCollectionChange(Sender: TObject); strict private var /// Flag indicating if changes affect UI. fUIChanged: Boolean; - fMainColourBox: TColorBoxEx; - fMainColourDlg: TColorDialogEx; - fUserColourBox: TColorBoxEx; - fUserColourDlg: TColorDialogEx; + + /// Local copy of snippet heading / tree node colour for each + /// collection. + fSnippetHeadingColours: TDictionary; + + fGroupHeadingColourBox: TColorBoxEx; + fGroupHeadingColourDlg: TColorDialogEx; + fSnippetHeadingColourBox: TColorBoxEx; + fSnippetHeadingColourDlg: TColorDialogEx; fSourceBGColourBox: TColorBoxEx; fSourceBGColourDlg: TColorDialogEx; + + fCollList: TCollectionListAdapter; + procedure SelectOverviewTreeState(const State: TOverviewStartState); {Selects combo box item associated with a overview treeview startup state. @param State [in] Startup state to be selected. @@ -62,15 +81,23 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) @param State [in] State for which description is required. @return Required description. } - function CreateCustomColourBox(const ColourDlg: TColorDialogEx): + function CreateCustomColourBox(const ColourDlg: TColorDialogEx; + ChangeHandler: TNotifyEvent): TColorBoxEx; procedure ColourBoxChangeHandler(Sender: TObject); + procedure SnippetHeadingColourBoxChange(Sender: TObject); procedure PopulateFontSizeCombos; + procedure SetTabOrder; + function SelectedCollectionID: TCollectionID; public constructor Create(AOwner: TComponent); override; - {Class constructor. Sets up frame and populates controls. + {Object constructor. Sets up frame and populates controls. @param AOwner [in] Component that owns frame. } + + /// Object destructor. Frees owned objects. + destructor Destroy; override; + procedure Activate(const Prefs: IPreferences; const Flags: UInt64); override; {Called when page activated. Updates controls. @@ -105,10 +132,16 @@ implementation uses // Delphi - SysUtils, Math, Graphics, ExtCtrls, + SysUtils, + Generics.Defaults, + Math, + ExtCtrls, // Project - DB.UCollections, - FmPreferencesDlg, UColours, UCtrlArranger, UFontHelper, UGraphicUtils, + FmPreferencesDlg, + UColours, + UCtrlArranger, + UFontHelper, + UGraphicUtils, UMessageBox; @@ -128,93 +161,146 @@ procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences; {Called when page activated. Updates controls. @param Prefs [in] Object that provides info used to update controls. } +var + Collection: TCollection; begin + {TODO -cCollections: Replace __TMP__ method below with call to a new + TCollections.Default method or similar.} + cbCollection.ItemIndex := TCollections.Instance.IndexOfID(TCollectionID.__TMP__UserDBCollectionID); + Assert(cbCollection.ItemIndex >= 0, + ClassName + '.Activate: no default collection found'); + SelectOverviewTreeState(Prefs.OverviewStartState); chkHideEmptySections.OnClick := nil; // prevent OnClick when Checked set chkHideEmptySections.Checked := not Prefs.ShowEmptySections; chkHideEmptySections.OnClick := chkHideEmptySectionsClick; chkSnippetsInNewTab.Checked := Prefs.ShowNewSnippetsInNewTabs; - fMainColourBox.Selected := Prefs.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID); - fUserColourBox.Selected := Prefs.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID); + fGroupHeadingColourBox.Selected := Prefs.GroupHeadingColour; + fSnippetHeadingColours.Clear; + for Collection in TCollections.Instance do + fSnippetHeadingColours.Add( + Collection.UID, Prefs.GetSnippetHeadingColour(Collection.UID) + ); + fSnippetHeadingColourBox.Selected := + Prefs.GetSnippetHeadingColour(SelectedCollectionID); fSourceBGColourBox.Selected := Prefs.SourceCodeBGcolour; - Prefs.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID).CopyTo(fMainColourDlg.CustomColors, True); - Prefs.GetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID).CopyTo(fUserColourDlg.CustomColors, True); + Prefs.GroupHeadingCustomColours.CopyTo( + fGroupHeadingColourDlg.CustomColors, True + ); Prefs.SourceCodeBGCustomColours.CopyTo(fSourceBGColourDlg.CustomColors, True); cbOverviewFontSize.Tag := Prefs.OverviewFontSize; // store font size in .Tag cbOverviewFontSize.Text := IntToStr(Prefs.OverviewFontSize); cbDetailFontSize.Tag := Prefs.DetailFontSize; // store font size in .Tag cbDetailFontSize.Text := IntToStr(Prefs.DetailFontSize); + end; procedure TDisplayPrefsFrame.ArrangeControls; {Arranges controls on frame. Called after frame has been sized. } begin + // Align controls on left TCtrlArranger.AlignLefts( [ - lblOverviewTree, chkHideEmptySections, chkSnippetsInNewTab, - lblMainColour, lblUserColour, lblSourceBGColour, btnDefColours, - lblOverviewFontSize, lblDetailFontSize, lblHiliterInfo + lblOverviewTree, chkSnippetsInNewTab, chkHideEmptySections, + lblGroupHeadingColour, lblCollectionColours, lblSourceBGColour, + btnDefColours, lblOverviewFontSize, lblDetailFontSize, lblHiliterInfo ], 0 ); + // Align collections combo indented from left + cbCollection.Left := 8; + + // Align controls on right: make sure they are all to right of everything + // on left that is on same line as any of them. TCtrlArranger.AlignLefts( [ - cbOverviewTree, fMainColourBox, fUserColourBox, fSourceBGColourBox, - cbOverviewFontSize, cbDetailFontSize + cbOverviewTree, fGroupHeadingColourBox, fSnippetHeadingColourBox, + fSourceBGColourBox, cbOverviewFontSize, cbDetailFontSize ], TCtrlArranger.RightOf( - [lblOverviewTree, lblMainColour, lblUserColour, lblSourceBGColour], + [ + lblOverviewTree, lblGroupHeadingColour, cbCollection, lblSourceBGColour, + lblOverviewFontSize, lblDetailFontSize + ], 8 ) ); + + // Align rows: + // 1st row TCtrlArranger.AlignVCentres(3, [lblOverviewTree, cbOverviewTree]); + // 2nd row TCtrlArranger.MoveBelow( [lblOverviewTree, cbOverviewTree], chkSnippetsInNewTab, 12 ); + chkSnippetsInNewTab.Width := Self.Width - 16; + // 3rd row TCtrlArranger.MoveBelow(chkSnippetsInNewTab, chkHideEmptySections, 8); + chkHideEmptySections.Width := Self.Width - 16; + // 4th row TCtrlArranger.AlignVCentres( TCtrlArranger.BottomOf(chkHideEmptySections, 12), - [lblMainColour, fMainColourBox] + [lblGroupHeadingColour, fGroupHeadingColourBox] + ); + // 5th row + TCtrlArranger.MoveBelow( + [lblGroupHeadingColour, fGroupHeadingColourBox], + lblCollectionColours, + 12 ); + // 6th row TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf([lblMainColour, fMainColourBox], 6), - [lblUserColour, fUserColourBox] + TCtrlArranger.BottomOf(lblCollectionColours, 6), + [cbCollection, fSnippetHeadingColourBox] ); + // 7th row TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf([lblUserColour, fUserColourBox], 6), + TCtrlArranger.BottomOf([cbCollection, fSnippetHeadingColourBox], 18), [lblSourceBGColour, fSourceBGColourBox] ); + // 8th row TCtrlArranger.MoveBelow( - [lblSourceBGColour, fSourceBGColourBox], btnDefColours, 6 + [lblSourceBGColour, fSourceBGColourBox], btnDefColours, 12 ); + // 9th row TCtrlArranger.AlignVCentres( TCtrlArranger.BottomOf(btnDefColours, 12), [lblOverviewFontSize, cbOverviewFontSize] ); + // 10th row TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf(cbOverviewFontSize, 8), + TCtrlArranger.BottomOf([lblOverviewFontSize, cbOverviewFontSize], 8), [lblDetailFontSize, cbDetailFontSize] ); + // 11th row TCtrlArranger.MoveBelow( [lblDetailFontSize, cbDetailFontSize], lblHiliterInfo, 12 ); lblHiliterInfo.Width := Self.ClientWidth; TCtrlArranger.SetLabelHeight(lblHiliterInfo); - chkHideEmptySections.Width := Self.Width - 16; - chkSnippetsInNewTab.Width := Self.Width - 16; end; procedure TDisplayPrefsFrame.btnDefColoursClick(Sender: TObject); +var + Collection: TCollection; begin // Restores default heading and source code background colours in colour // combo boxes - fMainColourBox.Selected := clMainSnippet; - fUserColourBox.Selected := clUserSnippet; + fGroupHeadingColourBox.Selected := clDefGroupHeading; + fSnippetHeadingColourBox.Selected := clDefSnippetHeading; + for Collection in TCollections.Instance do + fSnippetHeadingColours[Collection.UID] := clDefSnippetHeading; fSourceBGColourBox.Selected := clSourceBg; fUIChanged := True; end; +procedure TDisplayPrefsFrame.cbCollectionChange(Sender: TObject); +begin + fSnippetHeadingColourBox.Selected := + fSnippetHeadingColours[SelectedCollectionID]; +end; + procedure TDisplayPrefsFrame.chkHideEmptySectionsClick(Sender: TObject); {Handles clicks on "Hide Empty Sections" check box. Flags UI preferences has having changed. @@ -235,6 +321,7 @@ constructor TDisplayPrefsFrame.Create(AOwner: TComponent); } resourcestring sHeadingColourDlgTitle = 'Heading Colour'; + sGroupHeadingColourDlgTitle = 'Group Heading Colour'; sSourceBGColourDlgTitle = 'Source Code Background Colour'; var OTStateIdx: TOverviewStartState; // loops thru each overview tree start state @@ -247,28 +334,42 @@ constructor TDisplayPrefsFrame.Create(AOwner: TComponent); OverviewTreeStateDesc(OTStateIdx), TObject(OTStateIdx) ); // Create colour dialogue boxes - fMainColourDlg := TColorDialogEx.Create(Self); - fMainColourDlg.Title := sHeadingColourDlgTitle; - fUserColourDlg := TColorDialogEx.Create(Self); - fUserColourDlg.Title := sHeadingColourDlgTitle; + fGroupHeadingColourDlg := TColorDialogEx.Create(Self); + fGroupHeadingColourDlg.Title := sGroupHeadingColourDlgTitle; + fSnippetHeadingColourDlg := TColorDialogEx.Create(Self); + fSnippetHeadingColourDlg.Title := sHeadingColourDlgTitle; fSourceBGColourDlg := TColorDialogEx.Create(Self); fSourceBGColourDlg.Title := sSourceBGColourDlgTitle; // Create colour combo boxes - fMainColourBox := CreateCustomColourBox(fMainColourDlg); - fMainColourBox.TabOrder := 3; - lblMainColour.FocusControl := fMainColourBox; - fUserColourBox := CreateCustomColourBox(fUserColourDlg); - fUserColourBox.TabOrder := 4; - lblUserColour.FocusControl := fUserColourBox; - fSourceBGColourBox := CreateCustomColourBox(fSourceBGColourDlg); - fSourceBGColourBox.TabOrder := 5; + fGroupHeadingColourBox := CreateCustomColourBox( + fGroupHeadingColourDlg, ColourBoxChangeHandler + ); + lblGroupHeadingColour.FocusControl := fGroupHeadingColourBox; + fSnippetHeadingColourBox := CreateCustomColourBox( + fSnippetHeadingColourDlg, SnippetHeadingColourBoxChange + ); + fSnippetHeadingColourBox.OnChange := SnippetHeadingColourBoxChange; + lblCollectionColours.FocusControl := cbCollection; + fSourceBGColourBox := CreateCustomColourBox( + fSourceBGColourDlg, ColourBoxChangeHandler + ); lblSourceBGColour.FocusControl := fSourceBGColourBox; PopulateFontSizeCombos; + + fSnippetHeadingColours := TDictionary.Create( + TCollectionID.TComparer.Create + ); + + fCollList := TCollectionListAdapter.Create; + fCollList.ToStrings(cbCollection.Items); + Assert(cbCollection.Items.Count > 0, ClassName + '.Create: no collections'); + + SetTabOrder; end; function TDisplayPrefsFrame.CreateCustomColourBox( - const ColourDlg: TColorDialogEx): TColorBoxEx; + const ColourDlg: TColorDialogEx; ChangeHandler: TNotifyEvent): TColorBoxEx; begin // Create and initialise custom color combo box Result := TColorBoxEx.Create(Self); // automatically freed @@ -282,28 +383,31 @@ function TDisplayPrefsFrame.CreateCustomColourBox( Result.ItemHeight := 16; if Assigned(ColourDlg) then Result.ColorDialog := ColourDlg; - Result.OnChange := ColourBoxChangeHandler; + Result.OnChange := ChangeHandler; end; procedure TDisplayPrefsFrame.Deactivate(const Prefs: IPreferences); {Called when page is deactivated. Stores information entered by user. @param Prefs [in] Object used to store information. } +var + Collection: TCollection; begin Prefs.ShowNewSnippetsInNewTabs := chkSnippetsInNewTab.Checked; Prefs.ShowEmptySections := not chkHideEmptySections.Checked; Prefs.OverviewStartState := TOverviewStartState( cbOverviewTree.Items.Objects[cbOverviewTree.ItemIndex] ); - Prefs.SetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID, fMainColourBox.Selected); - Prefs.SetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID, fUserColourBox.Selected); + Prefs.GroupHeadingColour := fGroupHeadingColourBox.Selected; Prefs.SourceCodeBGcolour := fSourceBGColourBox.Selected; - Prefs.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID).CopyFrom( - fMainColourDlg.CustomColors, True - ); - Prefs.GetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID).CopyFrom( - fUserColourDlg.CustomColors, True + Prefs.GroupHeadingCustomColours.CopyFrom( + fGroupHeadingColourDlg.CustomColors, True ); + + for Collection in TCollections.Instance do + Prefs.SetSnippetHeadingColour( + Collection.UID, fSnippetHeadingColours[Collection.UID] + ); Prefs.SourceCodeBGCustomColours.CopyFrom( fSourceBGColourDlg.CustomColors, True ); @@ -313,6 +417,13 @@ procedure TDisplayPrefsFrame.Deactivate(const Prefs: IPreferences); Prefs.DetailFontSize := StrToIntDef(cbDetailFontSize.Text, -1); end; +destructor TDisplayPrefsFrame.Destroy; +begin + fCollList.Free; + fSnippetHeadingColours.Free; + inherited; +end; + function TDisplayPrefsFrame.DisplayName: string; {Caption that is displayed in the tab sheet that contains this frame when displayed in the preference dialog box. @@ -401,6 +512,13 @@ procedure TDisplayPrefsFrame.PopulateFontSizeCombos; TFontHelper.ListCommonFontSizes(cbDetailFontSize.Items); end; +function TDisplayPrefsFrame.SelectedCollectionID: TCollectionID; +begin + Assert(cbCollection.ItemIndex >= 0, + ClassName + '.SelectedCollectionID: no collection selected'); + Result := fCollList.Collection(cbCollection.ItemIndex).UID; +end; + procedure TDisplayPrefsFrame.SelectOverviewTreeState( const State: TOverviewStartState); {Selects combo box item associated with a overview treeview startup state. @@ -419,6 +537,27 @@ procedure TDisplayPrefsFrame.SelectOverviewTreeState( end; end; +procedure TDisplayPrefsFrame.SetTabOrder; +begin + cbOverviewTree.TabOrder := 0; + chkSnippetsInNewTab.TabOrder := 1; + chkHideEmptySections.TabOrder := 2; + fGroupHeadingColourBox.TabOrder := 3; + cbCollection.TabOrder := 4; + fSnippetHeadingColourBox.TabOrder := 5; + fSourceBGColourBox.TabOrder := 6; + btnDefColours.TabOrder := 7; + cbOverviewFontSize.TabOrder := 8; + cbDetailFontSize.TabOrder := 9; +end; + +procedure TDisplayPrefsFrame.SnippetHeadingColourBoxChange(Sender: TObject); +begin + ColourBoxChangeHandler(Sender); + fSnippetHeadingColours[SelectedCollectionID] := + fSnippetHeadingColourBox.Selected +end; + function TDisplayPrefsFrame.UIUpdated: Boolean; begin Result := fUIChanged; diff --git a/Src/UColours.pas b/Src/UColours.pas index 219745f46..e0e9bef20 100644 --- a/Src/UColours.pas +++ b/Src/UColours.pas @@ -53,11 +53,13 @@ interface clSplashShadowText = clWhite; // splash screen text shadow // new tab - clNewTabText = cl3DLight; // color of text displayed in new tabs + clNewTabText = cl3DLight; // text displayed in new tabs - // colours of snippet titles / heading - clMainSnippet = clWindowText; // main database snippets - clUserSnippet = clBlue; // user database snippets + // group headings + clDefGroupHeading = clWindowText; // default for overview group headings + + // snippet headings + clDefSnippetHeading = clWindowText; // default for snippet headings // markup tags clVarText = clPurple; // tag text diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 84f6a9d9f..78727dab8 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -578,7 +578,7 @@ destructor TSnippetListPageHTML.Destroy; function TSnippetListPageHTML.GetH1ClassName: string; begin - Result := 'maindb'; + Result := 'group-heading'; end; function TSnippetListPageHTML.GetHeading: string; diff --git a/Src/UPreferences.pas b/Src/UPreferences.pas index 1137db604..da22563ff 100644 --- a/Src/UPreferences.pas +++ b/Src/UPreferences.pas @@ -137,35 +137,61 @@ interface property ShowNewSnippetsInNewTabs: Boolean read GetShowNewSnippetsInNewTabs write SetShowNewSnippetsInNewTabs; - /// Gets heading colour used for snippets from a specified - /// collection. - /// TCollectionID [in] ID of required + /// Gets colour used for group heading / tree nodes. + /// TColor [in] Required colour. + function GetGroupHeadingColour: TColor; + /// Sets colour to be used for group heading / tree nodes. + /// + /// TColor [in] Colour to be used. + procedure SetGroupHeadingColour(const AColour: TColor); + /// Colour to be used for group headings / tree nodes. + property GroupHeadingColour: TColor + read GetGroupHeadingColour write SetGroupHeadingColour; + + /// Gets custom colours available for use for group headings / + /// tree nodes. + /// IStringList. List of hex representations of custom + /// colours. + function GetGroupHeadingCustomColours: IStringList; + /// Sets custom colours available for use for group headings / + /// tree nodes. + /// IStringList. List of hex representations + /// of custom colours. + procedure SetGroupHeadingCustomColours(const AColours: IStringList); + /// Custom colours available for use for group headings / + /// tree nodes. + property GroupHeadingCustomColours: IStringList + read GetGroupHeadingCustomColours write SetGroupHeadingCustomColours; + + /// Gets the heading / tree node colour used for snippets from a + /// specified collection. + /// TCollectionID [in] ID of required /// collection. /// TColor. Required colour. - function GetDBHeadingColour(const ACollectionID: TCollectionID): TColor; - /// Sets heading colour used for snippets from a specified - /// collection. - /// TCollectionID [in] ID of required + function GetSnippetHeadingColour(const ACollectionID: TCollectionID): + TColor; + /// Sets heading / tree node colour used for snippets from a + /// specified collection. + /// TCollectionID [in] ID of required /// collection. - /// TColor. Required colour. - procedure SetDBHeadingColour(const ACollectionID: TCollectionID; + /// TColor. Required colour. + procedure SetSnippetHeadingColour(const ACollectionID: TCollectionID; const Value: TColor); - /// Gets custom colours available for headings for specified - /// collection. - /// TCollectionID [in] ID of required - /// collection. - /// IStringList. String list containing custom colours. - function GetDBHeadingCustomColours(const ACollectionID: TCollectionID): - IStringList; - /// Sets custom colours available for headings for specified - /// collection. - /// TCollectionID [in] ID of required - /// collection. - /// IStringList [in] String list containing custom - /// colours. - procedure SetDBHeadingCustomColours(const ACollectionID: TCollectionID; - Value: IStringList); + /// Gets custom colours available for snippet headings / tree + /// nodes. + /// IStringList. String list containing custom colours. + /// + function GetSnippetHeadingCustomColours: IStringList; + /// Sets custom colours available for snippet headings / tree + /// nodes. + /// IStringList [in] String list containing + /// custom colours. + procedure SetSnippetHeadingCustomColours(const AColours: IStringList); + /// Custom colours available for snippet headings / tree nodes. + /// + property SnippetHeadingCustomColours: IStringList + read GetSnippetHeadingCustomColours write SetSnippetHeadingCustomColours; /// Gets size of font used in overview pane tree view. function GetOverviewFontSize: Integer; @@ -287,6 +313,8 @@ implementation uses // Delphi SysUtils, + Generics.Collections, + Generics.Defaults, // Project Hiliter.UAttrs, Hiliter.UPersist, IntfCommon, UExceptions, UColours, UFontHelper, USettings; @@ -328,21 +356,20 @@ TPreferences = class(TInterfacedObject, /// Indicates whether empty sections are displayed in overview /// pane. fShowEmptySections: Boolean; - /// Indicates whether new snippets and ca-tegories are displayed + /// Indicates whether new snippets and categories are displayed /// in new tabs in details pane. fShowNewSnippetsInNewTabs: Boolean; - /// Records colour to be used for headings of items from either - /// main (False) or user (True) collections. - fDBHeadingColours: array[Boolean] of TColor; - {TODO -cCollections: WARNING. The fDBHeadingColours field only supports - the two original main & user collections. This MUST be changed - once more than two snippet collections are supported} - /// Records custom colours available for headings of items from - /// either main (False) or user (True) collections. - fDBHeadingCustomColours: array[Boolean] of IStringList; - {TODO -cCollections: WARNING. The fDBHeadingCustomColours field only - supports the two original main & user collections. This MUST be - changed once more than two snippet collections are supported} + /// Records colour to be used for group headings. + fGroupHeadingColour: TColor; + /// Records custom colours available for group headings. + /// + fGroupHeadingCustomColours: IStringList; + /// Records colour to be used for snippet headings and tree + /// nodes for each collection. + fSnippetHeadingColours: TDictionary; + /// Records custom colours available for snippet heading and + /// tree nodes. + fSnippetHeadingCustomColours: IStringList; /// Records size of font used in overview pane tree view. /// fOverviewFontSize: Integer; @@ -377,9 +404,6 @@ TPreferences = class(TInterfacedObject, function DefaultOverviewFontSize: Integer; /// Returns default font size for details pane. function DefaultDetailFontSize: Integer; - - function __TMP__UseUserDBHeadingColour(const ACollectionID: TCollectionID): - Boolean; public /// Constructs a new object instance. constructor Create; @@ -481,41 +505,68 @@ TPreferences = class(TInterfacedObject, /// Method of IPreferences. procedure SetShowNewSnippetsInNewTabs(const Value: Boolean); - /// Gets heading colour used for snippets from a specified - /// collection. - /// TCollectionID [in] ID of required - /// collection. - /// TColor. Required colour. + /// Gets colour used for group heading / tree nodes. + /// TColor [in] Required colour. + /// Method of IPreferences. + function GetGroupHeadingColour: TColor; + + /// Sets colour to be used for group heading / tree nodes. + /// + /// TColor [in] Colour to be used. + /// Method of IPreferences. + procedure SetGroupHeadingColour(const AColour: TColor); + + /// Gets custom colours available for use for group headings / + /// tree nodes. + /// IStringList. List of hex representations of custom + /// colours. /// Method of IPreferences. - function GetDBHeadingColour(const ACollectionID: TCollectionID): TColor; + function GetGroupHeadingCustomColours: IStringList; - /// Sets heading colour used for snippets from a specified - /// collection. - /// TCollectionID [in] ID of required - /// collection. - /// TColor. Required colour. + /// Sets custom colours available for use for group headings / + /// tree nodes. + /// IStringList. List of hex representations + /// of custom colours. /// Method of IPreferences. - procedure SetDBHeadingColour(const ACollectionID: TCollectionID; - const Value: TColor); + procedure SetGroupHeadingCustomColours(const AColours: IStringList); - /// Gets custom colours available for headings for specified - /// collection. - /// TCollectionID [in] ID of required + /// Gets the heading / tree node colour used for snippets from a + /// specified collection. + /// TCollectionID [in] ID of required /// collection. - /// IStringList. String list containing custom colours. - /// Method of IPreferences. - function GetDBHeadingCustomColours(const ACollectionID: TCollectionID): - IStringList; + /// TColor. Required colour. + /// Method of IPreferences. + function GetSnippetHeadingColour(const ACollectionID: TCollectionID): + TColor; - /// Sets custom colours available for headings for specified - /// collection. - /// TCollectionID [in] ID of required + /// Sets heading / tree node colour used for snippets from a + /// specified collection. + /// TCollectionID [in] ID of required /// collection. - /// IStringList [in] String list containing custom - /// colours. - /// Method of IPreferences. - procedure SetDBHeadingCustomColours(const ACollectionID: TCollectionID; - Value: IStringList); + /// TColor. Required colour. + /// Method of IPreferences. + procedure SetSnippetHeadingColour(const ACollectionID: TCollectionID; + const Value: TColor); + + /// Gets custom colours available for snippet headings / tree + /// nodes. + /// IStringList. String list containing custom colours. + /// + /// + /// All collections share this one custom colour list. + /// Method of IPreferences. + /// + function GetSnippetHeadingCustomColours: IStringList; + + /// Sets custom colours available for snippet headings / tree + /// nodes. + /// IStringList [in] String list containing + /// custom colours. + /// + /// All collections share this one custom colour list. + /// Method of IPreferences. + /// + procedure SetSnippetHeadingCustomColours(const AColours: IStringList); /// Gets size of font used in overview pane tree view. /// Method of IPreferences. @@ -681,6 +732,7 @@ function Preferences: IPreferences; procedure TPreferences.Assign(const Src: IInterface); var SrcPref: IPreferences; // IPreferences interface of Src + Collection: TCollection; begin // Get IPreferences interface of given object if not Supports(Src, IPreferences, SrcPref) then @@ -695,10 +747,13 @@ procedure TPreferences.Assign(const Src: IInterface); Self.fOverviewStartState := SrcPref.OverviewStartState; Self.fShowEmptySections := SrcPref.ShowEmptySections; Self.fShowNewSnippetsInNewTabs := SrcPref.ShowNewSnippetsInNewTabs; - Self.SetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID, SrcPref.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); - Self.SetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID, SrcPref.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID)); - Self.SetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID, SrcPref.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); - Self.SetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID, SrcPref.GetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID)); + Self.fGroupHeadingColour := SrcPref.GetGroupHeadingColour; + Self.fGroupHeadingCustomColours := SrcPref.GetGroupHeadingCustomColours; + for Collection in TCollections.Instance do + Self.SetSnippetHeadingColour( + Collection.UID, SrcPref.GetSnippetHeadingColour(Collection.UID) + ); + Self.fSnippetHeadingCustomColours := SrcPref.GetSnippetHeadingCustomColours; Self.fOverviewFontSize := SrcPref.OverviewFontSize; Self.fDetailFontSize := SrcPref.DetailFontSize; Self.fSourceCodeBGColour := SrcPref.SourceCodeBGColour; @@ -719,8 +774,9 @@ constructor TPreferences.Create; fNamedHiliteAttrs := THiliteAttrsFactory.CreateNamedAttrs; fHiliteCustomColours := TIStringList.Create; fWarnings := TWarnings.Create; - fDBHeadingCustomColours[False] := TIStringList.Create; - fDBHeadingCustomColours[True] := TIStringList.Create; + fSnippetHeadingColours := TDictionary.Create( + TCollectionID.TComparer.Create + ); fPageStructures := TSnippetPageStructures.Create; TDefaultPageStructures.SetDefaults(fPageStructures); end; @@ -738,6 +794,7 @@ function TPreferences.DefaultOverviewFontSize: Integer; destructor TPreferences.Destroy; begin fPageStructures.Free; + fSnippetHeadingColours.Free; inherited; end; @@ -746,31 +803,19 @@ function TPreferences.GetCustomHiliteColours: IStringList; Result := fHiliteCustomColours; end; -function TPreferences.GetDBHeadingColour( - const ACollectionID: TCollectionID): TColor; +function TPreferences.GetDetailFontSize: Integer; begin - {TODO -cCollections: WARNING: This implementation of GetDBHeadingColour only - supports the old main and user collections. It will break when further - collections are added. - } - Result := fDBHeadingColours[__TMP__UseUserDBHeadingColour(ACollectionID)]; + Result := fDetailFontSize; end; -function TPreferences.GetDBHeadingCustomColours( - const ACollectionID: TCollectionID): IStringList; +function TPreferences.GetGroupHeadingColour: TColor; begin - {TODO -cCollections: WARNING: This implementation of GetDBHeadingCustomColours - only supports the old main and user collections. It will break when - further collections are added. - } - Result := fDBHeadingCustomColours[ - __TMP__UseUserDBHeadingColour(ACollectionID) - ]; + Result := fGroupHeadingColour; end; -function TPreferences.GetDetailFontSize: Integer; +function TPreferences.GetGroupHeadingCustomColours: IStringList; begin - Result := fDetailFontSize; + Result := fGroupHeadingCustomColours; end; function TPreferences.GetHiliteAttrs: IHiliteAttrs; @@ -828,6 +873,20 @@ function TPreferences.GetShowNewSnippetsInNewTabs: Boolean; Result := fShowNewSnippetsInNewTabs; end; +function TPreferences.GetSnippetHeadingColour( + const ACollectionID: TCollectionID): TColor; +begin + if fSnippetHeadingColours.ContainsKey(ACollectionID) then + Result := fSnippetHeadingColours[ACollectionID] + else + Result := clDefSnippetHeading; +end; + +function TPreferences.GetSnippetHeadingCustomColours: IStringList; +begin + Result := fSnippetHeadingCustomColours; +end; + function TPreferences.GetSourceCodeBGColour: TColor; begin Result := fSourceCodeBGColour; @@ -868,34 +927,23 @@ procedure TPreferences.SetCustomHiliteColours(const Colours: IStringList); fHiliteCustomColours := Colours; end; -procedure TPreferences.SetDBHeadingColour(const ACollectionID: TCollectionID; - const Value: TColor); +procedure TPreferences.SetDetailFontSize(const Value: Integer); begin - {TODO -cCollections: WARNING: This implementation of SetDBHeadingColour only - supports the old main and user collections. It will break when further - collections are added. - } - fDBHeadingColours[__TMP__UseUserDBHeadingColour(ACollectionID)] := Value; + if TFontHelper.IsInCommonFontSizeRange(Value) then + fDetailFontSize := Value + else + fDetailFontSize := DefaultDetailFontSize; end; -procedure TPreferences.SetDBHeadingCustomColours( - const ACollectionID: TCollectionID; Value: IStringList); +procedure TPreferences.SetGroupHeadingColour(const AColour: TColor); begin - {TODO -cCollections: WARNING: This implementation of SetDBHeadingCustomColours - only supports the old main and user collections. It will break when - further collections are added. - } - fDBHeadingCustomColours[ - __TMP__UseUserDBHeadingColour(ACollectionID) - ] := Value; + fGroupHeadingColour := AColour; end; -procedure TPreferences.SetDetailFontSize(const Value: Integer); +procedure TPreferences.SetGroupHeadingCustomColours( + const AColours: IStringList); begin - if TFontHelper.IsInCommonFontSizeRange(Value) then - fDetailFontSize := Value - else - fDetailFontSize := DefaultDetailFontSize; + fGroupHeadingCustomColours := AColours; end; procedure TPreferences.SetHiliteAttrs(const Attrs: IHiliteAttrs); @@ -957,6 +1005,18 @@ procedure TPreferences.SetShowNewSnippetsInNewTabs(const Value: Boolean); fShowNewSnippetsInNewTabs := Value; end; +procedure TPreferences.SetSnippetHeadingColour( + const ACollectionID: TCollectionID; const Value: TColor); +begin + fSnippetHeadingColours.AddOrSetValue(ACollectionID, Value); +end; + +procedure TPreferences.SetSnippetHeadingCustomColours( + const AColours: IStringList); +begin + fSnippetHeadingCustomColours := AColours; +end; + procedure TPreferences.SetSourceCodeBGColour(const Value: TColor); begin fSourceCodeBGColour := Value; @@ -992,18 +1052,12 @@ procedure TPreferences.SetWarnings(Warnings: IWarnings); (fWarnings as IAssignable).Assign(Warnings); end; -function TPreferences.__TMP__UseUserDBHeadingColour( - const ACollectionID: TCollectionID): Boolean; -begin - Result := (ACollectionID <> TCollectionID.__TMP__MainDBCollectionID) - and not ACollectionID.IsNull; -end; - { TPreferencesPersist } function TPreferencesPersist.Clone: IInterface; var NewPref: IPreferences; // reference to new object's IPreferences interface + Collection: TCollection; begin // Create new object Result := TPreferences.Create; @@ -1018,10 +1072,13 @@ function TPreferencesPersist.Clone: IInterface; NewPref.OverviewStartState := Self.fOverviewStartState; NewPref.ShowEmptySections := Self.fShowEmptySections; NewPref.ShowNewSnippetsInNewTabs := Self.fShowNewSnippetsInNewTabs; - NewPref.SetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID, Self.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); - NewPref.SetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID, Self.GetDBHeadingCustomColours(TCollectionID.__TMP__MainDBCollectionID)); - NewPref.SetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID, Self.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); - NewPref.SetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID, Self.GetDBHeadingCustomColours(TCollectionID.__TMP__UserDBCollectionID)); + NewPref.GroupHeadingColour := Self.fGroupHeadingColour; + NewPref.GroupHeadingCustomColours := Self.fGroupHeadingCustomColours; + for Collection in TCollections.Instance do + NewPref.SetSnippetHeadingColour( + Collection.UID, Self.GetSnippetHeadingColour(Collection.UID) + ); + NewPref.SnippetHeadingCustomColours := Self.fSnippetHeadingCustomColours; NewPref.OverviewFontSize := Self.fOverviewFontSize; NewPref.DetailFontSize := Self.fDetailFontSize; NewPref.SourceCodeBGColour := Self.fSourceCodeBGColour; @@ -1038,6 +1095,7 @@ function TPreferencesPersist.Clone: IInterface; constructor TPreferencesPersist.Create; var Storage: ISettingsSection; // object used to access persistent storage + Collection: TCollection; const // Default margin size in millimeters cPrintPageMarginSizeMM = 25.0; @@ -1063,22 +1121,32 @@ constructor TPreferencesPersist.Create; fShowNewSnippetsInNewTabs := Storage.GetBoolean( 'ShowNewSnippetsInNewTabs', False ); - SetDBHeadingColour( - TCollectionID.__TMP__MainDBCollectionID, - TColor(Storage.GetInteger('MainDBHeadingColour', clMainSnippet)) - ); - SetDBHeadingColour( - TCollectionID.__TMP__UserDBCollectionID, - TColor(Storage.GetInteger('UserDBHeadingColour', clUserSnippet)) - ); fSourceCodeBGColour := TColor( Storage.GetInteger('SourceCodeBGColour', clSourceBg) ); - fDBHeadingCustomColours[False] := Storage.GetStrings( - 'MainDBHeadingCustomColourCount', 'MainDBHeadingCustomColour%d' + fGroupHeadingColour := TColor( + Storage.GetInteger('GroupHeadingColour', clDefGroupHeading) ); - fDBHeadingCustomColours[True] := Storage.GetStrings( - 'UserDBHeadingCustomColourCount', 'UserDBHeadingCustomColour%d' + fGroupHeadingCustomColours := Storage.GetStrings( + 'GroupHeadingCustomColourCount', 'GroupHeadingCustomColour%d' + ); + + fSnippetHeadingColours.Clear; + for Collection in TCollections.Instance do + begin + fSnippetHeadingColours.AddOrSetValue( + Collection.UID, + TColor( + Storage.GetInteger( + 'SnippetHeadingColour:' + Collection.UID.ToHexString, + clDefSnippetHeading + ) + ) + ); + end; + + fSnippetHeadingCustomColours := Storage.GetStrings( + 'SnippetHeadingCustomColourCount', 'SnippetHeadingCustomColour%d' ); fOverviewFontSize := Storage.GetInteger( 'OverviewFontSize', DefaultOverviewFontSize @@ -1138,6 +1206,7 @@ constructor TPreferencesPersist.Create; destructor TPreferencesPersist.Destroy; var Storage: ISettingsSection; // object used to access persistent storage + Collection: TCollection; begin // Wreite meta section (no sub-section name) Storage := Settings.EmptySection(ssPreferences); @@ -1154,27 +1223,33 @@ destructor TPreferencesPersist.Destroy; Storage.SetInteger('OverviewStartState', Ord(fOverviewStartState)); Storage.SetBoolean('ShowEmptySections', fShowEmptySections); Storage.SetBoolean('ShowNewSnippetsInNewTabs', fShowNewSnippetsInNewTabs); - Storage.SetInteger( - 'MainDBHeadingColour', - GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID) + Storage.SetInteger('GroupHeadingColour', fGroupHeadingColour); + Storage.SetStrings( + 'GroupHeadingCustomColourCount', + 'GroupHeadingCustomColour%d', + fGroupHeadingCustomColours ); - Storage.SetInteger( - 'UserDBHeadingColour', - GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID) + for Collection in TCollections.Instance do + begin + if fSnippetHeadingColours.ContainsKey(Collection.UID) then + Storage.SetInteger( + 'SnippetHeadingColour:' + Collection.UID.ToHexString, + fSnippetHeadingColours[Collection.UID] + ) + else + Storage.SetInteger( + 'SnippetHeadingColour:' + Collection.UID.ToHexString, + clDefSnippetHeading + ) + end; + Storage.SetStrings( + 'SnippetHeadingCustomColourCount', + 'SnippetHeadingCustomColour%d', + fSnippetHeadingCustomColours ); Storage.SetInteger('OverviewFontSize', fOverviewFontSize); Storage.SetInteger('DetailFontSize', fDetailFontSize); Storage.SetInteger('SourceCodeBGColour', fSourceCodeBGColour); - Storage.SetStrings( - 'MainDBHeadingCustomColourCount', - 'MainDBHeadingCustomColour%d', - fDBHeadingCustomColours[False] - ); - Storage.SetStrings( - 'UserDBHeadingCustomColourCount', - 'UserDBHeadingCustomColour%d', - fDBHeadingCustomColours[True] - ); Storage.SetStrings( 'SourceCodeBGCustomColourCount', 'SourceCodeBGCustomColour%d', diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index 8d2bc6bbd..73f6e6858 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -106,8 +106,8 @@ constructor TRTFCategoryDoc.Create(const UseColour: Boolean); // Set up colour table {TODO -cCollection: Replace following 2 statements with loop that iterates over all collections.} - fBuilder.ColourTable.Add(Preferences.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); - fBuilder.ColourTable.Add(Preferences.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); + fBuilder.ColourTable.Add(Preferences.GetSnippetHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); + fBuilder.ColourTable.Add(Preferences.GetSnippetHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); fBuilder.ColourTable.Add(clExternalLink); fDescStyles := TActiveTextRTFStyleMap.Create; InitStyles; @@ -228,7 +228,7 @@ procedure TRTFCategoryDoc.OutputSnippetSubHeading(const Snippet: TSnippet); fBuilder.SetFont(MainFontName); fBuilder.SetFontSize(SubHeadingFontSize); fBuilder.SetFontStyle([fsBold]); - SetColour(Preferences.GetDBHeadingColour(Snippet.CollectionID)); + SetColour(Preferences.GetSnippetHeadingColour(Snippet.CollectionID)); fBuilder.AddText(Snippet.DisplayName); fBuilder.EndPara; fBuilder.EndGroup; diff --git a/Src/URTFSnippetDoc.pas b/Src/URTFSnippetDoc.pas index 6781dd3a6..5893e8dd3 100644 --- a/Src/URTFSnippetDoc.pas +++ b/Src/URTFSnippetDoc.pas @@ -176,8 +176,8 @@ procedure TRTFSnippetDoc.InitialiseDoc; { TODO -cCollections: Replace following two statements with iteration over all supported collections when support for multiple collections is added. } - fBuilder.ColourTable.Add(Preferences.GetDBHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); - fBuilder.ColourTable.Add(Preferences.GetDBHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); + fBuilder.ColourTable.Add(Preferences.GetSnippetHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); + fBuilder.ColourTable.Add(Preferences.GetSnippetHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); end; procedure TRTFSnippetDoc.InitStyles; @@ -426,7 +426,7 @@ procedure TRTFSnippetDoc.RenderHeading(const Heading: string; fBuilder.SetFontStyle([fsBold]); fBuilder.SetFontSize(HeadingFontSize); if fUseColour then - fBuilder.SetColour(Preferences.GetDBHeadingColour(ACollectionID)); + fBuilder.SetColour(Preferences.GetSnippetHeadingColour(ACollectionID)); fBuilder.SetParaSpacing(TRTFParaSpacing.Create(0.0, ParaSpacing)); fBuilder.AddText(Heading); fBuilder.EndPara; diff --git a/Src/USnippetsChkListMgr.pas b/Src/USnippetsChkListMgr.pas index b8b8b708a..bbc9a8ba5 100644 --- a/Src/USnippetsChkListMgr.pas +++ b/Src/USnippetsChkListMgr.pas @@ -203,7 +203,7 @@ procedure TSnippetsChkListMgr.DrawItem(Control: TWinControl; Index: Integer; Assert(fCLB = Control, ClassName + '.DrawItem: Control <> fCLB'); Canvas := fCLB.Canvas; if not (odSelected in State) then - Canvas.Font.Color := Preferences.GetDBHeadingColour( + Canvas.Font.Color := Preferences.GetSnippetHeadingColour( (fCLB.Items.Objects[Index] as TSnippet).CollectionID ); Canvas.TextRect( diff --git a/Src/USnippetsTVDraw.pas b/Src/USnippetsTVDraw.pas index 073444c3d..cd3191ad7 100644 --- a/Src/USnippetsTVDraw.pas +++ b/Src/USnippetsTVDraw.pas @@ -122,9 +122,11 @@ procedure TSnippetsTVDraw.CustomDrawItem(Sender: TCustomTreeView; if IsErrorNode(Node) then // colour unselected error nodes differently TV.Canvas.Font.Color := clWarningText + else if IsSectionHeadNode(Node) then + TV.Canvas.Font.Color := Preferences.GroupHeadingColour else TV.Canvas.Font.Color := - Preferences.GetDBHeadingColour(GetCollectionID(Node)); + Preferences.GetSnippetHeadingColour(GetCollectionID(Node)); TV.Canvas.Brush.Color := TV.Color; end; if IsSectionHeadNode(Node) then From 16a70cf6766fb2a87532b84b3aef73059a94ffbd Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 15 Nov 2024 12:55:00 +0000 Subject: [PATCH 090/222] Enable collection selection in Snippets Editor Added new collections combo box to allow the collections to be chosen for new snippets. Collection of existing snippet being edited is displayed but can't be changed. Snippet references page now only lists snippets in the same collection: cross-collection references are no longer to be supported. --- Src/FmSnippetsEditorDlg.dfm | 42 ++++++++++++---- Src/FmSnippetsEditorDlg.pas | 96 +++++++++++++++++++++++++++++++------ 2 files changed, 116 insertions(+), 22 deletions(-) diff --git a/Src/FmSnippetsEditorDlg.dfm b/Src/FmSnippetsEditorDlg.dfm index bbb544308..92c6a994b 100644 --- a/Src/FmSnippetsEditorDlg.dfm +++ b/Src/FmSnippetsEditorDlg.dfm @@ -19,7 +19,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Top = 0 Width = 662 Height = 504 - ActivePage = tsCompileResults + ActivePage = tsCode Align = alClient TabOrder = 0 OnChange = pcMainChange @@ -90,6 +90,22 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Caption = 'Displa&y Name:' FocusControl = edDisplayName end + object lblCollection: TLabel + Left = 3 + Top = 10 + Width = 50 + Height = 13 + Caption = 'C&ollection:' + FocusControl = cbCollection + end + object lblCollectionInfo: TLabel + Left = 411 + Top = 10 + Width = 76 + Height = 13 + Caption = 'lblCollectionInfo' + FocusControl = cbCollection + end object edSourceCode: TMemo Left = 4 Top = 224 @@ -103,7 +119,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg ParentFont = False PopupMenu = mnuEditCtrls ScrollBars = ssBoth - TabOrder = 5 + TabOrder = 6 end object cbCategories: TComboBox Left = 93 @@ -111,7 +127,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Width = 209 Height = 21 Style = csDropDownList - TabOrder = 4 + TabOrder = 5 end object cbKind: TComboBox Left = 93 @@ -119,7 +135,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Width = 209 Height = 21 Style = csDropDownList - TabOrder = 3 + TabOrder = 4 OnChange = cbKindChange end inline frmDescription: TSnippetsActiveTextEdFrame @@ -130,7 +146,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Color = clWindow ParentBackground = False ParentColor = False - TabOrder = 1 + TabOrder = 2 ExplicitLeft = 93 ExplicitTop = 67 ExplicitWidth = 462 @@ -138,12 +154,14 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg inherited edText: TMemo Width = 462 Height = 55 + TabOrder = 1 ExplicitWidth = 462 ExplicitHeight = 55 end inherited tcEditMode: TTabControl Top = 55 Width = 462 + TabOrder = 0 ExplicitTop = 55 ExplicitWidth = 462 end @@ -155,7 +173,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Height = 25 Action = actViewDescription Caption = 'Previe&w...' - TabOrder = 2 + TabOrder = 3 end object edDisplayName: TEdit Left = 93 @@ -163,7 +181,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Width = 298 Height = 21 PopupMenu = mnuEditCtrls - TabOrder = 0 + TabOrder = 1 end object chkUseHiliter: TCheckBox Left = 3 @@ -171,7 +189,15 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Width = 478 Height = 17 Caption = 'Synta&x highlight this snippet as Pascal code' - TabOrder = 6 + TabOrder = 7 + end + object cbCollection: TComboBox + Left = 93 + Top = 7 + Width = 298 + Height = 21 + Style = csDropDownList + TabOrder = 0 end end object tsReferences: TTabSheet diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 9bd91f635..ab8c331c2 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -24,6 +24,7 @@ interface ActiveText.UMain, Compilers.UGlobals, DB.UCollections, DB.USnippet, FmGenericOKDlg, FrBrowserBase, FrFixedHTMLDlg, FrHTMLDlg, UBaseObjects, UCategoryListAdapter, + UCollectionListAdapter, UCompileMgr, UCompileResultsLBMgr, UCSSBuilder, UMemoCaretPosDisplayMgr, UMemoHelper, USnipKindListAdapter, USnippetsChkListMgr, UUnitsChkListMgr, FmSnippetsEditorDlg.FrActiveTextEditor; @@ -117,6 +118,9 @@ TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) actClearUnits: TAction; miClearUnits: TMenuItem; miSpacer3: TMenuItem; + lblCollection: TLabel; + cbCollection: TComboBox; + lblCollectionInfo: TLabel; procedure actAddUnitExecute(Sender: TObject); procedure actAddUnitUpdate(Sender: TObject); procedure actCompileExecute(Sender: TObject); @@ -157,6 +161,8 @@ TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) strict private fSnippet: TSnippet; // Snippet being edited: nil for new snippet fCatList: TCategoryListAdapter; // Accesses sorted list of categories + fCollList: + TCollectionListAdapter; // Accesses sorted list of collections fSnipKindList: TSnipKindListAdapter; // Accesses sorted list of snippet kinds fEditData: TSnippetEditData; // Record storing a snippet's editable data @@ -441,7 +447,7 @@ procedure TSnippetsEditorDlg.actViewDependenciesExecute(Sender: TObject); fDependsCLBMgr.GetCheckedSnippets(DependsList); TDependenciesDlg.Execute( Self, - TSnippetID.Create(UniqueSnippetKey, TCollectionID.__TMP__UserDBCollectionID), + TSnippetID.Create(UniqueSnippetKey, SelectedCollectionID), StrTrim(edDisplayName.Text), DependsList, [tiDependsUpon], @@ -569,39 +575,65 @@ procedure TSnippetsEditorDlg.ArrangeForm; begin // tsCode edSourceCode.Width := tsCode.ClientWidth - 8; + // Column 1 TCtrlArranger.AlignLefts( [ - lblDisplayName, lblDescription, lblKind, lblCategories, + lblCollection, lblDisplayName, lblDescription, lblKind, lblCategories, lblSourceCode, edSourceCode ], 3 ); + // Column 2 + TCtrlArranger.AlignLefts( + [ + cbCollection, lblCollectionInfo, edDisplayName, frmDescription, cbKind, + cbCategories + ], + TCtrlArranger.RightOf( + [lblCollection, lblDisplayName, lblDescription, lblKind, lblCategories], + 12 + ) + ); + // Right hand sides TCtrlArranger.AlignRights( [edSourceCode, lblSourceCaretPos, btnViewDescription] ); frmDescription.Width := btnViewDescription.Left - frmDescription.Left - 8; - TCtrlArranger.AlignVCentres(3, [lblDisplayName, edDisplayName] + // Row 1 + TCtrlArranger.AlignVCentres( + 3, [lblCollection, cbCollection, lblCollectionInfo] ); + // Row 2 + TCtrlArranger.AlignVCentres( + TCtrlArranger.BottomOf([lblCollection, cbCollection], 8), + [lblDisplayName, edDisplayName] + ); + // Row 3 TCtrlArranger.AlignTops( [lblDescription, frmDescription, btnViewDescription], TCtrlArranger.BottomOf([lblDisplayName, edDisplayName], 8) ); + // Row 4 TCtrlArranger.AlignVCentres( TCtrlArranger.BottomOf( [lblDescription, frmDescription, btnViewDescription], 8 ), [lblKind, cbKind, lblSnippetKindHelp] ); + // Row 5 TCtrlArranger.AlignVCentres( TCtrlArranger.BottomOf([lblKind, cbKind, lblSnippetKindHelp], 8), [lblCategories, cbCategories] ); + // Row 6 TCtrlArranger.MoveToRightOf(cbKind, lblSnippetKindHelp, 12); TCtrlArranger.AlignTops( [lblSourceCode, lblSourceCaretPos], TCtrlArranger.BottomOf([lblCategories, cbCategories], 8) ); + // Row 7 TCtrlArranger.MoveBelow([lblSourceCode, lblSourceCaretPos], edSourceCode, 4); + // Row 8 TCtrlArranger.MoveBelow(edSourceCode, chkUseHiliter, 8); // tsReferences @@ -766,6 +798,7 @@ procedure TSnippetsEditorDlg.FormCreate(Sender: TObject); begin inherited; fCatList := TCategoryListAdapter.Create(Database.Categories); + fCollList := TCollectionListAdapter.Create; fSnipKindList := TSnipKindListAdapter.Create; fCompileMgr := TCompileMgr.Create(Self); // auto-freed fMemoCaretPosDisplayMgr := TMemoCaretPosDisplayMgr.Create; @@ -790,6 +823,7 @@ procedure TSnippetsEditorDlg.FormDestroy(Sender: TObject); FreeAndNil(fXRefsCLBMgr); FreeAndNil(fDependsCLBMgr); FreeAndNil(fSnipKindList); + FreeAndNil(fCollList); FreeAndNil(fCatList); fMemoCaretPosDisplayMgr.Free; end; @@ -833,6 +867,10 @@ procedure TSnippetsEditorDlg.InitControls; frmDescription.ActiveText := fSnippet.Description; edDisplayName.Text := fSnippet.DisplayName; cbCategories.ItemIndex := fCatList.IndexOf(fSnippet.Category); + cbCollection.ItemIndex := fCollList.IndexOfUID(fSnippet.CollectionID); + cbCollection.Visible := False; // can't change existing snippet collection + lblCollectionInfo.Caption := cbCollection.Text; + lblCollectionInfo.Visible := True; frmExtra.DefaultEditMode := emAuto; frmExtra.ActiveText := fSnippet.Extra; cbKind.ItemIndex := fSnipKindList.IndexOf(fSnippet.Kind); @@ -854,6 +892,13 @@ procedure TSnippetsEditorDlg.InitControls; cbCategories.ItemIndex := fCatList.IndexOf(TCategory.DefaultID); if cbCategories.ItemIndex = -1 then cbCategories.ItemIndex := 0; + {TODO -cCollections: Replace following __TMP__ method call with call to new + TCollections.Default method or similar.} + cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.__TMP__UserDBCollectionID); + if cbCollection.ItemIndex = -1 then + cbCollection.ItemIndex := 0; + cbCollection.Visible := True; // can select collection of new snippet + lblCollectionInfo.Visible := False; cbKind.ItemIndex := fSnipKindList.IndexOf(skFreeform); frmExtra.DefaultEditMode := emPlainText; frmExtra.Clear; @@ -931,17 +976,19 @@ procedure TSnippetsEditorDlg.PopulateControls; fSnipKindList.ToStrings(cbKind.Items); // Display all available categories in drop down list fCatList.ToStrings(cbCategories.Items); + // Display all available collections in drop down list + fCollList.ToStrings(cbCollection.Items); end; function TSnippetsEditorDlg.SelectedCollectionID: TCollectionID; begin + // If editing existing snippet ID then the collection cannot be edited if Assigned(fSnippet) then + // Editing existing snippet: can't change collection Result := fSnippet.CollectionID else - {TODO -cCollections: Replace the following __TMP__ method with collection ID - selected by user from a combo box. DO NOT permit this choice when - editing an existing snippet.} - Result := TCollectionID.__TMP__UserDBCollectionID; + // Editing new snippet: chosing collection is permitted + Result := fCollList.Collection(cbCollection.ItemIndex).UID; end; procedure TSnippetsEditorDlg.SetAllCompilerResults( @@ -999,15 +1046,17 @@ procedure TSnippetsEditorDlg.UpdateReferences; EditSnippetID := TSnippetID.Create(UniqueSnippetKey, SelectedCollectionID); EditSnippetKind := fSnipKindList.SnippetKind(cbKind.ItemIndex); + + {TODO -cVault: We do following kind of filtering of Database.Snippets so + often it would be useful to have a Filter or Select method of + TSnippetList that can be passed a predicate to do this and return a + filtered snippet list. + } for Snippet in Database.Snippets do begin - // We ignore snippet being edited and main database snippets if there is - // a user-defined one with same key - if (Snippet.ID <> EditSnippetID) and - ( - (Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) or - not Assigned(Database.Snippets.Find(Snippet.Key, TCollectionID.__TMP__UserDBCollectionID)) - ) then + if Snippet.CollectionID <> SelectedCollectionID then + Continue; + if Snippet.ID <> EditSnippetID then begin // Decide if snippet can be added to depends list: must be correct kind if Snippet.Kind in @@ -1017,6 +1066,25 @@ procedure TSnippetsEditorDlg.UpdateReferences; fXRefsCLBMgr.AddSnippet(Snippet); end; end; + +// for Snippet in Database.Snippets do +// begin +// // We ignore snippet being edited and main database snippets if there is +// // a user-defined one with same key +// if (Snippet.ID <> EditSnippetID) and +// ( +// (Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) or +// not Assigned(Database.Snippets.Find(Snippet.Key, TCollectionID.__TMP__UserDBCollectionID)) +// ) then +// begin +// // Decide if snippet can be added to depends list: must be correct kind +// if Snippet.Kind in +// TSnippetValidator.ValidDependsKinds(EditSnippetKind) then +// fDependsCLBMgr.AddSnippet(Snippet); +// // Anything can be in XRefs list +// fXRefsCLBMgr.AddSnippet(Snippet); +// end; +// end; // Restore checks to any saved checked item that still exist in new list fDependsCLBMgr.Restore; fXRefsCLBMgr.Restore; From 1c51d2143a98639e5e4e87aec9cb6231184704ce Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 15 Nov 2024 17:15:31 +0000 Subject: [PATCH 091/222] Add a permanent "default" collection Added TCollectionID.Default method to return the ID of the default collection: the ID is an empty GUID, i.e. 16 zero bytes. Removed redundant Native_v4_ID that represented the former "user" database. Added TCollection.IsDefault method to if a collection ID is the default. Added TCollections.Default method that returns the default collection. Modified TCollections.Delete to prevent the default collection from being deleted. Modified TCollection.Initialize to create the default collection if it is not read from settings. Removed creation of "user" database collection and moved the auto-creation of the "main" database to after the Default collection is created. Modified TCollectionID.__TMP__UserDBCollectionID to call TCollectionID.Default instead of creating the now-removed "user database" collection. Also deleted the redundant TCollectionID.IsBuiltInID method. --- Src/DB.UCollections.pas | 64 +++++++++++++++++++++++++++-------------- 1 file changed, 42 insertions(+), 22 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 4a575c1e6..ae10638f1 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -94,19 +94,20 @@ TComparer = class(TInterfacedObject, reintroduce; end; const + {TODO -cCollections: remove DCSC_v2_ID and SWAG_v1_ID once there are no + built-in collections except Default} DCSC_v2_ID: TGUID = '{9F3A4A8A-0A2B-4088-B7C9-AE1D32D3FF9A}'; SWAG_v1_ID: TGUID = '{ADA985E0-0929-4986-A3FE-B2C981D430F1}'; - Native_v4_ID: TGUID = '{E63E7160-2389-45F2-B712-EA0449D30B1F}'; constructor Create(const ABytes: TBytes); overload; constructor Create(const AStr: string); overload; constructor Create(const AGUID: TGUID); overload; class function CreateFromHexString(const AHexStr: string): TCollectionID; static; class function CreateNull: TCollectionID; static; + class function Default: TCollectionID; static; function Clone: TCollectionID; function ToArray: TBytes; function ToHexString: string; - function IsBuiltInID: Boolean; function IsNull: Boolean; function Hash: Integer; class function Compare(Left, Right: TCollectionID): Integer; static; @@ -200,6 +201,8 @@ TCollection = record read fCollectionFormatKind; /// Checks if this record's fields are valid. function IsValid: Boolean; + /// Checks if this record is the default collection. + function IsDefault: Boolean; end; TCollections = class sealed(TSingleton) @@ -218,6 +221,7 @@ TCollections = class sealed(TSingleton) function ContainsID(const AUID: TCollectionID): Boolean; function ContainsName(const AName: string): Boolean; function GetCollection(const AUID: TCollectionID): TCollection; + function Default: TCollection; procedure Add(const ACollection: TCollection); procedure Update(const ACollection: TCollection); procedure AddOrUpdate(const ACollection: TCollection); @@ -315,6 +319,11 @@ constructor TCollection.Create(const AUID: TCollectionID; fCollectionFormatKind := ACollectionFormatKind; end; +function TCollection.IsDefault: Boolean; +begin + Result := UID = TCollectionID.Default; +end; + function TCollection.IsValid: Boolean; begin {TODO: Constructor enforces all these requirements, so #TCollection.IsValid @@ -370,10 +379,19 @@ function TCollections.Count: Integer; Result := fItems.Count; end; +function TCollections.Default: TCollection; +begin + Result := GetCollection(TCollectionID.Default); +end; + procedure TCollections.Delete(const AUID: TCollectionID); +resourcestring + sCantDelete = 'Cannot delete the default collection'; var Idx: Integer; begin + if TCollectionID.Default = AUID then + raise EArgumentException.Create(sCantDelete); Idx := IndexOfID(AUID); if Idx >= 0 then fItems.Delete(Idx); @@ -433,8 +451,18 @@ procedure TCollections.Initialize; begin fItems := TList.Create; TCollectionsPersist.Load(Self); - { TODO -cCollections: following lines are for v4 compatibility - Remove if not required in v5 } + // Ensure there is always at least the default collection present + if not ContainsID(TCollectionID.Default) then + Add( + TCollection.Create( + TCollectionID.Default, + 'Default', + TCollectionLocation.Create(TAppInfo.DefaultUserDataDir, '', etUTF8), + TCollectionFormatKind.Native_v4 + ) + ); + { TODO -cCollections: following line is for v4 main database compatibility + Remove when reduce to only one compulsory collection } if not ContainsID(TCollectionID.__TMP__MainDBCollectionID) then Add( TCollection.Create( @@ -446,17 +474,6 @@ procedure TCollections.Initialize; TCollectionFormatKind.DCSC_v2 ) ); - if not ContainsID(TCollectionID.__TMP__UserDBCollectionID) then - Add( - TCollection.Create( - TCollectionID.__TMP__UserDBCollectionID, - { TODO -cVault: change name - this text matches name used in CodeSnip - v4} - 'User Database', - TCollectionLocation.Create(TAppInfo.DefaultUserDataDir, '', etUTF8), - TCollectionFormatKind.Native_v4 - ) - ); end; procedure TCollections.Save; @@ -537,6 +554,12 @@ class function TCollectionID.CreateNull: TCollectionID; Result := TCollectionID.Create(NullID); end; +class function TCollectionID.Default: TCollectionID; +begin + // Default collection is an empty GUID = 16 zero bytes + Result := TCollectionID.Create(TGUID.Empty); +end; + class operator TCollectionID.Equal(Left, Right: TCollectionID): Boolean; begin @@ -548,12 +571,6 @@ function TCollectionID.Hash: Integer; Result := BobJenkinsHash(fID[0], Length(fID), 0); end; -function TCollectionID.IsBuiltInID: Boolean; -begin - Result := (TCollectionID.Create(DCSC_v2_ID) = Self) - or (TCollectionID.Create(SWAG_v1_ID) = Self); -end; - function TCollectionID.IsNull: Boolean; begin Result := Length(fID) = 0; @@ -582,7 +599,7 @@ class function TCollectionID.__TMP__MainDBCollectionID: TCollectionID; class function TCollectionID.__TMP__UserDBCollectionID: TCollectionID; begin - Result := TCollectionID.Create(Native_v4_ID); + Result := TCollectionID.Default; end; { TCollectionID.TComparer } @@ -632,6 +649,9 @@ class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; begin Storage := Settings.ReadSection(ssCollection, IntToStr(AOrdinal)); UID := TCollectionID.Create(Storage.GetBytes(UIDKey)); + if ACollections.ContainsID(UID) then + // Don't load a duplicate collection + Exit; Name := Storage.GetString(NameKey, ''); Location := TCollectionLocation.Create( Storage.GetString(LocationDirectoryKey, ''), From 58970657160d7e66034a0a63aea2137d0459c5ba Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 15 Nov 2024 19:41:46 +0000 Subject: [PATCH 092/222] Update various units to work with default collection Several units that formerly used the TCollectionID.__TMP__UserDBCollectionID method were altered to use the new default collection or default collection ID. NOTE: not all __TMP__UserDBCollectionID calls were replaced: those that were inserted for a different purpose than to stand in for the default collection were left in place. Also some previously commented out code was deleted. --- Src/DB.UMain.pas | 43 +++++++++++++++---------------------- Src/FmCodeImportDlg.pas | 8 ++----- Src/FmSWAGImportDlg.pas | 10 +++------ Src/FmSnippetsEditorDlg.pas | 26 +++------------------- Src/FrDisplayPrefs.pas | 7 ++---- Src/UCodeImportExport.pas | 10 ++------- Src/UCodeImportMgr.pas | 4 +--- 7 files changed, 30 insertions(+), 78 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index fced065ae..2ca5089c8 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -1073,7 +1073,7 @@ procedure TDatabase.Load; } var Factory: IDBDataItemFactory; // object reader uses to create snippets objects - MainCollectionIdx, UserCollectionIdx: Integer; + MainCollectionIdx: Integer; Loader: IDataFormatLoader; Collections: TCollections; Collection: TCollection; @@ -1104,16 +1104,12 @@ procedure TDatabase.Load; Loader.Load(fSnippets, fCategories, Factory); end; - UserCollectionIdx := TCollections.Instance.IndexOfID( - TCollectionID.__TMP__UserDBCollectionID - ); - if UserCollectionIdx >= 0 then - begin - Collection := Collections[UserCollectionIdx]; - Loader := TDatabaseIOFactory.CreateDBLoader(Collection); - if Assigned(Loader) then - Loader.Load(fSnippets, fCategories, Factory); - end; + // Load default collection + Collection := Collections.Default; + Loader := TDatabaseIOFactory.CreateDBLoader(Collection); + Assert(Assigned(Loader), + ClassName + '.Load: No loader for default collection'); + Loader.Load(fSnippets, fCategories, Factory); // Read categories from categories file to get any empty categories not // created by format loaders @@ -1144,8 +1140,8 @@ procedure TDatabase.Save; {Saves user defined snippets and all categories to user database. } var - MainProvider, UserProvider: IDBDataProvider; - MainCollectionIdx, UserCollectionIdx: Integer; + MainProvider, DefaultProvider: IDBDataProvider; + MainCollectionIdx: Integer; Saver: IDataFormatSaver; Collections: TCollections; Collection: TCollection; @@ -1169,26 +1165,21 @@ procedure TDatabase.Save; begin Collection := Collections[MainCollectionIdx]; MainProvider := TCollectionDataProvider.Create( - TCollectionID.__TMP__MainDBCollectionID, fSnippets, fCategories + Collection.UID, fSnippets, fCategories ); Saver := TDatabaseIOFactory.CreateDBSaver(Collection); if Assigned(Saver) then Saver.Save(fSnippets, fCategories, MainProvider); end; - UserCollectionIdx := TCollections.Instance.IndexOfID( - TCollectionID.__TMP__UserDBCollectionID + Collection := Collections.Default; + DefaultProvider := TCollectionDataProvider.Create( + Collection.UID, fSnippets, fCategories ); - if UserCollectionIdx >= 0 then - begin - Collection := Collections[UserCollectionIdx]; - UserProvider := TCollectionDataProvider.Create( - TCollectionID.__TMP__UserDBCollectionID, fSnippets, fCategories - ); - Saver := TDatabaseIOFactory.CreateDBSaver(Collection); - if Assigned(Saver) then - Saver.Save(fSnippets, fCategories, UserProvider); - end; + Saver := TDatabaseIOFactory.CreateDBSaver(Collection); + Assert(Assigned(Saver), + ClassName + '.Save: No saver for default collection'); + Saver.Save(fSnippets, fCategories, DefaultProvider); fUpdated := False; end; diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index 1a131ce41..7b9bfa4f8 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -339,13 +339,9 @@ procedure TCodeImportDlg.InitForm; begin fCollList.ToStrings(cbCollection.Items); Assert(cbCollection.Items.Count > 0, ClassName + '.InitForm: no collections'); - {TODO -cCollections: Replace following __TMP__ method calls with a calls to - TCollections.DefaultCollection or similar.} - Assert(TCollections.Instance.ContainsID(TCollectionID.__TMP__UserDBCollectionID), + Assert(TCollections.Instance.ContainsID(TCollectionID.Default), ClassName + '.InitForm: default collection not found'); - cbCollection.ItemIndex := cbCollection.Items.IndexOf( - TCollections.Instance.GetCollection(TCollectionID.__TMP__UserDBCollectionID).Name - ); + cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); Assert(cbCollection.ItemIndex >= 0, ClassName + '.InitForm: default collection name not in cbCollection'); diff --git a/Src/FmSWAGImportDlg.pas b/Src/FmSWAGImportDlg.pas index 873f9bb71..e33029319 100644 --- a/Src/FmSWAGImportDlg.pas +++ b/Src/FmSWAGImportDlg.pas @@ -535,15 +535,11 @@ procedure TSWAGImportDlg.ConfigForm; fCollList.ToStrings(cbCollection.Items); Assert(cbCollection.Items.Count > 0, ClassName + '.ConfigForm: no collections'); - {TODO -cCollections: Replace following __TMP__ method calls with a calls to - TCollections.DefaultCollection or similar.} - Assert(TCollections.Instance.ContainsID(TCollectionID.__TMP__UserDBCollectionID), + Assert(TCollections.Instance.ContainsID(TCollectionID.Default), ClassName + '.ConfigForm: default collection not found'); - cbCollection.ItemIndex := cbCollection.Items.IndexOf( - TCollections.Instance.GetCollection(TCollectionID.__TMP__UserDBCollectionID).Name - ); + cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); Assert(cbCollection.ItemIndex >= 0, - ClassName + '.ConfigForm: default collection name not in cbCollection'); + ClassName + '.ConfigForm: default collection not in cbCollection'); end; destructor TSWAGImportDlg.Destroy; diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index ab8c331c2..5c7079dc3 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -892,11 +892,9 @@ procedure TSnippetsEditorDlg.InitControls; cbCategories.ItemIndex := fCatList.IndexOf(TCategory.DefaultID); if cbCategories.ItemIndex = -1 then cbCategories.ItemIndex := 0; - {TODO -cCollections: Replace following __TMP__ method call with call to new - TCollections.Default method or similar.} - cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.__TMP__UserDBCollectionID); - if cbCollection.ItemIndex = -1 then - cbCollection.ItemIndex := 0; + cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); + Assert(cbCollection.ItemIndex >= 0, + ClassName + '.InitControls: No default collection in cbCollection'); cbCollection.Visible := True; // can select collection of new snippet lblCollectionInfo.Visible := False; cbKind.ItemIndex := fSnipKindList.IndexOf(skFreeform); @@ -1067,24 +1065,6 @@ procedure TSnippetsEditorDlg.UpdateReferences; end; end; -// for Snippet in Database.Snippets do -// begin -// // We ignore snippet being edited and main database snippets if there is -// // a user-defined one with same key -// if (Snippet.ID <> EditSnippetID) and -// ( -// (Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) or -// not Assigned(Database.Snippets.Find(Snippet.Key, TCollectionID.__TMP__UserDBCollectionID)) -// ) then -// begin -// // Decide if snippet can be added to depends list: must be correct kind -// if Snippet.Kind in -// TSnippetValidator.ValidDependsKinds(EditSnippetKind) then -// fDependsCLBMgr.AddSnippet(Snippet); -// // Anything can be in XRefs list -// fXRefsCLBMgr.AddSnippet(Snippet); -// end; -// end; // Restore checks to any saved checked item that still exist in new list fDependsCLBMgr.Restore; fXRefsCLBMgr.Restore; diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index 926c561a5..41c8834d1 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -164,12 +164,9 @@ procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences; var Collection: TCollection; begin - {TODO -cCollections: Replace __TMP__ method below with call to a new - TCollections.Default method or similar.} - cbCollection.ItemIndex := TCollections.Instance.IndexOfID(TCollectionID.__TMP__UserDBCollectionID); + cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); Assert(cbCollection.ItemIndex >= 0, - ClassName + '.Activate: no default collection found'); - + ClassName + '.Activate: no default collection found in cbCollection'); SelectOverviewTreeState(Prefs.OverviewStartState); chkHideEmptySections.OnClick := nil; // prevent OnClick when Checked set chkHideEmptySections.Checked := not Prefs.ShowEmptySections; diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index e422bf338..c90d10d7d 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -295,18 +295,12 @@ procedure TCodeExporter.WriteSnippet(const ParentNode: IXMLNode; begin // Create snippet node with attribute that specifies snippet key SnippetNode := fXMLDoc.CreateElement(ParentNode, cSnippetNode); - (Database as IDatabaseEdit).GetUniqueSnippetKey(TCollectionID.__TMP__UserDBCollectionID); // Export snippet under a new unique key within the default collection // we use default collection because code importer assumes snippet id from // that collection. We create new unique key because more than one snippet // could be exported that have the same key but are in different collections. SnippetNode.Attributes[cSnippetNameAttr] := - (Database as IDatabaseEdit).GetUniqueSnippetKey( - {TODO -cVault: Replace following __TMP__ method call with a call to get - default collection, which should be common to databases used by - every user} - TCollectionID.__TMP__UserDBCollectionID - ); + (Database as IDatabaseEdit).GetUniqueSnippetKey(TCollectionID.Default); // Add nodes for properties: (ignore category and xrefs) // description node is written even if empty (which it shouldn't be) fXMLDoc.CreateElement( @@ -412,7 +406,7 @@ procedure TCodeImporter.Execute(const Data: TBytes); // Note: in building snippet ID list we assume each snippet is from the // default collection. It may not be, but there is no way of telling // from XML. - Depends.Add(TSnippetID.Create(SnippetName, TCollectionID.__TMP__UserDBCollectionID)); + Depends.Add(TSnippetID.Create(SnippetName, TCollectionID.Default)); end; // Reads description node and converts to active text. diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index 8a91a2560..1a5ff89b6 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -168,9 +168,7 @@ constructor TCodeImportMgr.Create; // set default event handler fRequestCollectionCallback := function: TCollectionID begin - {TODO -cCollections: Require a TCollections.DefaultCollection method or - similar to replace the following __TMP__ method call.} - Result := TCollectionID.__TMP__UserDBCollectionID; + Result := TCollectionID.Default; end; end; From 9fbae1e78baa1f19cc21ec8167bb1f102c4d02c4 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 15 Nov 2024 20:22:54 +0000 Subject: [PATCH 093/222] Update RTF colour table used in TRTFSnippetDoc TRTFSnippetDoc changed to add to RTF colour table all colours used to render snippet display names from every collection. --- Src/URTFSnippetDoc.pas | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/Src/URTFSnippetDoc.pas b/Src/URTFSnippetDoc.pas index 5893e8dd3..3c560586d 100644 --- a/Src/URTFSnippetDoc.pas +++ b/Src/URTFSnippetDoc.pas @@ -163,6 +163,8 @@ function TRTFSnippetDoc.FinaliseDoc: TEncodedData; end; procedure TRTFSnippetDoc.InitialiseDoc; +var + Collection: TCollection; begin // Create object used to build main rich text document fBuilder := TRTFBuilder.Create(0); // Use default code page @@ -173,11 +175,10 @@ procedure TRTFSnippetDoc.InitialiseDoc; fBuilder.ColourTable.Add(clWarningText); fBuilder.ColourTable.Add(clVarText); fBuilder.ColourTable.Add(clExternalLink); - { TODO -cCollections: Replace following two statements with iteration over all - supported collections when support for multiple collections is added. - } - fBuilder.ColourTable.Add(Preferences.GetSnippetHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); - fBuilder.ColourTable.Add(Preferences.GetSnippetHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); + for Collection in TCollections.Instance do + fBuilder.ColourTable.Add( + Preferences.GetSnippetHeadingColour(Collection.UID) + ); end; procedure TRTFSnippetDoc.InitStyles; From acd5c87ef9c459232e512cbc1ef6d1e38a179a3a Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 15 Nov 2024 20:25:45 +0000 Subject: [PATCH 094/222] Update RTF colour table used in TRTFCategoryDoc TRTFCategoryDoc changed to add to RTF colour table all colours used to render snippet display names from every collection and the colour used for category headings. --- Src/URTFCategoryDoc.pas | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index 73f6e6858..0d4009200 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -96,6 +96,8 @@ implementation { TRTFCategoryDoc } constructor TRTFCategoryDoc.Create(const UseColour: Boolean); +var + Collection: TCollection; begin inherited Create; fUseColour := UseColour; @@ -104,10 +106,11 @@ constructor TRTFCategoryDoc.Create(const UseColour: Boolean); fBuilder.FontTable.Add(MainFontName, rgfSwiss, 0); fBuilder.FontTable.Add(MonoFontName, rgfModern, 0); // Set up colour table - {TODO -cCollection: Replace following 2 statements with loop that iterates - over all collections.} - fBuilder.ColourTable.Add(Preferences.GetSnippetHeadingColour(TCollectionID.__TMP__MainDBCollectionID)); - fBuilder.ColourTable.Add(Preferences.GetSnippetHeadingColour(TCollectionID.__TMP__UserDBCollectionID)); + for Collection in TCollections.Instance do + fBuilder.ColourTable.Add( + Preferences.GetSnippetHeadingColour(Collection.UID) + ); + fBuilder.ColourTable.Add(Preferences.GroupHeadingColour); fBuilder.ColourTable.Add(clExternalLink); fDescStyles := TActiveTextRTFStyleMap.Create; InitStyles; @@ -216,6 +219,7 @@ procedure TRTFCategoryDoc.OutputCategoryHeading(const Category: TCategory); fBuilder.SetFont(MainFontName); fBuilder.SetFontSize(HeadingFontSize); fBuilder.SetFontStyle([fsBold]); + SetColour(Preferences.GroupHeadingColour); fBuilder.AddText(Category.Description); fBuilder.EndPara; fBuilder.EndGroup; From d28b49b743fda158c9c610f320afe32a82123489 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 16 Nov 2024 10:30:27 +0000 Subject: [PATCH 095/222] Split DB.UMetaData unit into two units Removed all "main" database specific code from DB.UMetaData and placed it in a new DBIO.MetaData.DCSC unit that was added to the project. DB.UMetaData now just declares the IDBMetaData interface to be supported by all objects that encapsulate a collection's meta along with two records referenced by the interface. DBIO.MetaData.DCSC contains the implementation of IDBMetaData for various versions of the old "main" database, now referred to as the DelphiDabbler Code Snippets Collection (DCSC). Added a reference to DBIO.MetaData.DCSC to all units that previously accessed its code via DB.MetaData. --- Src/CodeSnip.dpr | 3 +- Src/CodeSnip.dproj | 1 + Src/DB.UMetaData.pas | 866 ++----------------------------------- Src/DBIO.MetaData.DCSC.pas | 830 +++++++++++++++++++++++++++++++++++ Src/FmAboutDlg.pas | 1 + Src/UDBUpdateMgr.pas | 1 + Src/USaveUnitMgr.pas | 1 + Src/USnippetDoc.pas | 1 + Src/USnippetSourceGen.pas | 1 + 9 files changed, 865 insertions(+), 840 deletions(-) create mode 100644 Src/DBIO.MetaData.DCSC.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index e345c810e..73f6da5c6 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -377,7 +377,8 @@ uses DB.UCollections in 'DB.UCollections.pas', UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas', DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas', - UCollectionListAdapter in 'UCollectionListAdapter.pas'; + UCollectionListAdapter in 'UCollectionListAdapter.pas', + DBIO.MetaData.DCSC in 'DBIO.MetaData.DCSC.pas'; // Include resources {$Resource ExternalObj.tlb} // Type library file diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 3524fb160..d5132b5a5 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -584,6 +584,7 @@ + Base diff --git a/Src/DB.UMetaData.pas b/Src/DB.UMetaData.pas index 1c26520f3..8e4b69cf3 100644 --- a/Src/DB.UMetaData.pas +++ b/Src/DB.UMetaData.pas @@ -5,104 +5,26 @@ * * Copyright (C) 2020-2021, Peter Johnson (gravatar.com/delphidabbler). * - * Provides meta data for the current main database and for any database - * updates. + * Declares interface and defines records required to support collection + * metadata. } unit DB.UMetaData; -{ - Notes About Database Versions And Meta Files. - ============================================= - - Versions - -------- - - v1 of the Code Snippets Database was not considered to have a version number - until the arrival of v2. Therefore v1 did not have any means of identifying - its version number. Although the database format changed slightly over time - there is not enough historical information to identify different minor - releases, so all are considered to be v1.0.0.0 - - Database v2 has a VERSION file that specifies the version number as a dotted - quad, of the form v2.0.0.0. - - Note that semantic versioning is now being used so any database with major - version 2 will be backwards compatible with earlier v2 minor release. - - If a breaking change is introduced the major version will be bumped to v3 and - so on. - - Meta Files - ---------- - - Database v1 had only two meta files: - + contrib.txt - lists of contributors to the database, one per line - + testers.txt - lists of database testers, one per line - If those two files are present the database is assumed to be v1 - - Database v2 has the following meta files: - + VERSION - version number (v2.x.x.x) - + CONTRIBUTORS - lists of contributors to the database, one per line - + TESTERS - lists of database testers, one per line - + LICENSE - full text of the license that applies to the snippets - + LICENSE-INFO - furter information about the license - - For database v1 the license text, license information are hard-wired in the - absence of meta files. As noted above the version number is deduced. - - File encoding - ------------- - - All meta files are plain text. - - Early v1 database meta files were encoded in the system default encoding. - Later v1 databases encoded meta files in UTF-8. To distinguish between UTF-8 - and default encoded files the UTF-8 files use the UTF-8 preamble (BOM). - - v2 database meta files are all encoded in UTF-8 with preamble (BOM). - - Future major versions - --------------------- - - Future major database releases MUST include backwards compatibility with - earlier versions of CodeSnip in as much as those versions must be able to - easily detect and reject the format. - - To achieve this new major releases MUST include a VERSION file encoded in - UTF-8 with BOM. Existing code can detect and will reject any unsupported - version. - - CodeSnip support - ---------------- - - CodeSnip versions earlier than v4.16 are only ever delivered v1 database files - via their built in web update code. There is no way for these versions to - access v2 databases. - - CodeSnip from v4.16 get their main snippets database from files downloaded - manually. All such databases are v2. CodeSnip v4.16 also supports v1 format - because such a database may be resident on the user's computer at install - time. -} - interface uses - // VCL - Classes, // Project - UExceptions, UIStringList, UVersionInfo; type - /// Record providing information about the main database license. + /// Record providing information about a collection's license. /// TDBLicenseInfo = record strict private @@ -112,6 +34,7 @@ TDBLicenseInfo = record fText: string; public /// Record constructor: sets all fields of record. + /// Any or all parameters may be the empty string constructor Create(const AName, ASPDX, AURL, AText: string); /// Name of license. property Name: string read fName; @@ -132,7 +55,7 @@ TDBLicenseInfo = record function NameWithURL: string; end; - /// Record providing informaton about the main database copyright. + /// Record providing informaton about a collection's copyright. /// TDBCopyrightInfo = record strict private @@ -141,6 +64,7 @@ TDBCopyrightInfo = record fHolderURL: string; public /// Record constructor: sets all fields of record. + /// Any or all parameters may be the empty string constructor Create(const ADate, AHolder, AHolderURL: string); /// Copyright date. /// May be a single year or a range: e.g. 2020 or 2012-2016. @@ -153,785 +77,49 @@ TDBCopyrightInfo = record property HolderURL: string read fHolderURL; end; - /// Interface supported by classes providing database meta data. - /// + /// Interface that provides information about any meta data + /// supported by a collection. IDBMetaData = interface(IInterface) - /// Returns database version number. - /// A null version number is returned if the meta data does not - /// come from a recognised database. + /// Returns the collection's version number. + /// A null version number is returned if the collection does not + /// include Version in its capabilities. function GetVersion: TVersionNumber; - /// Returns database license information. - /// Return value is meaningless if the meta data does not come - /// from a supported database. + /// Returns the collection's license information. + /// Return value is meaningless if the collection does not include + /// License in its capabilities. function GetLicenseInfo: TDBLicenseInfo; - /// Returns database copyright informatiom. - /// Return value is meaningless if the meta data does not come - /// from a supported database. + /// Returns the collection's copyright informatiom. + /// Return value is meaningless if the collection does not include + /// Copyright in its capabilities. function GetCopyrightInfo: TDBCopyrightInfo; - /// Returns list of contributors to database. - /// Return value is meaningless if the meta data does not come - /// from a supported database. + /// Returns a list of contributors to the collection. + /// Return value is meaningless if the collection does not include + /// Contributors in its capabilities. function GetContributors: IStringList; - /// Returns list of testers of database. - /// Return value is meaningless if the meta data does not come - /// from a supported database. + /// Returns a list of testers of the collection. + /// Return value is meaningless if the collection does not include + /// Testers in its capabilities. function GetTesters: IStringList; /// Checks if meta data is recognised as belonging to a valid - /// database, whether supported or not. + /// collection, whether supported or not. function IsRecognised: Boolean; /// Checks if meta data is recognised as belonging to a supported - /// database version. + /// collection version. function IsSupportedVersion: Boolean; /// Checks if meta data is corrupt. /// Should only be called if meta data belongs to a supported - /// database. An exception should be raised if called on unsupported + /// collection. An exception should be raised if called on unsupported /// versions. function IsCorrupt: Boolean; - /// Refreshes the meta information by re-reading from database + /// Refreshes the meta information by re-reading from collection /// meta files. procedure Refresh; end; - /// Factory that creates instances of objects that provide - /// information about the main database and database updates. - TMainDBMetaDataFactory = record - public - /// Returns instance of class that provides meta data for the - /// main database. - class function MainDBMetaDataInstance: IDBMetaData; static; - /// Returns instance of class that provides meta data for the - /// database update stored in the given folder. - class function UpdateMetaDataInstance(const UpdateDir: string): - IDBMetaData; static; - end; - - /// Class of exception raised by meta data classes. - EDBMetaData = class(ECodeSnip); - implementation -uses - // Project - SysUtils, - IOUtils, - Types, - // VCL - UAppInfo, - UEncodings, - UIOUtils, - UResourceUtils, - UStructs, - UStrUtils; - - -const - DBValidVersions: TRange = (Min: 1; Max: 2); - -type - - /// Provides names of meta data files supported by various database - /// versions. - TDBMetaFileNames = record - public - const - ContributorsV1 = 'contrib.txt'; - TestersV1 = 'testers.txt'; - VersionV2AndLater = 'VERSION'; - LicenseV2 = 'LICENSE'; - LicenseInfoV2 = 'LICENSE-INFO'; - ContributorsV2 = 'CONTRIBUTORS'; - TestersV2 = 'TESTERS'; - end; - - /// Abstract base class for classes that access or emulate database - /// meta data files. - TDBMetaFiles = class abstract(TObject) - strict private - var - /// Directory of database for which meta data files are being - /// accessed. - fDBDir: string; - /// Returns encoding used by given meta file. - function GetFileEncoding(const FileName: TFileName): TEncoding; - strict protected - /// Makes a fully specified path to a given database file. - /// - /// FileName must contain no path information. - function MakePath(const FileName: string): string; - /// Checks if a given file exists in database directory. - function DBFileExists(const FileName: string): Boolean; - /// Reads all lines from given file and returns them as an array. - /// - /// FileName must contain no path information. - function ReadFileLines(const FileName: TFileName): TStringDynArray; - /// Reads all text from given file and returns it. - /// FileName must contain no path information. - function ReadFileText(const FileName: TFileName): string; - public - /// Constructs object that accesses meta data database files in - /// given directory. - constructor Create(const DBDir: string); - /// Returns text of the version file, or surrogate value. - /// - function Version: string; virtual; abstract; - /// Returns content license text file or surrogate value. - /// - function LicenseText: string; virtual; abstract; - /// Returns lines of license information file or surrogate value. - /// - function LicenseInfo: TStringDynArray; virtual; abstract; - /// Returns lines of contributors file or surrogate value. - /// - function Contributors: TStringDynArray; virtual; abstract; - /// Returns lines of testers file or surrogate value. - function Testers: TStringDynArray; virtual; abstract; - /// Checks if all the expected meta files are present. Returns - /// True if so or False if not. - /// ENotSupportedException must be raised if called on an - /// unsupported database version. - function AreAllFilesPresent: Boolean; virtual; abstract; - end; - - /// Class that accesses content of version 1 main database meta data - /// files. - /// Not all meta files are present in version main databases so - /// invariant placeholder content is provided to substitute for missing - /// files. - TV1DBMetaFiles = class sealed(TDBMetaFiles) - strict private - const - cContributorsFile = TDBMetaFileNames.ContributorsV1; - cTestersFile = TDBMetaFileNames.TestersV1; - public - /// Returns an surrogate, invariant value of 1 for the version - /// number. - /// No version file exists for this database version. The value - /// returned is deduced using documentation from the current code snippets - /// database project. - function Version: string; override; - /// Returns an surrogate, invariant value for the license text. - /// - /// No license text file exists for this database version. The - /// value returned is based on documentation of the database. - function LicenseText: string; override; - /// Returns an surrogate, invariant value for the lines of license - /// information. - function LicenseInfo: TStringDynArray; override; - /// Returns the lines of the contributors file. - function Contributors: TStringDynArray; override; - /// Returns the lines of the testers file. - function Testers: TStringDynArray; override; - /// Checks if all the expected meta files are present. Returns - /// True if so or False if not. - function AreAllFilesPresent: Boolean; override; - end; - - /// Class that accesses content of supported version 2 main database - /// meta files. - TV2DBMetaFiles = class sealed(TDBMetaFiles) - strict private - const - cVersionFile = TDBMetaFileNames.VersionV2AndLater; - cLicenseFile = TDBMetaFileNames.LicenseV2; - cLicenseInfoFile = TDBMetaFileNames.LicenseInfoV2; - cContributorsFile = TDBMetaFileNames.ContributorsV2; - cTestersFile = TDBMetaFileNames.TestersV2; - public - /// Returns the contents of the version file. - function Version: string; override; - /// Returns the contents of the license text file. - function LicenseText: string; override; - /// Returns the lines of the license info file. - function LicenseInfo: TStringDynArray; override; - /// Returns the lines of the contributors file. - function Contributors: TStringDynArray; override; - /// Returns the lines of the testers file. - function Testers: TStringDynArray; override; - /// Checks if all the expected meta files are present. Returns - /// True if so or False if not. - function AreAllFilesPresent: Boolean; override; - end; - - /// Class that represents later versions of database meta file - /// formats. - /// These formats have a valid version file but the version is not - /// supported and nothing is known about any other meta data files. - TLaterDBMetaFiles = class sealed(TDBMetaFiles) - strict private - const - cVersionFile = TDBMetaFileNames.VersionV2AndLater; - public - /// Returns the contents of the version file. - function Version: string; override; - /// Returns the empty string. - /// The file format is unknown, so the license text file cannot be - /// read and there is no information to deduce the value. - function LicenseText: string; override; - /// Returns an empty string array. - /// The file format is unknown, so the license information file - /// cannot be read and there is no information to deduce the value. - /// - function LicenseInfo: TStringDynArray; override; - /// Returns an empty string array. - /// The file format is unknown, so the contributors file cannot be - /// read and there is no information to deduce the value. - function Contributors: TStringDynArray; override; - /// Returns an empty string array. - /// The file format is unknown, so the testers file cannot be read - /// and there is no information to deduce the value. - function Testers: TStringDynArray; override; - /// Checks if all the expected meta files are present only if - /// the meta files come from a supported database format. - /// ENotSupportedException always raised since there is no way - /// of knowing what files should be present in an unsupported database - /// format. - function AreAllFilesPresent: Boolean; override; - end; - - /// Class that is present to represent unknown database meta file - /// formats. Also used when database is not present. - /// Accesses no files and returns null results for all methods - /// except IsVersionSupported. - TUnknownOrMissingMetaFiles = class sealed(TDBMetaFiles) - public - /// Returns the empty string. - /// The file format is unknown, so the version file cannot be read - /// and there is no information to deduce the value. - function Version: string; override; - /// Returns the empty string. - /// The file format is unknown, so the license text file cannot be - /// read and there is no information to deduce the value. - function LicenseText: string; override; - /// Returns an empty string array. - /// The file format is unknown, so the license information file - /// cannot be read and there is no information to deduce the value. - /// - function LicenseInfo: TStringDynArray; override; - /// Returns an empty string array. - /// The file format is unknown, so the contributors file cannot be - /// read and there is no information to deduce the value. - function Contributors: TStringDynArray; override; - /// Returns an empty string array. - /// The file format is unknown, so the testers file cannot be read - /// and there is no information to deduce the value. - function Testers: TStringDynArray; override; - /// Checks if all the expected meta files are present only if - /// the meta files come from a supported database format. - /// ENotSupportedException always raised since there is no way - /// of knowing what files should be present in an unrecognised database - /// format. - function AreAllFilesPresent: Boolean; override; - end; - - /// Factory to create the correct instance of database meta file - /// classes that can read the version of a database in a given folder. - /// - TDBMetaFilesFactory = record - public - class function GetInstance(const DBDir: string): TDBMetaFiles; - static; - end; - - /// Abstract base class for classes that provide main database meta - /// data. - TAbstractMainDBMetaData = class abstract(TInterfacedObject) - strict private - var - fMetaFiles: TDBMetaFiles; - fIsVersionLoaded: Boolean; - fVersion: TVersionNumber; - fIsLicenseAndCopyrightInfoLoaded: Boolean; - fLicenseInfo: TDBLicenseInfo; - fCopyrightInfo: TDBCopyrightInfo; - fContributors: IStringList; - fTesters: IStringList; - - procedure LoadLicenseAndCopyrightInfo; - - strict protected - function GetDBDir: string; virtual; abstract; - public - constructor Create; - procedure AfterConstruction; override; - destructor Destroy; override; - /// Returns database version number. - /// - /// A null version number is returned if the meta data does not come - /// from a recognised database. - /// Method of IDBMetaData. - /// - function GetVersion: TVersionNumber; - /// Returns database license information. - /// - /// Return value is meaningless if the meta data does not come - /// from a supported database. - /// Method of IDBMetaData. - /// - function GetLicenseInfo: TDBLicenseInfo; - /// Returns database copyright informatiom. - /// - /// Return value is meaningless if the meta data does not come - /// from a supported database. - /// Method of IDBMetaData. - /// - function GetCopyrightInfo: TDBCopyrightInfo; - /// Returns list of contributors to database. - /// - /// Return value is meaningless if the meta data does not come - /// from a supported database. - /// Method of IDBMetaData. - /// - function GetContributors: IStringList; - /// Returns list of testers of database. - /// - /// Return value is meaningless if the meta data does not come - /// from a supported database. - /// Method of IDBMetaData. - /// - function GetTesters: IStringList; - /// Checks if meta data is recognised as belonging to a valid - /// database, whether supported or not. - /// Method of IDBMetaData. - function IsRecognised: Boolean; - /// Checks if meta data is recognised as belonging to a supported - /// database version. - /// Method of IDBMetaData. - function IsSupportedVersion: Boolean; - /// Checks if meta data is corrupt. - /// - /// Should only be called if meta data belongs to a supported - /// database. - /// Method of IDBMetaData. - /// - /// ENotSupportedException raised if called on an unsupported - /// database. - function IsCorrupt: Boolean; - /// Refreshes the meta information by re-reading from database - /// meta files. - /// Method of IDBMetaData. - procedure Refresh; - end; - - /// Class that provides meta data for the main database. - TMainDBMetaData = class sealed(TAbstractMainDBMetaData, IDBMetaData) - strict protected - function GetDBDir: string; override; - end; - - /// Class that provides meta data for update database directories. - /// - TUpdateDBMetaData = class sealed(TAbstractMainDBMetaData, IDBMetaData) - strict private - var - fUpdateDir: string; - strict protected - function GetDBDir: string; override; - public - constructor Create(const UpdateDir: string); - end; - -{ TMainDBMetaDataFactory } - -class function TMainDBMetaDataFactory.MainDBMetaDataInstance: - IDBMetaData; -begin - Result := TMainDBMetaData.Create; -end; - -class function TMainDBMetaDataFactory.UpdateMetaDataInstance( - const UpdateDir: string): IDBMetaData; -begin - Result := TUpdateDBMetaData.Create(UpdateDir); -end; - -{ TAbstractMainDBMetaData } - -procedure TAbstractMainDBMetaData.AfterConstruction; -begin - inherited; - Refresh; -end; - -constructor TAbstractMainDBMetaData.Create; -begin - inherited; -// Refresh; -end; - -destructor TAbstractMainDBMetaData.Destroy; -begin - fMetaFiles.Free; - inherited; -end; - -function TAbstractMainDBMetaData.GetContributors: IStringList; -begin - if not Assigned(fContributors) then - fContributors := TIStringList.Create(fMetaFiles.Contributors); - Result := fContributors; -end; - -function TAbstractMainDBMetaData.GetCopyrightInfo: TDBCopyrightInfo; -begin - if not fIsLicenseAndCopyrightInfoLoaded then - LoadLicenseAndCopyrightInfo; - Result := fCopyrightInfo; -end; - -function TAbstractMainDBMetaData.GetLicenseInfo: TDBLicenseInfo; -begin - if not fIsLicenseAndCopyrightInfoLoaded then - LoadLicenseAndCopyrightInfo; - Result := fLicenseInfo; -end; - -function TAbstractMainDBMetaData.GetTesters: IStringList; -begin - if not Assigned(fTesters) then - fTesters := TIStringList.Create(fMetaFiles.Testers); - Result := fTesters; -end; - -function TAbstractMainDBMetaData.GetVersion: TVersionNumber; -begin - if not fIsVersionLoaded then - begin - if not TVersionNumber.TryStrToVersionNumber( - StrTrim(fMetaFiles.Version), fVersion - ) then - fVersion := TVersionNumber.Nul; - end; - fIsVersionLoaded := True; - Result := fVersion; -end; - -function TAbstractMainDBMetaData.IsCorrupt: Boolean; -resourcestring - sNotSupportedError = 'Can''t call IDBMetaData.IsCorrupt for an unsupported ' - + 'database version'; -begin - if not IsSupportedVersion then - raise ENotSupportedException.Create(sNotSupportedError); - Result := not fMetaFiles.AreAllFilesPresent; -end; - -function TAbstractMainDBMetaData.IsRecognised: Boolean; -begin - Result := not GetVersion.IsNull; -end; - -function TAbstractMainDBMetaData.IsSupportedVersion: Boolean; -var - ThisVersion: TVersionNumber; -begin - ThisVersion := GetVersion; - Result := DBValidVersions.Contains(ThisVersion.V1); -end; - -procedure TAbstractMainDBMetaData.LoadLicenseAndCopyrightInfo; -var - SL: TStringList; -begin - if fIsLicenseAndCopyrightInfoLoaded then - Exit; - SL := TStringList.Create; - try - StrArrayToStrList(fMetaFiles.LicenseInfo, SL); - fLicenseInfo := TDBLicenseInfo.Create( - SL.Values['LicenseName'], - SL.Values['LicenseSPDX'], - SL.Values['LicenseURL'], - fMetaFiles.LicenseText - ); - fCopyrightInfo := TDBCopyrightInfo.Create( - SL.Values['CopyrightDate'], - SL.Values['CopyrightHolder'], - SL.Values['CopyrightHolderURL'] - ); - finally - SL.Free; - end; - fIsLicenseAndCopyrightInfoLoaded := True; -end; - -procedure TAbstractMainDBMetaData.Refresh; -begin - FreeAndNil(fMetaFiles); - fMetaFiles := TDBMetaFilesFactory.GetInstance(GetDBDir); - fIsVersionLoaded := False; - fIsLicenseAndCopyrightInfoLoaded := False; - fContributors := nil; - fTesters := nil; -end; - -{ TMainDBMetaData } - -function TMainDBMetaData.GetDBDir: string; -begin - Result := TAppInfo.AppDataDir; -end; - -{ TUpdateDBMetaData } - -constructor TUpdateDBMetaData.Create(const UpdateDir: string); -begin - inherited Create; - fUpdateDir := ExcludeTrailingPathDelimiter(UpdateDir); -end; - -function TUpdateDBMetaData.GetDBDir: string; -begin - Result := fUpdateDir; -end; - -{ TDBMetaFiles } - -constructor TDBMetaFiles.Create(const DBDir: string); -begin - inherited Create; - fDBDir := DBDir; -end; - -function TDBMetaFiles.DBFileExists(const FileName: string): Boolean; -begin - Result := TFile.Exists(MakePath(FileName), False); -end; - -function TDBMetaFiles.GetFileEncoding(const FileName: TFileName): TEncoding; -begin - // Old v1 database meta files may be in the system default encodings, v1 and - // all v2 and later use UTF-8 with BOM. - if TFileIO.CheckBOM(MakePath(FileName), TEncoding.UTF8) then - Result := TEncoding.UTF8 - else - Result := TEncoding.Default; -end; - -function TDBMetaFiles.MakePath(const FileName: string): string; -begin - Assert(not StrContainsStr(PathDelim, FileName), - ClassName + '.MakePath: FileName must be a base file name.'); - Result := IncludeTrailingPathDelimiter(fDBDir) + FileName; -end; - -function TDBMetaFiles.ReadFileLines(const FileName: TFileName): TStringDynArray; -var - Encoding: TEncoding; -begin - if not DBFileExists(FileName) then - begin - SetLength(Result, 0); - Exit; - end; - Encoding := GetFileEncoding(FileName); - try - Result := TFileIO.ReadAllLines(MakePath(FileName), Encoding, True); - finally - TEncodingHelper.FreeEncoding(Encoding); - end; -end; - -function TDBMetaFiles.ReadFileText(const FileName: TFileName): string; -begin - if not DBFileExists(FileName) then - Exit(''); - Result := TFileIO.ReadAllText( - MakePath(FileName), GetFileEncoding(FileName), True - ); -end; - -{ TV1DBMetaFiles } - -function TV1DBMetaFiles.AreAllFilesPresent: Boolean; -begin - Result := DBFileExists(cContributorsFile) and DBFileExists(cTestersFile); -end; - -function TV1DBMetaFiles.Contributors: TStringDynArray; -begin - Result := ReadFileLines(cContributorsFile) -end; - -function TV1DBMetaFiles.LicenseInfo: TStringDynArray; -begin - Result := TStringDynArray.Create( - 'LicenseName=MIT License', - 'LicenseSPDX=MIT', - 'LicenseURL=https://opensource.org/licenses/MIT', - 'CopyrightDate=2005-2016', - 'CopyrightHolder=Peter Johnson & Contributors', - 'CopyrightHolderURL=https://gravatar.com/delphidabbler' - ); -end; - -function TV1DBMetaFiles.LicenseText: string; -begin - Result := LoadResourceAsString(HInstance, 'CSDBLICENSE', RT_RCDATA, etUTF8); -end; - -function TV1DBMetaFiles.Testers: TStringDynArray; -begin - Result := ReadFileLines(cTestersFile); -end; - -function TV1DBMetaFiles.Version: string; -begin - Result := '1'; -end; - -{ TV2DBMetaFiles } - -function TV2DBMetaFiles.AreAllFilesPresent: Boolean; -begin - Result := DBFileExists(cVersionFile) - and DBFileExists(cLicenseFile) - and DBFileExists(cLicenseInfoFile) - and DBFileExists(cContributorsFile) - and DBFileExists(cTestersFile); -end; - -function TV2DBMetaFiles.Contributors: TStringDynArray; -begin - Result := ReadFileLines(cContributorsFile); -end; - -function TV2DBMetaFiles.LicenseInfo: TStringDynArray; -begin - Result := ReadFileLines(cLicenseInfoFile); -end; - -function TV2DBMetaFiles.LicenseText: string; -begin - Result := StrTrimRight(ReadFileText(cLicenseFile)); -end; - -function TV2DBMetaFiles.Testers: TStringDynArray; -begin - Result := ReadFileLines(cTestersFile); -end; - -function TV2DBMetaFiles.Version: string; -begin - Result := StrTrim(ReadFileText(cVersionFile)); -end; - -{ TLaterDBMetaFiles } - -function TLaterDBMetaFiles.AreAllFilesPresent: Boolean; -resourcestring - sNotSupportedError = 'Calling %s.AreAllFilesPresent is not supported for an ' - + 'unsupported database format'; -begin - raise ENotSupportedException.CreateFmt(sNotSupportedError, [ClassName]); -end; - -function TLaterDBMetaFiles.Contributors: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TLaterDBMetaFiles.LicenseInfo: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TLaterDBMetaFiles.LicenseText: string; -begin - Result := ''; -end; - -function TLaterDBMetaFiles.Testers: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TLaterDBMetaFiles.Version: string; -begin - Result := StrTrim(ReadFileText(cVersionFile)); -end; - -{ TUnknownOrMissingMetaFiles } - -function TUnknownOrMissingMetaFiles.AreAllFilesPresent: Boolean; -resourcestring - sNotSupportedError = 'Calling %s.AreAllFilesPresent is not supported for an ' - + 'unrecognised database format or missing database'; -begin - raise ENotSupportedException.CreateFmt(sNotSupportedError, [ClassName]); -end; - -function TUnknownOrMissingMetaFiles.Contributors: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TUnknownOrMissingMetaFiles.LicenseInfo: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TUnknownOrMissingMetaFiles.LicenseText: string; -begin - Result := ''; -end; - -function TUnknownOrMissingMetaFiles.Testers: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TUnknownOrMissingMetaFiles.Version: string; -begin - Result := ''; -end; - -{ TDBMetaFilesFactory } - -class function TDBMetaFilesFactory.GetInstance(const DBDir: string): - TDBMetaFiles; -var - VersionFile: string; - VersionStr: string; - Version: TVersionNumber; - DBPath: string; -begin - if not TDirectory.Exists(ExcludeTrailingPathDelimiter(DBDir)) then - // Database is not installed - Exit(TUnknownOrMissingMetaFiles.Create(DBDir)); - - DBPath := IncludeTrailingPathDelimiter(DBDir); - - // Check if VERSION file exists: - // Yes: - // either: version is invalid - database format unknown - // or: version is 2.x.x.x - database format v2 recognised - // or: version is >2 - database format recognised but not supported - // No: - // either: expected v1 meta files exist - database format v1 recognised - // or: no v1 meta files - database format unknown - VersionFile := DBPath + TDBMetaFileNames.VersionV2AndLater; - if TFile.Exists(VersionFile, False) then - begin - VersionStr := TFileIO.ReadAllText(VersionFile, TEncoding.UTF8, True); - if not TVersionNumber.TryStrToVersionNumber(VersionStr, Version) then - Result := TUnknownOrMissingMetaFiles.Create(DBDir) - else if Version.V1 = 2 then - Result := TV2DBMetaFiles.Create(DBDir) - else - Result := TLaterDBMetaFiles.Create(DBDir); - end - else - begin - if TFile.Exists(DBPath + TDBMetaFileNames.ContributorsV1, False) - and TFile.Exists(DBPath + TDBMetaFileNames.TestersV1, False) then - Result := TV1DBMetaFiles.Create(DBDir) - else - Result := TUnknownOrMissingMetaFiles.Create(DBDir); - end; -end; - { TDBLicenseInfo } constructor TDBLicenseInfo.Create(const AName, ASPDX, AURL, AText: string); diff --git a/Src/DBIO.MetaData.DCSC.pas b/Src/DBIO.MetaData.DCSC.pas new file mode 100644 index 000000000..984f00cc0 --- /dev/null +++ b/Src/DBIO.MetaData.DCSC.pas @@ -0,0 +1,830 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). + * + * Loads and vaildates meta data supported by the DelphiDabbler Code Snippets + * Collection. +} + + +unit DBIO.MetaData.DCSC; + +interface + +{ + Notes About Database Versions And Meta Files. + ============================================= + + Versions + -------- + + v1 of the Code Snippets Database was not considered to have a version number + until the arrival of v2. Therefore v1 did not have any means of identifying + its version number. Although the database format changed slightly over time + there is not enough historical information to identify different minor + releases, so all are considered to be v1.0.0.0 + + Database v2 has a VERSION file that specifies the version number as a dotted + quad, of the form v2.0.0.0. + + Note that semantic versioning is now being used so any database with major + version 2 will be backwards compatible with earlier v2 minor release. + + If a breaking change is introduced the major version will be bumped to v3 and + so on. + + Meta Files + ---------- + + Database v1 had only two meta files: + + contrib.txt - lists of contributors to the database, one per line + + testers.txt - lists of database testers, one per line + If those two files are present the database is assumed to be v1 + + Database v2 has the following meta files: + + VERSION - version number (v2.x.x.x) + + CONTRIBUTORS - lists of contributors to the database, one per line + + TESTERS - lists of database testers, one per line + + LICENSE - full text of the license that applies to the snippets + + LICENSE-INFO - furter information about the license + + For database v1 the license text, license information are hard-wired in the + absence of meta files. As noted above the version number is deduced. + + File encoding + ------------- + + All meta files are plain text. + + Early v1 database meta files were encoded in the system default encoding. + Later v1 databases encoded meta files in UTF-8. To distinguish between UTF-8 + and default encoded files the UTF-8 files use the UTF-8 preamble (BOM). + + v2 database meta files are all encoded in UTF-8 with preamble (BOM). + + Future major versions + --------------------- + + Future major database releases MUST include backwards compatibility with + earlier versions of CodeSnip in as much as those versions must be able to + easily detect and reject the format. + + To achieve this new major releases MUST include a VERSION file encoded in + UTF-8 with BOM. Existing code can detect and will reject any unsupported + version. + + CodeSnip support + ---------------- + + CodeSnip versions earlier than v4.16 are only ever delivered v1 database files + via their built in web update code. There is no way for these versions to + access v2 databases. + + CodeSnip from v4.16 get their main snippets database from files downloaded + manually. All such databases are v2. CodeSnip v4.16 also supports v1 format + because such a database may be resident on the user's computer at install + time. +} + + + +uses + // Project + SysUtils, + Types, + // VCL + DB.UMetaData, + UIStringList, + UStructs, + UVersionInfo; + + +const + DBValidVersions: TRange = (Min: 1; Max: 2); + +type + + /// Provides names of meta data files supported by various database + /// versions. + TDBMetaFileNames = record + public + const + ContributorsV1 = 'contrib.txt'; + TestersV1 = 'testers.txt'; + VersionV2AndLater = 'VERSION'; + LicenseV2 = 'LICENSE'; + LicenseInfoV2 = 'LICENSE-INFO'; + ContributorsV2 = 'CONTRIBUTORS'; + TestersV2 = 'TESTERS'; + end; + + /// Abstract base class for classes that access or emulate database + /// meta data files. + TDBMetaFiles = class abstract(TObject) + strict private + var + /// Directory of database for which meta data files are being + /// accessed. + fDBDir: string; + /// Returns encoding used by given meta file. + function GetFileEncoding(const FileName: TFileName): TEncoding; + strict protected + /// Makes a fully specified path to a given database file. + /// + /// FileName must contain no path information. + function MakePath(const FileName: string): string; + /// Checks if a given file exists in database directory. + function DBFileExists(const FileName: string): Boolean; + /// Reads all lines from given file and returns them as an array. + /// + /// FileName must contain no path information. + function ReadFileLines(const FileName: TFileName): TStringDynArray; + /// Reads all text from given file and returns it. + /// FileName must contain no path information. + function ReadFileText(const FileName: TFileName): string; + public + /// Constructs object that accesses meta data database files in + /// given directory. + constructor Create(const DBDir: string); + /// Returns text of the version file, or surrogate value. + /// + function Version: string; virtual; abstract; + /// Returns content license text file or surrogate value. + /// + function LicenseText: string; virtual; abstract; + /// Returns lines of license information file or surrogate value. + /// + function LicenseInfo: TStringDynArray; virtual; abstract; + /// Returns lines of contributors file or surrogate value. + /// + function Contributors: TStringDynArray; virtual; abstract; + /// Returns lines of testers file or surrogate value. + function Testers: TStringDynArray; virtual; abstract; + /// Checks if all the expected meta files are present. Returns + /// True if so or False if not. + /// ENotSupportedException must be raised if called on an + /// unsupported database version. + function AreAllFilesPresent: Boolean; virtual; abstract; + end; + + /// Class that accesses content of version 1 main database meta data + /// files. + /// Not all meta files are present in version main databases so + /// invariant placeholder content is provided to substitute for missing + /// files. + TV1DBMetaFiles = class sealed(TDBMetaFiles) + strict private + const + cContributorsFile = TDBMetaFileNames.ContributorsV1; + cTestersFile = TDBMetaFileNames.TestersV1; + public + /// Returns an surrogate, invariant value of 1 for the version + /// number. + /// No version file exists for this database version. The value + /// returned is deduced using documentation from the current code snippets + /// database project. + function Version: string; override; + /// Returns an surrogate, invariant value for the license text. + /// + /// No license text file exists for this database version. The + /// value returned is based on documentation of the database. + function LicenseText: string; override; + /// Returns an surrogate, invariant value for the lines of license + /// information. + function LicenseInfo: TStringDynArray; override; + /// Returns the lines of the contributors file. + function Contributors: TStringDynArray; override; + /// Returns the lines of the testers file. + function Testers: TStringDynArray; override; + /// Checks if all the expected meta files are present. Returns + /// True if so or False if not. + function AreAllFilesPresent: Boolean; override; + end; + + /// Class that accesses content of supported version 2 main database + /// meta files. + TV2DBMetaFiles = class sealed(TDBMetaFiles) + strict private + const + cVersionFile = TDBMetaFileNames.VersionV2AndLater; + cLicenseFile = TDBMetaFileNames.LicenseV2; + cLicenseInfoFile = TDBMetaFileNames.LicenseInfoV2; + cContributorsFile = TDBMetaFileNames.ContributorsV2; + cTestersFile = TDBMetaFileNames.TestersV2; + public + /// Returns the contents of the version file. + function Version: string; override; + /// Returns the contents of the license text file. + function LicenseText: string; override; + /// Returns the lines of the license info file. + function LicenseInfo: TStringDynArray; override; + /// Returns the lines of the contributors file. + function Contributors: TStringDynArray; override; + /// Returns the lines of the testers file. + function Testers: TStringDynArray; override; + /// Checks if all the expected meta files are present. Returns + /// True if so or False if not. + function AreAllFilesPresent: Boolean; override; + end; + + /// Class that represents later versions of database meta file + /// formats. + /// These formats have a valid version file but the version is not + /// supported and nothing is known about any other meta data files. + TLaterDBMetaFiles = class sealed(TDBMetaFiles) + strict private + const + cVersionFile = TDBMetaFileNames.VersionV2AndLater; + public + /// Returns the contents of the version file. + function Version: string; override; + /// Returns the empty string. + /// The file format is unknown, so the license text file cannot be + /// read and there is no information to deduce the value. + function LicenseText: string; override; + /// Returns an empty string array. + /// The file format is unknown, so the license information file + /// cannot be read and there is no information to deduce the value. + /// + function LicenseInfo: TStringDynArray; override; + /// Returns an empty string array. + /// The file format is unknown, so the contributors file cannot be + /// read and there is no information to deduce the value. + function Contributors: TStringDynArray; override; + /// Returns an empty string array. + /// The file format is unknown, so the testers file cannot be read + /// and there is no information to deduce the value. + function Testers: TStringDynArray; override; + /// Checks if all the expected meta files are present only if + /// the meta files come from a supported database format. + /// ENotSupportedException always raised since there is no way + /// of knowing what files should be present in an unsupported database + /// format. + function AreAllFilesPresent: Boolean; override; + end; + + /// Class that is present to represent unknown database meta file + /// formats. Also used when database is not present. + /// Accesses no files and returns null results for all methods + /// except IsVersionSupported. + TUnknownOrMissingMetaFiles = class sealed(TDBMetaFiles) + public + /// Returns the empty string. + /// The file format is unknown, so the version file cannot be read + /// and there is no information to deduce the value. + function Version: string; override; + /// Returns the empty string. + /// The file format is unknown, so the license text file cannot be + /// read and there is no information to deduce the value. + function LicenseText: string; override; + /// Returns an empty string array. + /// The file format is unknown, so the license information file + /// cannot be read and there is no information to deduce the value. + /// + function LicenseInfo: TStringDynArray; override; + /// Returns an empty string array. + /// The file format is unknown, so the contributors file cannot be + /// read and there is no information to deduce the value. + function Contributors: TStringDynArray; override; + /// Returns an empty string array. + /// The file format is unknown, so the testers file cannot be read + /// and there is no information to deduce the value. + function Testers: TStringDynArray; override; + /// Checks if all the expected meta files are present only if + /// the meta files come from a supported database format. + /// ENotSupportedException always raised since there is no way + /// of knowing what files should be present in an unrecognised database + /// format. + function AreAllFilesPresent: Boolean; override; + end; + + /// Factory to create the correct instance of database meta file + /// classes that can read the version of a database in a given folder. + /// + TDBMetaFilesFactory = record + public + class function GetInstance(const DBDir: string): TDBMetaFiles; + static; + end; + + /// Abstract base class for classes that provide main database meta + /// data. + TAbstractMainDBMetaData = class abstract(TInterfacedObject) + strict private + var + fMetaFiles: TDBMetaFiles; + fIsVersionLoaded: Boolean; + fVersion: TVersionNumber; + fIsLicenseAndCopyrightInfoLoaded: Boolean; + fLicenseInfo: TDBLicenseInfo; + fCopyrightInfo: TDBCopyrightInfo; + fContributors: IStringList; + fTesters: IStringList; + + procedure LoadLicenseAndCopyrightInfo; + + strict protected + function GetDBDir: string; virtual; abstract; + public + procedure AfterConstruction; override; + destructor Destroy; override; + /// Returns database version number. + /// + /// A null version number is returned if the meta data does not come + /// from a recognised database. + /// Method of IDBMetaData. + /// + function GetVersion: TVersionNumber; + /// Returns database license information. + /// + /// Return value is meaningless if the meta data does not come + /// from a supported database. + /// Method of IDBMetaData. + /// + function GetLicenseInfo: TDBLicenseInfo; + /// Returns database copyright informatiom. + /// + /// Return value is meaningless if the meta data does not come + /// from a supported database. + /// Method of IDBMetaData. + /// + function GetCopyrightInfo: TDBCopyrightInfo; + /// Returns list of contributors to database. + /// + /// Return value is meaningless if the meta data does not come + /// from a supported database. + /// Method of IDBMetaData. + /// + function GetContributors: IStringList; + /// Returns list of testers of database. + /// + /// Return value is meaningless if the meta data does not come + /// from a supported database. + /// Method of IDBMetaData. + /// + function GetTesters: IStringList; + /// Checks if meta data is recognised as belonging to a valid + /// database, whether supported or not. + /// Method of IDBMetaData. + function IsRecognised: Boolean; + /// Checks if meta data is recognised as belonging to a supported + /// database version. + /// Method of IDBMetaData. + function IsSupportedVersion: Boolean; + /// Checks if meta data is corrupt. + /// + /// Should only be called if meta data belongs to a supported + /// database. + /// Method of IDBMetaData. + /// + /// ENotSupportedException raised if called on an unsupported + /// database. + function IsCorrupt: Boolean; + /// Refreshes the meta information by re-reading from database + /// meta files. + /// Method of IDBMetaData. + procedure Refresh; + end; + + /// Class that provides meta data for the main database. + TMainDBMetaData = class sealed(TAbstractMainDBMetaData, IDBMetaData) + strict protected + function GetDBDir: string; override; + end; + + /// Class that provides meta data for update database directories. + /// + TUpdateDBMetaData = class sealed(TAbstractMainDBMetaData, IDBMetaData) + strict private + var + fUpdateDir: string; + strict protected + function GetDBDir: string; override; + public + constructor Create(const UpdateDir: string); + end; + + /// Factory that creates instances of objects that provide + /// information about the main database and database updates. + TMainDBMetaDataFactory = record + public + /// Returns instance of class that provides meta data for the + /// main database. + class function MainDBMetaDataInstance: IDBMetaData; static; + /// Returns instance of class that provides meta data for the + /// database update stored in the given folder. + class function UpdateMetaDataInstance(const UpdateDir: string): + IDBMetaData; static; + end; + +implementation + +uses + // Project + Classes, + IOUtils, + // VCL + UAppInfo, + UEncodings, + UIOUtils, + UResourceUtils, + UStrUtils; + +{ TMainDBMetaDataFactory } + +class function TMainDBMetaDataFactory.MainDBMetaDataInstance: + IDBMetaData; +begin + Result := TMainDBMetaData.Create; +end; + +class function TMainDBMetaDataFactory.UpdateMetaDataInstance( + const UpdateDir: string): IDBMetaData; +begin + Result := TUpdateDBMetaData.Create(UpdateDir); +end; + +{ TAbstractMainDBMetaData } + +procedure TAbstractMainDBMetaData.AfterConstruction; +begin + inherited; + Refresh; +end; + +destructor TAbstractMainDBMetaData.Destroy; +begin + fMetaFiles.Free; + inherited; +end; + +function TAbstractMainDBMetaData.GetContributors: IStringList; +begin + if not Assigned(fContributors) then + fContributors := TIStringList.Create(fMetaFiles.Contributors); + Result := fContributors; +end; + +function TAbstractMainDBMetaData.GetCopyrightInfo: TDBCopyrightInfo; +begin + if not fIsLicenseAndCopyrightInfoLoaded then + LoadLicenseAndCopyrightInfo; + Result := fCopyrightInfo; +end; + +function TAbstractMainDBMetaData.GetLicenseInfo: TDBLicenseInfo; +begin + if not fIsLicenseAndCopyrightInfoLoaded then + LoadLicenseAndCopyrightInfo; + Result := fLicenseInfo; +end; + +function TAbstractMainDBMetaData.GetTesters: IStringList; +begin + if not Assigned(fTesters) then + fTesters := TIStringList.Create(fMetaFiles.Testers); + Result := fTesters; +end; + +function TAbstractMainDBMetaData.GetVersion: TVersionNumber; +begin + if not fIsVersionLoaded then + begin + if not TVersionNumber.TryStrToVersionNumber( + StrTrim(fMetaFiles.Version), fVersion + ) then + fVersion := TVersionNumber.Nul; + end; + fIsVersionLoaded := True; + Result := fVersion; +end; + +function TAbstractMainDBMetaData.IsCorrupt: Boolean; +resourcestring + sNotSupportedError = 'Can''t call IDBMetaData.IsCorrupt for an unsupported ' + + 'database version'; +begin + if not IsSupportedVersion then + raise ENotSupportedException.Create(sNotSupportedError); + Result := not fMetaFiles.AreAllFilesPresent; +end; + +function TAbstractMainDBMetaData.IsRecognised: Boolean; +begin + Result := not GetVersion.IsNull; +end; + +function TAbstractMainDBMetaData.IsSupportedVersion: Boolean; +var + ThisVersion: TVersionNumber; +begin + ThisVersion := GetVersion; + Result := DBValidVersions.Contains(ThisVersion.V1); +end; + +procedure TAbstractMainDBMetaData.LoadLicenseAndCopyrightInfo; +var + SL: TStringList; +begin + if fIsLicenseAndCopyrightInfoLoaded then + Exit; + SL := TStringList.Create; + try + StrArrayToStrList(fMetaFiles.LicenseInfo, SL); + fLicenseInfo := TDBLicenseInfo.Create( + SL.Values['LicenseName'], + SL.Values['LicenseSPDX'], + SL.Values['LicenseURL'], + fMetaFiles.LicenseText + ); + fCopyrightInfo := TDBCopyrightInfo.Create( + SL.Values['CopyrightDate'], + SL.Values['CopyrightHolder'], + SL.Values['CopyrightHolderURL'] + ); + finally + SL.Free; + end; + fIsLicenseAndCopyrightInfoLoaded := True; +end; + +procedure TAbstractMainDBMetaData.Refresh; +begin + FreeAndNil(fMetaFiles); + fMetaFiles := TDBMetaFilesFactory.GetInstance(GetDBDir); + fIsVersionLoaded := False; + fIsLicenseAndCopyrightInfoLoaded := False; + fContributors := nil; + fTesters := nil; +end; + +{ TMainDBMetaData } + +function TMainDBMetaData.GetDBDir: string; +begin + Result := TAppInfo.AppDataDir; +end; + +{ TUpdateDBMetaData } + +constructor TUpdateDBMetaData.Create(const UpdateDir: string); +begin + inherited Create; + fUpdateDir := ExcludeTrailingPathDelimiter(UpdateDir); +end; + +function TUpdateDBMetaData.GetDBDir: string; +begin + Result := fUpdateDir; +end; + +{ TDBMetaFiles } + +constructor TDBMetaFiles.Create(const DBDir: string); +begin + inherited Create; + fDBDir := DBDir; +end; + +function TDBMetaFiles.DBFileExists(const FileName: string): Boolean; +begin + Result := TFile.Exists(MakePath(FileName), False); +end; + +function TDBMetaFiles.GetFileEncoding(const FileName: TFileName): TEncoding; +begin + // Old v1 database meta files may be in the system default encodings, v1 and + // all v2 and later use UTF-8 with BOM. + if TFileIO.CheckBOM(MakePath(FileName), TEncoding.UTF8) then + Result := TEncoding.UTF8 + else + Result := TEncoding.Default; +end; + +function TDBMetaFiles.MakePath(const FileName: string): string; +begin + Assert(not StrContainsStr(PathDelim, FileName), + ClassName + '.MakePath: FileName must be a base file name.'); + Result := IncludeTrailingPathDelimiter(fDBDir) + FileName; +end; + +function TDBMetaFiles.ReadFileLines(const FileName: TFileName): TStringDynArray; +var + Encoding: TEncoding; +begin + if not DBFileExists(FileName) then + begin + SetLength(Result, 0); + Exit; + end; + Encoding := GetFileEncoding(FileName); + try + Result := TFileIO.ReadAllLines(MakePath(FileName), Encoding, True); + finally + TEncodingHelper.FreeEncoding(Encoding); + end; +end; + +function TDBMetaFiles.ReadFileText(const FileName: TFileName): string; +begin + if not DBFileExists(FileName) then + Exit(''); + Result := TFileIO.ReadAllText( + MakePath(FileName), GetFileEncoding(FileName), True + ); +end; + +{ TV1DBMetaFiles } + +function TV1DBMetaFiles.AreAllFilesPresent: Boolean; +begin + Result := DBFileExists(cContributorsFile) and DBFileExists(cTestersFile); +end; + +function TV1DBMetaFiles.Contributors: TStringDynArray; +begin + Result := ReadFileLines(cContributorsFile) +end; + +function TV1DBMetaFiles.LicenseInfo: TStringDynArray; +begin + Result := TStringDynArray.Create( + 'LicenseName=MIT License', + 'LicenseSPDX=MIT', + 'LicenseURL=https://opensource.org/licenses/MIT', + 'CopyrightDate=2005-2016', + 'CopyrightHolder=Peter Johnson & Contributors', + 'CopyrightHolderURL=https://gravatar.com/delphidabbler' + ); +end; + +function TV1DBMetaFiles.LicenseText: string; +begin + Result := LoadResourceAsString(HInstance, 'CSDBLICENSE', RT_RCDATA, etUTF8); +end; + +function TV1DBMetaFiles.Testers: TStringDynArray; +begin + Result := ReadFileLines(cTestersFile); +end; + +function TV1DBMetaFiles.Version: string; +begin + Result := '1'; +end; + +{ TV2DBMetaFiles } + +function TV2DBMetaFiles.AreAllFilesPresent: Boolean; +begin + Result := DBFileExists(cVersionFile) + and DBFileExists(cLicenseFile) + and DBFileExists(cLicenseInfoFile) + and DBFileExists(cContributorsFile) + and DBFileExists(cTestersFile); +end; + +function TV2DBMetaFiles.Contributors: TStringDynArray; +begin + Result := ReadFileLines(cContributorsFile); +end; + +function TV2DBMetaFiles.LicenseInfo: TStringDynArray; +begin + Result := ReadFileLines(cLicenseInfoFile); +end; + +function TV2DBMetaFiles.LicenseText: string; +begin + Result := StrTrimRight(ReadFileText(cLicenseFile)); +end; + +function TV2DBMetaFiles.Testers: TStringDynArray; +begin + Result := ReadFileLines(cTestersFile); +end; + +function TV2DBMetaFiles.Version: string; +begin + Result := StrTrim(ReadFileText(cVersionFile)); +end; + +{ TLaterDBMetaFiles } + +function TLaterDBMetaFiles.AreAllFilesPresent: Boolean; +resourcestring + sNotSupportedError = 'Calling %s.AreAllFilesPresent is not supported for an ' + + 'unsupported database format'; +begin + raise ENotSupportedException.CreateFmt(sNotSupportedError, [ClassName]); +end; + +function TLaterDBMetaFiles.Contributors: TStringDynArray; +begin + SetLength(Result, 0); +end; + +function TLaterDBMetaFiles.LicenseInfo: TStringDynArray; +begin + SetLength(Result, 0); +end; + +function TLaterDBMetaFiles.LicenseText: string; +begin + Result := ''; +end; + +function TLaterDBMetaFiles.Testers: TStringDynArray; +begin + SetLength(Result, 0); +end; + +function TLaterDBMetaFiles.Version: string; +begin + Result := StrTrim(ReadFileText(cVersionFile)); +end; + +{ TUnknownOrMissingMetaFiles } + +function TUnknownOrMissingMetaFiles.AreAllFilesPresent: Boolean; +resourcestring + sNotSupportedError = 'Calling %s.AreAllFilesPresent is not supported for an ' + + 'unrecognised database format or missing database'; +begin + raise ENotSupportedException.CreateFmt(sNotSupportedError, [ClassName]); +end; + +function TUnknownOrMissingMetaFiles.Contributors: TStringDynArray; +begin + SetLength(Result, 0); +end; + +function TUnknownOrMissingMetaFiles.LicenseInfo: TStringDynArray; +begin + SetLength(Result, 0); +end; + +function TUnknownOrMissingMetaFiles.LicenseText: string; +begin + Result := ''; +end; + +function TUnknownOrMissingMetaFiles.Testers: TStringDynArray; +begin + SetLength(Result, 0); +end; + +function TUnknownOrMissingMetaFiles.Version: string; +begin + Result := ''; +end; + +{ TDBMetaFilesFactory } + +class function TDBMetaFilesFactory.GetInstance(const DBDir: string): + TDBMetaFiles; +var + VersionFile: string; + VersionStr: string; + Version: TVersionNumber; + DBPath: string; +begin + if not TDirectory.Exists(ExcludeTrailingPathDelimiter(DBDir)) then + // Database is not installed + Exit(TUnknownOrMissingMetaFiles.Create(DBDir)); + + DBPath := IncludeTrailingPathDelimiter(DBDir); + + // Check if VERSION file exists: + // Yes: + // either: version is invalid - database format unknown + // or: version is 2.x.x.x - database format v2 recognised + // or: version is >2 - database format recognised but not supported + // No: + // either: expected v1 meta files exist - database format v1 recognised + // or: no v1 meta files - database format unknown + VersionFile := DBPath + TDBMetaFileNames.VersionV2AndLater; + if TFile.Exists(VersionFile, False) then + begin + VersionStr := TFileIO.ReadAllText(VersionFile, TEncoding.UTF8, True); + if not TVersionNumber.TryStrToVersionNumber(VersionStr, Version) then + Result := TUnknownOrMissingMetaFiles.Create(DBDir) + else if Version.V1 = 2 then + Result := TV2DBMetaFiles.Create(DBDir) + else + Result := TLaterDBMetaFiles.Create(DBDir); + end + else + begin + if TFile.Exists(DBPath + TDBMetaFileNames.ContributorsV1, False) + and TFile.Exists(DBPath + TDBMetaFileNames.TestersV1, False) then + Result := TV1DBMetaFiles.Create(DBDir) + else + Result := TUnknownOrMissingMetaFiles.Create(DBDir); + end; +end; + +end. diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index 22b0eb8a0..a15bbd236 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -181,6 +181,7 @@ implementation // Project DB.UCollections, DB.UMain, + DBIO.MetaData.DCSC, FmEasterEgg, FmPreviewDlg, UAppInfo, diff --git a/Src/UDBUpdateMgr.pas b/Src/UDBUpdateMgr.pas index 3cf1df472..f5f23bd4c 100644 --- a/Src/UDBUpdateMgr.pas +++ b/Src/UDBUpdateMgr.pas @@ -100,6 +100,7 @@ implementation IOUtils, // Project DB.UMetaData, + DBIO.MetaData.DCSC, UAppInfo, UFileUpdater, UStrUtils, diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index eb6c2f9d7..ca02bd04f 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -98,6 +98,7 @@ implementation // Project DB.UCollections, DB.UMetaData, + DBIO.MetaData.DCSC, UAppInfo, UConsts, UUrl, diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index 7d9e9763b..97ab36023 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -121,6 +121,7 @@ implementation DB.UMain, DB.UMetaData, DB.USnippetKind, + DBIO.MetaData.DCSC, UStrUtils, UUrl; diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index d0bcd3721..c3855ae64 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -91,6 +91,7 @@ implementation DB.UMetaData, DB.USnippet, DB.USnippetKind, + DBIO.MetaData.DCSC, UConsts, UAppInfo, UQuery, From 4ffa638b0adef03f6fea5dca0fa016332e5d1da8 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 16 Nov 2024 10:40:12 +0000 Subject: [PATCH 096/222] Add new IDBMetaData.GetCapabilities method This new method returns a set of capabilities (TMetaDataCapabilities) that describe the types of meta data supported by the collection. Classes DBIO.MetaData.DCSC implemented of the new method by returning a set of all capabilities. --- Src/DB.UMetaData.pas | 13 +++++++++++++ Src/DBIO.MetaData.DCSC.pas | 10 ++++++++++ 2 files changed, 23 insertions(+) diff --git a/Src/DB.UMetaData.pas b/Src/DB.UMetaData.pas index 8e4b69cf3..b2c037dae 100644 --- a/Src/DB.UMetaData.pas +++ b/Src/DB.UMetaData.pas @@ -24,6 +24,16 @@ interface type + TMetaDataCapability = ( + mdcVersion, + mdcLicense, + mdcCopyright, + mdcContributors, + mdcTesters + ); + + TMetaDataCapabilities = set of TMetaDataCapability; + /// Record providing information about a collection's license. /// TDBLicenseInfo = record @@ -80,6 +90,9 @@ TDBCopyrightInfo = record /// Interface that provides information about any meta data /// supported by a collection. IDBMetaData = interface(IInterface) + /// Returns information about what, if any, meta data is supported + /// by a collection. + function GetCapabilities: TMetaDataCapabilities; /// Returns the collection's version number. /// A null version number is returned if the collection does not /// include Version in its capabilities. diff --git a/Src/DBIO.MetaData.DCSC.pas b/Src/DBIO.MetaData.DCSC.pas index 984f00cc0..933554f3e 100644 --- a/Src/DBIO.MetaData.DCSC.pas +++ b/Src/DBIO.MetaData.DCSC.pas @@ -14,6 +14,8 @@ interface +{TODO -cVault: Remove support for main database v1 (and perhaps v>2)} + { Notes About Database Versions And Meta Files. ============================================= @@ -331,6 +333,9 @@ TAbstractMainDBMetaData = class abstract(TInterfacedObject) public procedure AfterConstruction; override; destructor Destroy; override; + /// Returns information about what, if any, meta data is supported + /// by a collection. + function GetCapabilities: TMetaDataCapabilities; /// Returns database version number. /// /// A null version number is returned if the meta data does not come @@ -461,6 +466,11 @@ destructor TAbstractMainDBMetaData.Destroy; inherited; end; +function TAbstractMainDBMetaData.GetCapabilities: TMetaDataCapabilities; +begin + Result := [mdcVersion, mdcLicense, mdcCopyright, mdcContributors, mdcTesters]; +end; + function TAbstractMainDBMetaData.GetContributors: IStringList; begin if not Assigned(fContributors) then From 37c52abddc0fc333b9fb61276982b27ad6ecc312 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 16 Nov 2024 16:39:38 +0000 Subject: [PATCH 097/222] Add TCollection.TComparer class Added a new TComparer nested class to TCollection that implements IComparer and IEqualityComparer. This provides Compare, Equals and GetHashCode methods. All methods rely on TCollectionID comparisons and hashes. --- Src/DB.UCollections.pas | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index ae10638f1..f12ae768f 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -178,6 +178,17 @@ TCollection = record fLocation: TCollectionLocation; fCollectionFormatKind: TCollectionFormatKind; public + type + TComparer = class(TInterfacedObject, + IComparer, IEqualityComparer + ) + public + function Compare(const Left, Right: TCollection): Integer; + function Equals(const Left, Right: TCollection): Boolean; + reintroduce; + function GetHashCode(const Value: TCollection): Integer; + reintroduce; + end; /// Creates a collection record. /// TCollectionID [in] Unique ID of the /// collection. Must not be null. @@ -726,5 +737,22 @@ class function TCollectionFormatInfo.IndexOf( Exit(Idx); end; +{ TCollection.TComparer } + +function TCollection.TComparer.Compare(const Left, Right: TCollection): Integer; +begin + Result := TCollectionID.Compare(Left.UID, Right.UID); +end; + +function TCollection.TComparer.Equals(const Left, Right: TCollection): Boolean; +begin + Result := Left.UID = Right.UID; +end; + +function TCollection.TComparer.GetHashCode(const Value: TCollection): Integer; +begin + Result := Value.UID.Hash; +end; + end. From d54c34caa71971032e68156c629972cec546a26e Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 16 Nov 2024 16:52:23 +0000 Subject: [PATCH 098/222] Add new methods to license & copyright records Added new TDBLicenseInfo.CreateNull and TDBCopyrightInfo.CreateNull methods to create null version of each record, with all fields set to empty strings. Added new TDBCopyrightInfo.ToString method to return a string representation of all non-empty fields in the record. --- Src/DB.UMetaData.pas | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/Src/DB.UMetaData.pas b/Src/DB.UMetaData.pas index b2c037dae..630657a47 100644 --- a/Src/DB.UMetaData.pas +++ b/Src/DB.UMetaData.pas @@ -46,6 +46,9 @@ TDBLicenseInfo = record /// Record constructor: sets all fields of record. /// Any or all parameters may be the empty string constructor Create(const AName, ASPDX, AURL, AText: string); + /// Creates and returns a null record with all fields set to the + /// empty string. + class function CreateNull: TDBLicenseInfo; static; /// Name of license. property Name: string read fName; /// Open Source Initiative SPDX short idenitifier for licenses. @@ -76,6 +79,9 @@ TDBCopyrightInfo = record /// Record constructor: sets all fields of record. /// Any or all parameters may be the empty string constructor Create(const ADate, AHolder, AHolderURL: string); + /// Creates and returns a null record with all fields set to the + /// empty string. + class function CreateNull: TDBCopyrightInfo; static; /// Copyright date. /// May be a single year or a range: e.g. 2020 or 2012-2016. /// @@ -85,6 +91,9 @@ TDBCopyrightInfo = record /// URL of main copyright holder. /// Optional. property HolderURL: string read fHolderURL; + /// Creates and returns a string representation of all the + /// non-empty fields of the record. + function ToString: string; end; /// Interface that provides information about any meta data @@ -143,6 +152,11 @@ constructor TDBLicenseInfo.Create(const AName, ASPDX, AURL, AText: string); fText := AText; end; +class function TDBLicenseInfo.CreateNull: TDBLicenseInfo; +begin + Result := TDBLicenseInfo.Create('', '', '', ''); +end; + function TDBLicenseInfo.NameWithURL: string; begin Result := fName; @@ -159,4 +173,32 @@ constructor TDBCopyrightInfo.Create(const ADate, AHolder, AHolderURL: string); fHolderURL := AHolderURL; end; +class function TDBCopyrightInfo.CreateNull: TDBCopyrightInfo; +begin + Result := TDBCopyrightInfo.Create('', '', ''); +end; + +function TDBCopyrightInfo.ToString: string; +resourcestring + sCopyright = 'Copyright'; +begin + Result := ''; + if Date <> '' then + Result := Result + '(C) ' + Date; + if Holder <> '' then + begin + if Result <> '' then + Result := Result + ', '; + Result := Result + Holder; + end; + if HolderURL <> '' then + begin + if Result <> '' then + Result := Result + ', '; + Result := Result + HolderURL; + end; + if Result <> '' then + Result := sCopyright + ' ' + Result; +end; + end. From 26a9e9420b26b5f4d86b51a770824f1f7fe4cd89 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 16 Nov 2024 18:50:21 +0000 Subject: [PATCH 099/222] Add meta data factory class with registrar Added new TMetaDataFactory class to DB.UMetaData unit with method to create a meta data class appropriate to a given collection. Classes that interpret meta data for a specific collection format make themselves available to the factory by registering their class type with it for a specified collection data format. A new TNullMetaData class was added to provide a do-nothing meta data class that the factory creates whenever there is no registered class that provides meta data for a collection's data format. Updated DBIO.MetaData.DCSC unit to register a suitable class to provide meta data for the DelphiDabbler Code Snippets Collection data format. --- Src/DB.UMetaData.pas | 178 +++++++++++++++++++++++++++++++++++++ Src/DBIO.MetaData.DCSC.pas | 19 +++- 2 files changed, 196 insertions(+), 1 deletion(-) diff --git a/Src/DB.UMetaData.pas b/Src/DB.UMetaData.pas index 630657a47..af4eefb8f 100644 --- a/Src/DB.UMetaData.pas +++ b/Src/DB.UMetaData.pas @@ -17,7 +17,10 @@ interface uses + // Delphi + Generics.Collections, // Project + DB.UCollections, UIStringList, UVersionInfo; @@ -138,9 +141,99 @@ TDBCopyrightInfo = record procedure Refresh; end; + /// Base class for all classes that implement IDBMetaData + /// and can also be registered with TMetaDataFactory. + TRegisterableMetaData = class abstract(TInterfacedObject) + public + /// Creates an instance of a concrete descendant of this class. + /// + /// TCollection [in] Collection associated + /// with the meta data being created. + /// IDBMetaData. Required meta data object. + class function Instance(ACollection: TCollection): IDBMetaData; + virtual; abstract; + end; + + TRegisterableMetaDataClass = class of TRegisterableMetaData; + + /// Advanced record manages the registration and creation of meta + /// data objects for different collection data formats. + TMetaDataFactory = record + strict private + class var + /// Map of collection format kinds to functions that create + /// meta data objects of the required type. + fCallbackMap: TDictionary< + TCollectionFormatKind, TRegisterableMetaDataClass + >; + public + class constructor Create; + class destructor Destroy; + /// Registers a class type that can create a meta data object for + /// a given collection data format kind. + /// TCollectionFormatKind [in] Collection data + /// format for which the meta data class is being registered. + /// TRegisterableMetaDataClass [in] Type of + /// class to create. + class procedure RegisterCreator(AFormat: TCollectionFormatKind; + AClass: TRegisterableMetaDataClass); static; + /// Creates a meta data object instance that can read a given + /// collection data format. + /// TCollection [in] Collection for which + /// meta data reader object is required. + /// IDBMetaData. Requested object. May be a null object if + /// no meta data class was registered for the data format associated with + /// ACollection. + class function CreateInstance(const ACollection: TCollection): + IDBMetaData; static; + end; implementation +type + /// Implements a null, do nothing, meta data object. + /// Instance of this class are used when a collection format does + /// not support meta data. + TNullMetaData = class(TInterfacedObject, IDBMetaData) + public + /// Returns information about what, if any, meta data is supported + /// by a collection. + function GetCapabilities: TMetaDataCapabilities; + /// Returns the collection's version number. + /// A null version number is returned if the collection does not + /// include Version in its capabilities. + function GetVersion: TVersionNumber; + /// Returns the collection's license information. + /// Return value is meaningless if the collection does not include + /// License in its capabilities. + function GetLicenseInfo: TDBLicenseInfo; + /// Returns the collection's copyright informatiom. + /// Return value is meaningless if the collection does not include + /// Copyright in its capabilities. + function GetCopyrightInfo: TDBCopyrightInfo; + /// Returns a list of contributors to the collection. + /// Return value is meaningless if the collection does not include + /// Contributors in its capabilities. + function GetContributors: IStringList; + /// Returns a list of testers of the collection. + /// Return value is meaningless if the collection does not include + /// Testers in its capabilities. + function GetTesters: IStringList; + /// Checks if meta data is recognised as belonging to a valid + /// collection, whether supported or not. + function IsRecognised: Boolean; + /// Checks if meta data is recognised as belonging to a supported + /// collection version. + function IsSupportedVersion: Boolean; + /// Checks if meta data is corrupt. + /// Should only be called if meta data belongs to a supported + /// collection. An exception should be raised if called on unsupported + /// versions. + function IsCorrupt: Boolean; + /// Refreshes the meta information by re-reading from collection + /// meta files. + procedure Refresh; + end; { TDBLicenseInfo } @@ -201,4 +294,89 @@ function TDBCopyrightInfo.ToString: string; Result := sCopyright + ' ' + Result; end; +{ TMetaDataFactory } + +class constructor TMetaDataFactory.Create; +begin + fCallbackMap := TDictionary< + TCollectionFormatKind, TRegisterableMetaDataClass + >.Create; +end; + +class function TMetaDataFactory.CreateInstance(const ACollection: TCollection): + IDBMetaData; +begin + if fCallbackMap.ContainsKey(ACollection.CollectionFormatKind) then + Result := fCallbackMap[ACollection.CollectionFormatKind].Instance( + ACollection + ) + else + Result := TNullMetaData.Create; +end; + +class destructor TMetaDataFactory.Destroy; +begin + fCallBackMap.Free; +end; + +class procedure TMetaDataFactory.RegisterCreator( + AFormat: TCollectionFormatKind; AClass: TRegisterableMetaDataClass); +begin + fCallbackMap.AddOrSetValue(AFormat, AClass); +end; + +{ TNullMetaData } + +function TNullMetaData.GetCapabilities: TMetaDataCapabilities; +begin + Result := []; +end; + +function TNullMetaData.GetContributors: IStringList; +begin + Result := TIStringList.Create; +end; + +function TNullMetaData.GetCopyrightInfo: TDBCopyrightInfo; +begin + Result := TDBCopyrightInfo.CreateNull; +end; + +function TNullMetaData.GetLicenseInfo: TDBLicenseInfo; +begin + Result := TDBLicenseInfo.CreateNull; +end; + +function TNullMetaData.GetTesters: IStringList; +begin + Result := TIStringList.Create; +end; + +function TNullMetaData.GetVersion: TVersionNumber; +begin + Result := TVersionNumber.Nul; +end; + +function TNullMetaData.IsCorrupt: Boolean; +resourcestring + sNotSupportedError = 'Can''t call IDBMetaData.IsCorrupt for null meta data'; +begin + raise ENotSupportedException.Create(sNotSupportedError); +end; + +function TNullMetaData.IsRecognised: Boolean; +begin + Result := False; +end; + +function TNullMetaData.IsSupportedVersion: Boolean; +begin + Result := False; +end; + +procedure TNullMetaData.Refresh; +begin + // Do nothing +end; + end. diff --git a/Src/DBIO.MetaData.DCSC.pas b/Src/DBIO.MetaData.DCSC.pas index 933554f3e..205eaa738 100644 --- a/Src/DBIO.MetaData.DCSC.pas +++ b/Src/DBIO.MetaData.DCSC.pas @@ -98,6 +98,7 @@ interface SysUtils, Types, // VCL + DB.UCollections, DB.UMetaData, UIStringList, UStructs, @@ -314,7 +315,7 @@ TDBMetaFilesFactory = record /// Abstract base class for classes that provide main database meta /// data. - TAbstractMainDBMetaData = class abstract(TInterfacedObject) + TAbstractMainDBMetaData = class abstract(TRegisterableMetaData) strict private var fMetaFiles: TDBMetaFiles; @@ -331,6 +332,10 @@ TAbstractMainDBMetaData = class abstract(TInterfacedObject) strict protected function GetDBDir: string; virtual; abstract; public + /// Creates an instance of meta data object that can read this + /// collection's format. + /// Must be called from a concrete descendant class. + class function Instance(ACollection: TCollection): IDBMetaData; override; procedure AfterConstruction; override; destructor Destroy; override; /// Returns information about what, if any, meta data is supported @@ -512,6 +517,12 @@ function TAbstractMainDBMetaData.GetVersion: TVersionNumber; Result := fVersion; end; +class function TAbstractMainDBMetaData.Instance( + ACollection: DB.UCollections.TCollection): IDBMetaData; +begin + Result := TMainDBMetaDataFactory.MainDBMetaDataInstance; +end; + function TAbstractMainDBMetaData.IsCorrupt: Boolean; resourcestring sNotSupportedError = 'Can''t call IDBMetaData.IsCorrupt for an unsupported ' @@ -837,4 +848,10 @@ class function TDBMetaFilesFactory.GetInstance(const DBDir: string): end; end; +initialization + +TMetaDataFactory.RegisterCreator( + TCollectionFormatKind.DCSC_v2, TMainDBMetaData +); + end. From 0dbf89515d2bdd2c79cf816ebd667dcd669390ce Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 16 Nov 2024 19:37:44 +0000 Subject: [PATCH 100/222] Update snippet docs code re revised meta data Modified the information that TSnippetDoc and descendants write to the generated documents to work with the recent changes to how meta data works with collections. Information is now written about all collections rather than just the "main database". License information is now for any collection whose data format supports it. Some methods in TSnippetDoc were renamed along with their implementation in descended classes. --- Src/URTFSnippetDoc.pas | 27 +++++++++++----------- Src/USnippetDoc.pas | 50 ++++++++++++++++++++--------------------- Src/UTextSnippetDoc.pas | 17 +++++++------- 3 files changed, 46 insertions(+), 48 deletions(-) diff --git a/Src/URTFSnippetDoc.pas b/Src/URTFSnippetDoc.pas index 3c560586d..73afd5899 100644 --- a/Src/URTFSnippetDoc.pas +++ b/Src/URTFSnippetDoc.pas @@ -107,9 +107,8 @@ TRTFSnippetDoc = class(TSnippetDoc) /// Active text formatting is observed and styled to suit /// document. procedure RenderExtra(const ExtraText: IActiveText); override; - /// Adds given information about code snippets database to - /// document. - procedure RenderDBInfo(const Text: string); override; + /// Output given information about a collection. + procedure RenderCollectionInfo(const Text: string); override; /// Finalises document and returns content as encoded data. /// function FinaliseDoc: TEncodedData; override; @@ -321,6 +320,17 @@ procedure TRTFSnippetDoc.InitStyles; end; end; +procedure TRTFSnippetDoc.RenderCollectionInfo(const Text: string); +begin + fBuilder.SetParaSpacing(TRTFParaSpacing.Create(ParaSpacing, 0.0)); + fBuilder.SetFontSize(DBInfoFontSize); + fBuilder.SetFontStyle([fsItalic]); + fBuilder.AddText(Text); + fBuilder.EndPara; + fBuilder.ClearParaFormatting; + fBuilder.ResetCharStyle; +end; + procedure TRTFSnippetDoc.RenderCompilerInfo(const Heading: string; const Info: TCompileDocInfoArray); @@ -376,17 +386,6 @@ procedure TRTFSnippetDoc.RenderCompilerInfo(const Heading: string; end; end; -procedure TRTFSnippetDoc.RenderDBInfo(const Text: string); -begin - fBuilder.SetParaSpacing(TRTFParaSpacing.Create(ParaSpacing, 0.0)); - fBuilder.SetFontSize(DBInfoFontSize); - fBuilder.SetFontStyle([fsItalic]); - fBuilder.AddText(Text); - fBuilder.EndPara; - fBuilder.ClearParaFormatting; - fBuilder.ResetCharStyle; -end; - procedure TRTFSnippetDoc.RenderDescription(const Desc: IActiveText); var RTFWriter: TActiveTextRTF; // Object that generates RTF from active text diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index 97ab36023..765543073 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -54,8 +54,10 @@ TSnippetDoc = class(TObject) /// information for given snippet. function CompilerInfo(const Snippet: TSnippet): TCompileDocInfoArray; /// Generates and returns a string containing information about - /// the main database. - function MainDBInfo: string; + /// the given collection. + /// Information includes license and copyright information if + /// the collection's data format supports it. + function CollectionInfo(const ACollectionID: TCollectionID): string; strict protected /// Initialise document. /// Does nothing. Descendant classes should perform any required @@ -90,9 +92,8 @@ TSnippetDoc = class(TObject) /// Active text must be interpreted in a manner that makes sense /// for document format. procedure RenderExtra(const ExtraText: IActiveText); virtual; abstract; - /// Output given information about code snippets database. - /// - procedure RenderDBInfo(const Text: string); virtual; abstract; + /// Output given information about a collection. + procedure RenderCollectionInfo(const Text: string); virtual; abstract; /// Finalise document and return content as encoded data. /// /// Descendant classes should perform any required finalisation @@ -128,6 +129,24 @@ implementation { TSnippetDoc } +function TSnippetDoc.CollectionInfo(const ACollectionID: TCollectionID): string; +resourcestring + sCollectionInfo = 'A snippet from the "%s" collection.'; +var + MetaData: IDBMetaData; + Collection: TCollection; +begin + Collection := TCollections.Instance.GetCollection(ACollectionID); + Result := Format(sCollectionInfo, [Collection.Name]); + MetaData := TMetaDataFactory.CreateInstance(Collection); + if mdcLicense in MetaData.GetCapabilities then + begin + Result := Result + ' ' + MetaData.GetLicenseInfo.NameWithURL + '.'; + if (mdcCopyright in MetaData.GetCapabilities) then + Result := Result + ' ' + MetaData.GetCopyrightInfo.ToString + '.'; + end; +end; + function TSnippetDoc.CommaList(const List: IStringList): string; resourcestring sNone = 'None.'; // string output for empty lists @@ -203,9 +222,7 @@ function TSnippetDoc.Generate(const Snippet: TSnippet): TEncodedData; end; if Snippet.Extra.HasContent then RenderExtra(Snippet.Extra); - if Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then - // database info written only if snippet is from main database - RenderDBInfo(MainDBInfo); + RenderCollectionInfo(CollectionInfo(Snippet.CollectionID)); Result := FinaliseDoc; end; @@ -214,23 +231,6 @@ procedure TSnippetDoc.InitialiseDoc; // Do nothing end; -function TSnippetDoc.MainDBInfo: string; -resourcestring - sMainDBInfo = 'A snippet from the DelphiDabbler Code Snippets Database ' - + '(%0:s), licensed under the %1:s.'; -var - DBMetaData: IDBMetaData; -begin - DBMetaData := TMainDBMetaDataFactory.MainDBMetaDataInstance; - Result := Format( - sMainDBInfo, - [ - TURL.CodeSnipRepo, - DBMetaData.GetLicenseInfo.NameWithURL - ] - ); -end; - function TSnippetDoc.SnippetsToStrings(const SnippetList: TSnippetList): IStringList; var diff --git a/Src/UTextSnippetDoc.pas b/Src/UTextSnippetDoc.pas index 4e7710b5b..f131dd624 100644 --- a/Src/UTextSnippetDoc.pas +++ b/Src/UTextSnippetDoc.pas @@ -78,9 +78,8 @@ TTextSnippetDoc = class(TSnippetDoc) /// Active text is converted to word-wrapped plain text /// paragraphs. procedure RenderExtra(const ExtraText: IActiveText); override; - /// Adds given information about code snippets database to - /// document. - procedure RenderDBInfo(const Text: string); override; + /// Output given information about a collection. + procedure RenderCollectionInfo(const Text: string); override; /// Finalises document and returns content as encoded data. /// function FinaliseDoc: TEncodedData; override; @@ -126,6 +125,12 @@ procedure TTextSnippetDoc.RenderActiveText(ActiveText: IActiveText); end; end; +procedure TTextSnippetDoc.RenderCollectionInfo(const Text: string); +begin + fWriter.WriteLine; + fWriter.WriteLine(StrWrap(Text, cPageWidth, 0)); +end; + procedure TTextSnippetDoc.RenderCompilerInfo(const Heading: string; const Info: TCompileDocInfoArray); var @@ -146,12 +151,6 @@ procedure TTextSnippetDoc.RenderCompilerInfo(const Heading: string; ); end; -procedure TTextSnippetDoc.RenderDBInfo(const Text: string); -begin - fWriter.WriteLine; - fWriter.WriteLine(StrWrap(Text, cPageWidth, 0)); -end; - procedure TTextSnippetDoc.RenderDescription(const Desc: IActiveText); begin fWriter.WriteLine; From 4057dee79a01f6a60953aca0ae3398809a98a765 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 16 Nov 2024 18:57:48 +0000 Subject: [PATCH 101/222] Change header comments in generated source code Updated USnippetSourceGen & USaveUnitMgr re revised meta data code. Modified the information that is written in header comments to work with the recent changes to how meta data works with collections. Header comments no longer only contain license information for the "main database" but now provide license information for any collection whose data format supports it. In addition all the collections providing snippets in the source code are bullet listed. --- Src/USaveUnitMgr.pas | 133 ++++++++++++++++++++------------------ Src/USnippetSourceGen.pas | 122 +++++++++++++++++----------------- 2 files changed, 134 insertions(+), 121 deletions(-) diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index ca02bd04f..6b13e0d50 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -17,8 +17,15 @@ interface uses + // Delphi + Generics.Collections, // Project - DB.USnippet, UIStringList, USourceFileInfo, USaveSourceMgr, USourceGen; + DB.UCollections, + DB.USnippet, + UIStringList, + USourceFileInfo, + USaveSourceMgr, + USourceGen; type @@ -38,9 +45,9 @@ TSaveUnitMgr = class(TSaveSourceMgr) /// Name of generated unit. /// If empty string a default name is used. fUnitName: string; - /// Flag true if unit contains at least one snippet from main - /// database, False only if unit is completely user defined. - fContainsMainDBSnippets: Boolean; + /// List of collections that have contributed snippets to the + /// source code being generated. + fCollections: TList; /// Gets name of unit to be used in generated code. function UnitName: string; /// Creates a string list containing comments to be written to @@ -96,12 +103,8 @@ implementation // Delphi SysUtils, // Project - DB.UCollections, DB.UMetaData, - DBIO.MetaData.DCSC, UAppInfo, - UConsts, - UUrl, UUtils; @@ -118,16 +121,10 @@ implementation // Error message sErrorMsg = 'Filename is not valid for a Pascal unit'; // Unit header comments - sLicense = 'The unit is copyright ' - + COPYRIGHT - + ' %0:s by %1:s and is licensed under the %2:s.'; - sMainDescription = 'This unit was generated automatically. It incorporates a ' - + 'selection of source code taken from the Code Snippets Database at %0:s.'; - sGenerated = 'Generated on : %0:s.'; - sGenerator = 'Generated by : %0:s %1:s.'; - sAdvert = 'The latest version of %0:s is available from the CodeSnip GitHub ' - + 'project at %1:s.'; - sUserDescription = 'This unit was generated automatically.'; + sMainGenerator = 'This unit snippet was generated by %0:s %1:s on %2:s.'; + sCollection = 'The code was sourced from the %s collection.'; + sCollectionList = 'The code was sourced from the following collections:'; + sCollectionCredit = 'Collection "%0:s" is licensed under the %1:s.'; // Output document title sDocTitle = 'Pascal unit generated by %s'; @@ -148,54 +145,64 @@ procedure TSaveUnitMgr.CheckFileName(const FileName: string; end; function TSaveUnitMgr.CreateHeaderComments: IStringList; + + {TODO -cRefactoring: This code has a lot in common with header comment + generator code in USnippetSourceGen - extract common code.} + + function CreditsLine(const ACollection: TCollection): string; + var + DBMetaData: IDBMetaData; + begin + DBMetaData := TMetaDataFactory.CreateInstance(ACollection); + Result := ''; + if mdcLicense in DBMetaData.GetCapabilities then + begin + Result := Result + DBMetaData.GetLicenseInfo.NameWithURL + '.'; + if (mdcCopyright in DBMetaData.GetCapabilities) then + Result := Result + ' ' + DBMetaData.GetCopyrightInfo.ToString + '.'; + end; + end; + var - DBMetaData: IDBMetaData; + Collection: TCollection; + Credits: string; begin Result := TIStringList.Create; - if fContainsMainDBSnippets then - begin - // Result used for units that contain any snippet(s) from main database - Result.Add(Format(sMainDescription, [TURL.CodeSnippetsDBRepo])); - Result.Add(''); - DBMetaData := TMainDBMetaDataFactory.MainDBMetaDataInstance; - Result.Add( - Format( - sLicense, - [ - DBMetaData.GetCopyrightInfo.Date, - DBMetaData.GetCopyrightInfo.Holder, - DBMetaData.GetLicenseInfo.NameWithURL - ] - ) - ); - Result.Add(''); - Result.Add(Format(sGenerated, [RFC1123DateStamp])); - Result.Add( - Format( - sGenerator, [TAppInfo.FullProgramName, TAppInfo.ProgramReleaseInfo] - ) - ); - Result.Add(''); - Result.Add( - Format(sAdvert, [TAppInfo.ProgramName, TURL.CodeSnipRepo]) - ); - end + + Result.Add( + Format( + sMainGenerator, + [TAppInfo.FullProgramName, TAppInfo.ProgramReleaseInfo, RFC1123DateStamp] + ) + ); + + Result.Add(''); + if fCollections.Count = 1 then + Result.Add(Format(sCollection, [fCollections[0].Name])) else begin - // Result used for units that contain only user defined snippets - Result.Add(sUserDescription); - Result.Add(''); - Result.Add(Format(sGenerated, [RFC1123DateStamp])); - Result.Add( - Format( - sGenerator, [TAppInfo.FullProgramName, TAppInfo.ProgramReleaseInfo] - ) - ); + Result.Add(sCollectionList); + for Collection in fCollections do + begin + Result.Add(' - ' + Collection.Name); + end; + end; + + for Collection in fCollections do + begin + Credits := CreditsLine(Collection); + if Credits <> '' then + begin + Result.Add(''); + Result.Add(Format(sCollectionCredit, [Collection.Name, Credits])); + end; end; + end; destructor TSaveUnitMgr.Destroy; begin + fCollections.Free; fSourceGen.Free; inherited; end; @@ -252,23 +259,23 @@ function TSaveUnitMgr.GetFileTypeDesc(const FileType: TSourceFileType): string; constructor TSaveUnitMgr.InternalCreate(const Snips: TSnippetList); var Snippet: TSnippet; // references each snippet in list + Collection: TCollection; begin Assert(Assigned(Snips), ClassName + '.InternalCreate: Snips is nil'); inherited InternalCreate; + fCollections := TList.Create(TCollection.TComparer.Create); + // Create source generator and initialize it with required snippets fSourceGen := TSourceGen.Create; fSourceGen.IncludeSnippets(Snips); - // Determine if snippet list contains at least one snippet from main database - fContainsMainDBSnippets := False; + // Count the number of collections containing snippet in the list for Snippet in Snips do begin - if Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then - begin - fContainsMainDBSnippets := True; - Break; - end; + Collection := TCollections.Instance.GetCollection(Snippet.CollectionID); + if not fCollections.Contains(Collection) then + fCollections.Add(Collection); end; end; diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index c3855ae64..b30a35883 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -17,8 +17,15 @@ interface uses + // Delphi + Generics.Collections, // Project - UBaseObjects, UIStringList, USourceGen, UView; + DB.UCollections, + DB.UMetaData, + UBaseObjects, + UIStringList, + USourceGen, + UView; type @@ -30,9 +37,9 @@ interface } TSnippetSourceGen = class sealed(TNoPublicConstructObject) strict private - fContainsMainDBSnippets: Boolean; - {Flag true if source code contains at least one snippet from main - database, False only if source code is completely user defined} + /// List of collections that have contributed snippets to the + /// source code being generated. + fCollections: TList; fGenerator: TSourceGen; {Object used to generate the source code} procedure Initialize(View: IView); @@ -87,8 +94,6 @@ implementation // Delphi SysUtils, // Project - DB.UCollections, - DB.UMetaData, DB.USnippet, DB.USnippetKind, DBIO.MetaData.DCSC, @@ -106,59 +111,60 @@ function TSnippetSourceGen.BuildHeaderComments: IStringList; } var DBMetaData: IDBMetaData; + Collection: TCollection; + Credits: string; resourcestring // Comment to be included at top of snippet // when snippets include those from main database - sMainDBGenerator = 'This code snippet was generated by %0:s %1:s on %2:s.'; - sMainDBLicense = 'It includes code taken from the DelphiDabbler Code ' - + 'Snippets database that is copyright ' - + COPYRIGHT - + ' %0:s by %1:s and is licensed under the %2:s.'; - // when snippets are all from user defined database - sUserGenerator = 'This user defined code snippet was generated by ' - + '%0:s %1:s on %2:s.'; + sMainGenerator = 'This code snippet was generated by %0:s %1:s on %2:s.'; + sCollection = 'The code was sourced from the %s collection.'; + sCollectionList = 'The code was sourced from the following collections:'; + sCollectionCredit = 'Collection "%0:s" is licensed under the %1:s'; + + function CreditsLine(const ACollection: TCollection): string; + begin + DBMetaData := TMetaDataFactory.CreateInstance(ACollection); + Result := ''; + if mdcLicense in DBMetaData.GetCapabilities then + begin + Result := Result + DBMetaData.GetLicenseInfo.NameWithURL + '.'; + if (mdcCopyright in DBMetaData.GetCapabilities) then + Result := Result + ' ' + DBMetaData.GetCopyrightInfo.ToString + '.'; + end; + end; + begin - // Header depends on whether snippets contain any from main database or are - // all user defined Result := TIStringList.Create; - if fContainsMainDBSnippets then - begin - Result.Add( - Format( - sMainDBGenerator, - [ - TAppInfo.FullProgramName, - TAppInfo.ProgramReleaseInfo, - RFC1123DateStamp - ] - ) - ); - Result.Add(''); - DBMetaData := TMainDBMetaDataFactory.MainDBMetaDataInstance; - Result.Add( - Format( - sMainDBLicense, - [ - DBMetaData.GetCopyrightInfo.Date, - DBMetaData.GetCopyrightInfo.Holder, - DBMetaData.GetLicenseInfo.NameWithURL - ] - ) - ); - end + + Result.Add( + Format( + sMainGenerator, + [TAppInfo.FullProgramName, TAppInfo.ProgramReleaseInfo, RFC1123DateStamp] + ) + ); + + Result.Add(''); + if fCollections.Count = 1 then + Result.Add(Format(sCollection, [fCollections[0].Name])) else begin - Result.Add( - Format( - sUserGenerator, - [ - TAppInfo.FullProgramName, - TAppInfo.ProgramReleaseInfo, - RFC1123DateStamp - ] - ) - ); + Result.Add(sCollectionList); + for Collection in fCollections do + begin + Result.Add(' - ' + Collection.Name); + end; + end; + + for Collection in fCollections do + begin + Credits := CreditsLine(Collection); + if Credits <> '' then + begin + Result.Add(''); + Result.Add(Format(sCollectionCredit, [Collection.Name, Credits])); + end; end; + end; class function TSnippetSourceGen.CanGenerate(View: IView): Boolean; @@ -191,6 +197,7 @@ destructor TSnippetSourceGen.Destroy; {Class destructor. Tears down object. } begin + fCollections.Free; fGenerator.Free; inherited; end; @@ -237,15 +244,15 @@ procedure TSnippetSourceGen.Initialize(View: IView); var Snips: TSnippetList; // list of snippets in a category to display Snippet: TSnippet; // a snippet in Snips list + Collection: TCollection; begin - fContainsMainDBSnippets := False; // Record required snippet(s) if Supports(View, ISnippetView) then begin // view is single snippet: just record that Snippet := (View as ISnippetView).Snippet; fGenerator.IncludeSnippet(Snippet); - fContainsMainDBSnippets := Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID; + fCollections.Add(TCollections.Instance.GetCollection(Snippet.CollectionID)); end else begin @@ -256,11 +263,9 @@ procedure TSnippetSourceGen.Initialize(View: IView); fGenerator.IncludeSnippets(Snips); // ignores freeform snippets for Snippet in Snips do begin - if Snippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then - begin - fContainsMainDBSnippets := True; - Break; - end; + Collection := TCollections.Instance.GetCollection(Snippet.CollectionID); + if not fCollections.Contains(Collection) then + fCollections.Add(Collection); end; finally Snips.Free; @@ -278,6 +283,7 @@ constructor TSnippetSourceGen.InternalCreate(View: IView); Assert(CanGenerate(View), ClassName + '.InternalCreate: View not supported'); inherited InternalCreate; fGenerator := TSourceGen.Create; + fCollections := TList.Create(TCollection.TComparer.Create); Initialize(View); end; From 6ca6e569128b493acd166cd51003ea05b4b369d5 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 17 Nov 2024 14:54:45 +0000 Subject: [PATCH 102/222] Modify About box database tab to show collection info Replaced the About box's "About The Database" tab with an "About Collections" tab that asks user to choose a collection and then shows any meta data associated with the collection. The data is shown, grouped by type, in a tree view. Where the collection has no meta data, a message for that is shown. Redundant code was deleted and there was some renaming for clarity. The dlg-about-database-tplt.html HTML template file used the the "About The Database" tab was deleted and its reference was removed from HTML.hrc. --- Src/FmAboutDlg.dfm | 61 ++--- Src/FmAboutDlg.pas | 274 ++++++++++------------ Src/HTML.hrc | 1 - Src/Res/HTML/dlg-about-database-tplt.html | 114 --------- 4 files changed, 156 insertions(+), 294 deletions(-) delete mode 100644 Src/Res/HTML/dlg-about-database-tplt.html diff --git a/Src/FmAboutDlg.dfm b/Src/FmAboutDlg.dfm index cfc0062f7..6f30713ad 100644 --- a/Src/FmAboutDlg.dfm +++ b/Src/FmAboutDlg.dfm @@ -63,37 +63,42 @@ inherited AboutDlg: TAboutDlg end end end - object tsDatabase: TTabSheet - Caption = 'About The Database' + object tsCollections: TTabSheet + Caption = 'About Collections' ImageIndex = 1 - inline frmDatabase: THTMLTpltDlgFrame - Left = 0 + DesignSize = ( + 401 + 190) + object lblCollection: TLabel + Left = 3 + Top = 3 + Width = 80 + Height = 13 + Caption = '&Select collection:' + FocusControl = cbCollection + end + object cbCollection: TComboBox + Left = 112 Top = 0 - Width = 401 - Height = 190 - Align = alClient + Width = 286 + Height = 21 + Style = csDropDownList + Anchors = [akLeft, akTop, akRight] TabOrder = 0 - TabStop = True - ExplicitWidth = 401 - ExplicitHeight = 190 - inherited pnlBrowser: TPanel - Width = 401 - Height = 190 - ExplicitWidth = 401 - ExplicitHeight = 190 - inherited wbBrowser: TWebBrowser - Width = 401 - Height = 190 - ExplicitWidth = 345 - ExplicitHeight = 133 - ControlData = { - 4C00000072290000A31300000000000000000000000000000000000000000000 - 000000004C000000000000000000000001000000E0D057007335CF11AE690800 - 2B2E126208000000000000004C0000000114020000000000C000000000000046 - 8000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000100000000000000000000000000000000000000} - end - end + OnChange = cbCollectionChange + end + object tvCollectionInfo: TTreeView + Left = 0 + Top = 27 + Width = 401 + Height = 163 + Anchors = [akLeft, akTop, akRight, akBottom] + BorderStyle = bsNone + Indent = 19 + ParentColor = True + ReadOnly = True + ShowRoot = False + TabOrder = 1 end end object tsPaths: TTabSheet diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index a15bbd236..7774645cb 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -26,11 +26,13 @@ interface Messages, // Project Browser.UHTMLEvents, + DB.UCollections, DB.UMetaData, FmGenericViewDlg, FrBrowserBase, FrHTMLDlg, FrHTMLTpltDlg, + UCollectionListAdapter, UCSSBuilder, UIStringList; @@ -81,16 +83,18 @@ TPathInfoBox = class(TCustomGroupBox) /// provides access to the program's easter egg. TAboutDlg = class(TGenericViewDlg) bvlSeparator: TBevel; - frmDatabase: THTMLTpltDlgFrame; frmProgram: THTMLTpltDlgFrame; pcDetail: TPageControl; - tsDatabase: TTabSheet; + tsCollections: TTabSheet; tsProgram: TTabSheet; pnlTitle: TPanel; frmTitle: THTMLTpltDlgFrame; tsPaths: TTabSheet; btnViewAppConfig: TButton; btnViewUserConfig: TButton; + cbCollection: TComboBox; + lblCollection: TLabel; + tvCollectionInfo: TTreeView; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); /// Handles event triggered when user clicks on one of page @@ -105,16 +109,16 @@ TAboutDlg = class(TGenericViewDlg) /// Handles button click event to display per-user config file. /// procedure btnViewUserConfigClick(Sender: TObject); + procedure cbCollectionChange(Sender: TObject); strict private var + fCollList: TCollectionListAdapter; /// Control that displays main database folder. fMainDBPathGp: TPathInfoBox; /// Control that displays user database folder. fUserDBPathGp: TPathInfoBox; /// Control that displays program install path. fInstallPathGp: TPathInfoBox; - /// Provides access to main database meta data. - fMetaData: IDBMetaData; /// Handles title frame's OnHTMLEvent event. Checks for mouse /// events relating to display of the easter egg and acts accordingly. /// @@ -123,12 +127,10 @@ TAboutDlg = class(TGenericViewDlg) /// information about the event. procedure HTMLEventHandler(Sender: TObject; const EventInfo: THTMLEventInfo); - /// Builds HTML used to display list of contributors or an error - /// message if the list is empty. - /// IStringList [in] List of contributors to - /// display. - /// string. Required HTML. - function ContribListHTML(ContribList: IStringList): string; + /// Displays any meta data associated with a collection. + /// TCollection [in] Collection for which + /// meta data is to be displayed. + procedure DisplayCollectionInfo(ACollection: TCollection); /// Displays content of a config file in a dialogue box or an /// error message if the file does not exist. /// string [in] Name of config file to display. @@ -151,14 +153,13 @@ TAboutDlg = class(TGenericViewDlg) /// TCSSBuilder [in] Object used to update CSS. /// procedure UpdateTitleCSS(Sender: TObject; const CSSBuilder: TCSSBuilder); - /// Updates CSS used for HTML displayed in detail frames. - /// + /// Updates CSS used for HTML displayed in About The Program + /// tab frame. /// TObject [in] Not used. /// TCSSBuilder [in] Object used to update CSS. /// - /// Details frames form the body of the About Box on the Program - /// and Database tabs. - procedure UpdateDetailCSS(Sender: TObject; const CSSBuilder: TCSSBuilder); + procedure UpdateProgramTabCSS(Sender: TObject; + const CSSBuilder: TCSSBuilder); public /// Displays dialog box. /// TComponent [in] Component that owns this dialogus @@ -179,9 +180,6 @@ implementation ShellAPI, IOUtils, // Project - DB.UCollections, - DB.UMain, - DBIO.MetaData.DCSC, FmEasterEgg, FmPreviewDlg, UAppInfo, @@ -192,14 +190,12 @@ implementation UEncodings, UFontHelper, UGraphicUtils, - UHTMLUtils, UHTMLTemplate, UIOUtils, UMessageBox, UResourceUtils, UStrUtils, - UThemesEx, - UVersionInfo; + UThemesEx; {$R *.dfm} @@ -222,6 +218,12 @@ procedure TAboutDlg.ArrangeForm; var PathTabHeight: Integer; begin + // Collections tab + TCtrlArranger.AlignVCentres(8, [lblCollection, cbCollection]); + TCtrlArranger.MoveToRightOf(lblCollection, cbCollection, 12); + TCtrlArranger.MoveBelow([lblCollection, cbCollection], tvCollectionInfo, 8); + + // Paths tab fMainDBPathGp.Top := TCtrlArranger.BottomOf(fInstallPathGp, 8); fUserDBPathGp.Top := TCtrlArranger.BottomOf(fMainDBPathGp, 8); TCtrlArranger.AlignTops( @@ -239,7 +241,7 @@ procedure TAboutDlg.ArrangeForm; pcDetail.Height - tsProgram.ClientHeight + Max( PathTabHeight, - Max(frmProgram.DocHeight, frmDatabase.DocHeight) + frmProgram.DocHeight ) + 8; pnlBody.ClientHeight := pnlTitle.Height + bvlSeparator.Height + pcDetail.Height; @@ -260,6 +262,11 @@ procedure TAboutDlg.btnViewUserConfigClick(Sender: TObject); ViewConfigFile(TAppInfo.UserConfigFileName, sTitle); end; +procedure TAboutDlg.cbCollectionChange(Sender: TObject); +begin + DisplayCollectionInfo(fCollList.Collection(cbCollection.ItemIndex)); +end; + procedure TAboutDlg.ConfigForm; // Creates and initialises a custom path information control with given @@ -282,8 +289,6 @@ procedure TAboutDlg.ConfigForm; sUserDBPathGpCaption = 'User Database Directory'; begin inherited; - // Create meta data object for main database - fMetaData := TMainDBMetaDataFactory.MainDBMetaDataInstance; // Creates required custom controls fInstallPathGp := CreatePathInfoBox( sInstallPathGpCaption, TAppInfo.AppExeDir, 0 @@ -296,34 +301,102 @@ procedure TAboutDlg.ConfigForm; ); btnViewAppConfig.TabOrder := fUserDBPathGp.TabOrder + 1; btnViewUserConfig.TabOrder := btnViewAppConfig.TabOrder + 1; + // Load collections into combo box & select default collection + fCollList.ToStrings(cbCollection.Items); + cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); + DisplayCollectionInfo(fCollList.Collection(cbCollection.ItemIndex)); + // Set collections treeview background colour + tvCollectionInfo.Color := ThemeServicesEx.GetTabBodyColour; // Load content into HTML frames InitHTMLFrames; end; -function TAboutDlg.ContribListHTML(ContribList: IStringList): - string; -resourcestring - // Error string used when contributor file not available - sNoContributors = 'No contributors list available. Database may be corrupt'; -var - Contributor: string; // name of a contributor - DivAttrs: IHTMLAttributes; // attributes of div tag -begin - Result := ''; - if ContribList.Count > 0 then +procedure TAboutDlg.DisplayCollectionInfo(ACollection: TCollection); + + function AddHeading(const AHeading: string): TTreeNode; begin - for Contributor in ContribList do - Result := Result - + THTML.CompoundTag('div', THTML.Entities(Contributor)) - + EOL; - end - else + Result := tvCollectionInfo.Items.AddChild(nil, AHeading); + end; + + procedure AddChild(const AParentNode: TTreeNode; const AData: string); begin - // List couldn't be found: display warning message - DivAttrs := THTMLAttributes.Create('class', 'warning'); - Result := THTML.CompoundTag( - 'div', DivAttrs, THTML.Entities(sNoContributors) - ); + tvCollectionInfo.Items.AddChild(AParentNode, AData); + end; + + procedure AddItem(const AHeading, AData: string); + var + HeadingNode: TTreeNode; + begin + HeadingNode := AddHeading(AHeading); + AddChild(HeadingNode, AData); + end; + + procedure AddItems(const AHeading: string; const AData: IStringList); + var + HeadingNode: TTreeNode; + DataItem: string; + begin + HeadingNode := AddHeading(AHeading); + for DataItem in AData do + AddChild(HeadingNode, DataItem); + end; + +var + MetaData: IDBMetaData; + Capabilities: TMetaDataCapabilities; + HeadingNode: TTreeNode; +resourcestring + sVersionHeading = 'Version'; + sLicenseHeading = 'License'; + sCopyrightHeading = 'Copyright'; + sContributorsHeading = 'Contributors'; + sTestersHeading = 'Testers'; + sNoMetaData = 'No information available for this collection.'; +begin + tvCollectionInfo.Items.BeginUpdate; + try + tvCollectionInfo.Items.Clear; + MetaData := TMetaDataFactory.CreateInstance(ACollection); + Capabilities := MetaData.GetCapabilities; + if Capabilities <> [] then + begin + if mdcVersion in Capabilities then + AddItem(sVersionHeading, MetaData.GetVersion); + if mdcLicense in Capabilities then + begin + HeadingNode := AddHeading(sLicenseHeading); + AddChild( + HeadingNode, + StrIf( + MetaData.GetLicenseInfo.Name <> '', + MetaData.GetLicenseInfo.Name, + MetaData.GetLicenseInfo.SPDX + ) + ); + AddChild(HeadingNode, MetaData.GetLicenseInfo.URL); + end; + if mdcCopyright in Capabilities then + begin + HeadingNode := AddHeading(sCopyrightHeading); + AddChild(HeadingNode, MetaData.GetCopyrightInfo.Date); + AddChild(HeadingNode, MetaData.GetCopyrightInfo.Holder); + AddChild(HeadingNode, MetaData.GetCopyrightInfo.HolderURL); + end; + if mdcContributors in Capabilities then + begin + AddItems(sContributorsHeading, MetaData.GetContributors); + end; + if mdcTesters in Capabilities then + AddItems(sTestersHeading, MetaData.GetTesters); + end + else + begin + AddHeading(sNoMetaData); + end; + tvCollectionInfo.FullExpand; + tvCollectionInfo.Items[0].MakeVisible; + finally + tvCollectionInfo.Items.EndUpdate; end; end; @@ -342,9 +415,9 @@ class procedure TAboutDlg.Execute(AOwner: TComponent); procedure TAboutDlg.FormCreate(Sender: TObject); begin inherited; + fCollList := TCollectionListAdapter.Create; frmTitle.OnBuildCSS := UpdateTitleCSS; - frmProgram.OnBuildCSS := UpdateDetailCSS; - frmDatabase.OnBuildCSS := UpdateDetailCSS; + frmProgram.OnBuildCSS := UpdateProgramTabCSS; end; procedure TAboutDlg.FormDestroy(Sender: TObject); @@ -353,6 +426,7 @@ procedure TAboutDlg.FormDestroy(Sender: TObject); fInstallPathGp.Free; fMainDBPathGp.Free; fUserDBPathGp.Free; + fCollList.Free; end; procedure TAboutDlg.HTMLEventHandler(Sender: TObject; @@ -417,105 +491,8 @@ procedure TAboutDlg.InitHTMLFrames; ); end; - // Initialises and loads HTML into database frame. - procedure InitDatabaseFrame; - begin - // Ensure browser loads page so we can process it - pcDetail.ActivePage := tsDatabase; - - frmDatabase.Initialise( - 'dlg-about-database-tplt.html', - procedure(Tplt: THTMLTemplate) - var - IsDBAvalable: Boolean; - IsMetaDataAvailable: Boolean; - IsLicenseInfoAvailable: Boolean; - - function DBVersion: string; - var - Ver: TVersionNumber; - begin - Ver := fMetaData.GetVersion; - if Ver.V1 = 1 then - Result := '1' - else - Result := Ver; - end; - - begin - // Resolve conditionally displayed block placeholders -// IsDBAvalable := Database.Snippets.Count(False) > 0; - // check if DelphiDabbler Code Snippets Collection is in use - IsDBAvalable := not Database.Snippets.IsEmpty( - TCollectionID.__TMP__MainDBCollectionID - ); - IsMetaDataAvailable := fMetaData.IsSupportedVersion - and not fMetaData.IsCorrupt; - IsLicenseInfoAvailable := IsMetaDataAvailable - and (fMetaData.GetLicenseInfo.Name <> '') - and (fMetaData.GetCopyrightInfo.Date <> '') - and (fMetaData.GetCopyrightInfo.Holder <> ''); - Tplt.ResolvePlaceholderHTML( - 'DBAvailable', TCSS.BlockDisplayProp(IsDBAvalable) - ); - Tplt.ResolvePlaceholderHTML( - 'DBNotAvailable', TCSS.BlockDisplayProp(not IsDBAvalable) - ); - Tplt.ResolvePlaceholderHTML( - 'MetaDataAvailable', TCSS.BlockDisplayProp(IsMetaDataAvailable) - ); - Tplt.ResolvePlaceholderHTML( - 'MetaDataNotAvailable', TCSS.BlockDisplayProp(not IsMetaDataAvailable) - ); - Tplt.ResolvePlaceholderHTML( - 'LicenseInfoAvailable', TCSS.BlockDisplayProp(IsLicenseInfoAvailable) - ); - Tplt.ResolvePlaceholderHTML( - 'LicenseInfoAvailableInline', - TCSS.InlineDisplayProp(IsLicenseInfoAvailable) - ); - Tplt.ResolvePlaceholderHTML( - 'LicenseInfoNotAvailable', - TCSS.BlockDisplayProp(not IsLicenseInfoAvailable) - ); - - // Resolve content placeholders - Tplt.ResolvePlaceholderText( - 'CopyrightYear', fMetaData.GetCopyrightInfo.Date - ); - Tplt.ResolvePlaceholderText( - 'CopyrightHolders', fMetaData.GetCopyrightInfo.Holder - ); - Tplt.ResolvePlaceholderHTML( - 'DBLicense', - StrIf( - fMetaData.GetLicenseInfo.URL <> '', - THTML.CompoundTag( - 'a', - THTMLAttributes.Create([ - THTMLAttribute.Create('href', fMetaData.GetLicenseInfo.URL), - THTMLAttribute.Create('class', 'external-link') - ]), - THTML.Entities(fMetaData.GetLicenseInfo.Name) - ), - THTML.Entities(fMetaData.GetLicenseInfo.Name) - ) - ); - Tplt.ResolvePlaceholderHTML( - 'ContribList', ContribListHTML(fMetaData.GetContributors) - ); - Tplt.ResolvePlaceholderHTML( - 'TesterList', ContribListHTML(fMetaData.GetTesters) - ); - Tplt.ResolvePlaceholderText('Version', DBVersion); - end - ); - end; - // --------------------------------------------------------------------------- - begin InitTitleFrame; - InitDatabaseFrame; InitProgramFrame; end; @@ -526,7 +503,7 @@ procedure TAboutDlg.pcDetailMouseDown(Sender: TObject; Button: TMouseButton; pcDetail.SetFocus; end; -procedure TAboutDlg.UpdateDetailCSS(Sender: TObject; +procedure TAboutDlg.UpdateProgramTabCSS(Sender: TObject; const CSSBuilder: TCSSBuilder); var ContentFont: TFont; // font used for content @@ -548,11 +525,6 @@ procedure TAboutDlg.UpdateDetailCSS(Sender: TObject; // Put border round scroll box CSSBuilder.AddSelector('.scrollbox') .AddProperty(UCSSUtils.TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); - // Set colours and font style of contributors and testers headings - CSSBuilder.AddSelector('.contrib-head, .tester-head') - .AddProperty(TCSS.BackgroundColorProp(clBtnFace)) - .AddProperty(TCSS.ColorProp(clBtnText)) - .AddProperty(TCSS.FontWeightProp(cfwBold)); end; procedure TAboutDlg.UpdateTitleCSS(Sender: TObject; diff --git a/Src/HTML.hrc b/Src/HTML.hrc index 600d279b8..90e550c11 100644 --- a/Src/HTML.hrc +++ b/Src/HTML.hrc @@ -13,7 +13,6 @@ # about box Res\HTML\dlg-about-head-tplt.html Res\HTML\dlg-about-program-tplt.html -Res\HTML\dlg-about-database-tplt.html # easter egg Res\HTML\dlg-easter-egg.html diff --git a/Src/Res/HTML/dlg-about-database-tplt.html b/Src/Res/HTML/dlg-about-database-tplt.html deleted file mode 100644 index ccc4f9797..000000000 --- a/Src/Res/HTML/dlg-about-database-tplt.html +++ /dev/null @@ -1,114 +0,0 @@ - - - - - - - - - - dlg-about-database-tplt.html - - - - - -

- The DelphiDabbler - Code Snippets Database is a resource containing numerous fragments of useful Object Pascal code. You are using version <%Version%>. -

- -
- -
- -

- The source code in the database is copyright © <%CopyrightYear%> by <%CopyrightHolders%>. It is made available under the terms of the <%DBLicense%>. -

- -

- No copyright or licensing information is available. -

- -

- The code is used entirely at your own risk. -

- -

- Credits -

- -

- The following people have contributed code to the database, or have helped to test it: -

- -
-
- Contributors -
-
- <%ContribList%> -
-
- Testers -
-
- <%TesterList%> -
-
- -
- -

- Credits, License and Copyright information are not available. The main database may be corrupt. Please use the Database | Install or Update DelphiDabbler Snippets Database menu option to display the Install or Update DelphiDabbler Snippets Database dialogue box and follow the instructions there to get the latest version of the database. -

- -
- -
- -

- The database is not installed. -

- -

- You can install it from the Database | Install or Update DelphiDabbler Snippets Database menu option. Learn more. -

- -
- - - - - From 0cf77d0eb383e9d42ee29daf7baca24112c1b34c Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 18 Nov 2024 00:01:47 +0000 Subject: [PATCH 103/222] Modify About Box to list collection paths The Paths & Files tab of the About box was revised to list the paths of each collection's data instead of the paths to the "user" and "main" databases. The new design places the custom group boxes used to display the path information within a scroll box since the number of collections can't be predicted and it can't be guaranteed that the path group boxes would not overflow the availablr screen space. Moved the buttons used to display the config files from the bottom to the top of the Paths & Files tab. Updated commenting to reflect the changes and to fix some typos. --- Src/FmAboutDlg.dfm | 30 +++++++++-- Src/FmAboutDlg.pas | 127 ++++++++++++++++++++++++++------------------- 2 files changed, 98 insertions(+), 59 deletions(-) diff --git a/Src/FmAboutDlg.dfm b/Src/FmAboutDlg.dfm index 6f30713ad..c683d780e 100644 --- a/Src/FmAboutDlg.dfm +++ b/Src/FmAboutDlg.dfm @@ -104,24 +104,44 @@ inherited AboutDlg: TAboutDlg object tsPaths: TTabSheet Caption = 'Paths && Files' ImageIndex = 2 + DesignSize = ( + 401 + 190) object btnViewAppConfig: TButton Left = 3 - Top = 144 + Top = 3 Width = 170 Height = 25 Caption = 'View Application Config File...' - TabOrder = 1 + TabOrder = 0 OnClick = btnViewAppConfigClick end object btnViewUserConfig: TButton - Left = 192 - Top = 144 + Left = 228 + Top = 3 Width = 170 Height = 25 + Anchors = [akTop, akRight] Caption = 'View Per-User Config File...' - TabOrder = 0 + TabOrder = 1 OnClick = btnViewUserConfigClick end + object sbPaths: TScrollBox + Left = 3 + Top = 34 + Width = 395 + Height = 153 + BevelInner = bvLowered + BevelOuter = bvRaised + BevelKind = bkFlat + BorderStyle = bsNone + Padding.Left = 3 + Padding.Top = 3 + Padding.Right = 3 + Padding.Bottom = 3 + TabOrder = 2 + TabStop = True + end end end object pnlTitle: TPanel diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index 7774645cb..99184be1f 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -24,6 +24,7 @@ interface ExtCtrls, Classes, Messages, + Generics.Collections, // Project Browser.UHTMLEvents, DB.UCollections, @@ -77,9 +78,9 @@ TPathInfoBox = class(TCustomGroupBox) property Path: string read GetPath write SetPath; end; - /// Implements program' about dialogue box. - /// Displays information about the program, the main database and - /// the program's user and application folders and config files. Also + /// Implements program's about dialogue box. + /// Displays information about the program, the collections in use + /// and the program's user and application folders and config files. Also /// provides access to the program's easter egg. TAboutDlg = class(TGenericViewDlg) bvlSeparator: TBevel; @@ -95,12 +96,13 @@ TAboutDlg = class(TGenericViewDlg) cbCollection: TComboBox; lblCollection: TLabel; tvCollectionInfo: TTreeView; + sbPaths: TScrollBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); - /// Handles event triggered when user clicks on one of page - /// control tabs. Ensures page control has focus. - /// Without this fix, page control does not always get focus when - /// a tab is clicked. + /// Handles event triggered when user clicks on one of the page + /// control tabs. Ensures the page control has focus. + /// Without this fix, the page control does not always get focus # + /// when a tab is clicked. procedure pcDetailMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); /// Handles button click event to display application config file. @@ -109,16 +111,18 @@ TAboutDlg = class(TGenericViewDlg) /// Handles button click event to display per-user config file. /// procedure btnViewUserConfigClick(Sender: TObject); + /// Handles the change event triggered when the user selects a + /// collection in the collections combo box. Updates the display of + /// information about the selected collection. procedure cbCollectionChange(Sender: TObject); strict private var + /// List of dynamically created path information group boxes. + /// + fPathInfoBoxes: TList; + /// Provides a sorted list of collection names for display in + /// the collections combo box. fCollList: TCollectionListAdapter; - /// Control that displays main database folder. - fMainDBPathGp: TPathInfoBox; - /// Control that displays user database folder. - fUserDBPathGp: TPathInfoBox; - /// Control that displays program install path. - fInstallPathGp: TPathInfoBox; /// Handles title frame's OnHTMLEvent event. Checks for mouse /// events relating to display of the easter egg and acts accordingly. /// @@ -162,7 +166,7 @@ TAboutDlg = class(TGenericViewDlg) const CSSBuilder: TCSSBuilder); public /// Displays dialog box. - /// TComponent [in] Component that owns this dialogus + /// TComponent [in] Component that owns this dialogue /// box. class procedure Execute(AOwner: TComponent); end; @@ -183,7 +187,6 @@ implementation FmEasterEgg, FmPreviewDlg, UAppInfo, - UColours, UConsts, UCSSUtils, UCtrlArranger, @@ -216,7 +219,8 @@ function ExploreFolder(const Folder: string): Boolean; procedure TAboutDlg.ArrangeForm; var - PathTabHeight: Integer; + PathInfoBox: TPathInfoBox; + NextPathInfoBoxTop: Integer; begin // Collections tab TCtrlArranger.AlignVCentres(8, [lblCollection, cbCollection]); @@ -224,27 +228,35 @@ procedure TAboutDlg.ArrangeForm; TCtrlArranger.MoveBelow([lblCollection, cbCollection], tvCollectionInfo, 8); // Paths tab - fMainDBPathGp.Top := TCtrlArranger.BottomOf(fInstallPathGp, 8); - fUserDBPathGp.Top := TCtrlArranger.BottomOf(fMainDBPathGp, 8); - TCtrlArranger.AlignTops( - [btnViewAppConfig, btnViewUserConfig], - TCtrlArranger.BottomOf(fUserDBPathGp, 8) - ); - PathTabHeight := TCtrlArranger.BottomOf( - [btnViewUserConfig, btnViewAppConfig] - ); - TCtrlArranger.AlignLefts([fUserDBPathGp, btnViewAppConfig]); - TCtrlArranger.AlignRights([fUserDBPathGp, btnViewUserConfig]); + TCtrlArranger.AlignTops([btnViewAppConfig, btnViewUserConfig], 8); + TCtrlArranger.MoveBelow([btnViewAppConfig, btnViewUserConfig], sbPaths, 8); + // stack path group boxes vertically + NextPathInfoBoxTop := 8; + for PathInfoBox in fPathInfoBoxes do + begin + PathInfoBox.Top := NextPathInfoBoxTop; + Inc(NextPathInfoBoxTop, PathInfoBox.Height + 8); + end; + // align ctrl left & right sides + TCtrlArranger.AlignLefts([sbPaths, btnViewAppConfig]); + TCtrlArranger.AlignRights([sbPaths, btnViewUserConfig]); + // Set height of title frame and page control pnlTitle.Height := frmTitle.DocHeight; - pcDetail.ClientHeight := - pcDetail.Height - tsProgram.ClientHeight + - Max( - PathTabHeight, - frmProgram.DocHeight - ) + 8; + pcDetail.ClientHeight := pcDetail.Height - tsProgram.ClientHeight + + frmProgram.DocHeight + 8; pnlBody.ClientHeight := pnlTitle.Height + bvlSeparator.Height + pcDetail.Height; + + // Set path scroll box height + sbPaths.ClientHeight := tsPaths.ClientHeight - sbPaths.Top - 28; + + // Set path controls' widths: must do this after all path box tops are set + // and after scroll box height is set so any vertical scroll bar will have + // been created. + for PathInfoBox in fPathInfoBoxes do + PathInfoBox.Width := sbPaths.ClientWidth - 2 * PathInfoBox.Left; + inherited; end; @@ -273,40 +285,49 @@ procedure TAboutDlg.ConfigForm; // caption, path and tab order. function CreatePathInfoBox(const Caption, Path: string; const TabOrder: Integer): TPathInfoBox; + const + MarginWidth = 8; begin - Result := TPathInfoBox.CreateParented(tsPaths.Handle); - Result.Parent := tsPaths; - Result.SetBounds(8, 8, tsPaths.ClientWidth - 16, 0); + Result := TPathInfoBox.CreateParented(sbPaths.Handle); + Result.Parent := sbPaths; + Result.SetBounds(MarginWidth, MarginWidth, sbPaths.ClientWidth - 2 * MarginWidth, 0); Result.Caption := Caption; Result.Path := Path; Result.TabOrder := TabOrder; end; +var + Collection: TCollection; + TabIdx: Integer; resourcestring // Captions for custom controls sInstallPathGpCaption = 'Install Directory'; - sMainDBPathGpCaption = 'Main Database Directory'; - sUserDBPathGpCaption = 'User Database Directory'; + sCollectionPathGpCaption = '%s Collection Directory'; begin inherited; // Creates required custom controls - fInstallPathGp := CreatePathInfoBox( - sInstallPathGpCaption, TAppInfo.AppExeDir, 0 - ); - fMainDBPathGp := CreatePathInfoBox( - sMainDBPathGpCaption, TAppInfo.AppDataDir, 1 - ); - fUserDBPathGp := CreatePathInfoBox( - sUserDBPathGpCaption, TAppInfo.UserDataDir, 2 + TabIdx := 0; + fPathInfoBoxes.Add( + CreatePathInfoBox(sInstallPathGpCaption, TAppInfo.AppExeDir, 1) ); - btnViewAppConfig.TabOrder := fUserDBPathGp.TabOrder + 1; - btnViewUserConfig.TabOrder := btnViewAppConfig.TabOrder + 1; + for Collection in TCollections.Instance do + begin + Inc(TabIdx); + fPathInfoBoxes.Add( + CreatePathInfoBox( + Format(sCollectionPathGpCaption, [Collection.Name]), + Collection.Location.Directory, + TabIdx + ) + ); + end; // Load collections into combo box & select default collection fCollList.ToStrings(cbCollection.Items); cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); DisplayCollectionInfo(fCollList.Collection(cbCollection.ItemIndex)); - // Set collections treeview background colour + // Set collections treeview and paths scrollbox background colours tvCollectionInfo.Color := ThemeServicesEx.GetTabBodyColour; + sbPaths.Color := ThemeServicesEx.GetTabBodyColour; // Load content into HTML frames InitHTMLFrames; end; @@ -416,6 +437,7 @@ procedure TAboutDlg.FormCreate(Sender: TObject); begin inherited; fCollList := TCollectionListAdapter.Create; + fPathInfoBoxes := TList.Create; frmTitle.OnBuildCSS := UpdateTitleCSS; frmProgram.OnBuildCSS := UpdateProgramTabCSS; end; @@ -423,9 +445,7 @@ procedure TAboutDlg.FormCreate(Sender: TObject); procedure TAboutDlg.FormDestroy(Sender: TObject); begin inherited; - fInstallPathGp.Free; - fMainDBPathGp.Free; - fUserDBPathGp.Free; + fPathInfoBoxes.Free; fCollList.Free; end; @@ -524,13 +544,12 @@ procedure TAboutDlg.UpdateProgramTabCSS(Sender: TObject; end; // Put border round scroll box CSSBuilder.AddSelector('.scrollbox') - .AddProperty(UCSSUtils.TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); + .AddProperty(UCSSUtils.TCSS.BorderProp(cssAll, 1, cbsSolid, clBtnShadow)); end; procedure TAboutDlg.UpdateTitleCSS(Sender: TObject; const CSSBuilder: TCSSBuilder); begin - // Set body colour, and put border round it CSSBuilder.Selectors['body'] .AddProperty(TCSS.BackgroundColorProp(clWindow)) .AddProperty(TCSS.PaddingProp(4)); From 75c458bfc39073a0654ed0d4b89ba23bf09c8558 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 18 Nov 2024 09:07:43 +0000 Subject: [PATCH 104/222] Remove TMainDBMetaDataFactory record Removed TMainDBMetaDataFactory from DBIO.MetaData.DCSC unit. Replace last remaining call to that record's methods in UDBUpdateMgr with a direct call to TUpdateDBMetaData's constructor. --- Src/DBIO.MetaData.DCSC.pas | 29 +---------------------------- Src/UDBUpdateMgr.pas | 2 +- 2 files changed, 2 insertions(+), 29 deletions(-) diff --git a/Src/DBIO.MetaData.DCSC.pas b/Src/DBIO.MetaData.DCSC.pas index 205eaa738..b2e07bb17 100644 --- a/Src/DBIO.MetaData.DCSC.pas +++ b/Src/DBIO.MetaData.DCSC.pas @@ -417,19 +417,6 @@ TUpdateDBMetaData = class sealed(TAbstractMainDBMetaData, IDBMetaData) constructor Create(const UpdateDir: string); end; - /// Factory that creates instances of objects that provide - /// information about the main database and database updates. - TMainDBMetaDataFactory = record - public - /// Returns instance of class that provides meta data for the - /// main database. - class function MainDBMetaDataInstance: IDBMetaData; static; - /// Returns instance of class that provides meta data for the - /// database update stored in the given folder. - class function UpdateMetaDataInstance(const UpdateDir: string): - IDBMetaData; static; - end; - implementation uses @@ -443,20 +430,6 @@ implementation UResourceUtils, UStrUtils; -{ TMainDBMetaDataFactory } - -class function TMainDBMetaDataFactory.MainDBMetaDataInstance: - IDBMetaData; -begin - Result := TMainDBMetaData.Create; -end; - -class function TMainDBMetaDataFactory.UpdateMetaDataInstance( - const UpdateDir: string): IDBMetaData; -begin - Result := TUpdateDBMetaData.Create(UpdateDir); -end; - { TAbstractMainDBMetaData } procedure TAbstractMainDBMetaData.AfterConstruction; @@ -520,7 +493,7 @@ function TAbstractMainDBMetaData.GetVersion: TVersionNumber; class function TAbstractMainDBMetaData.Instance( ACollection: DB.UCollections.TCollection): IDBMetaData; begin - Result := TMainDBMetaDataFactory.MainDBMetaDataInstance; + Result := TMainDBMetaData.Create; end; function TAbstractMainDBMetaData.IsCorrupt: Boolean; diff --git a/Src/UDBUpdateMgr.pas b/Src/UDBUpdateMgr.pas index f5f23bd4c..4119d9484 100644 --- a/Src/UDBUpdateMgr.pas +++ b/Src/UDBUpdateMgr.pas @@ -193,7 +193,7 @@ class procedure TDBUpdateMgr.ValidateUpdate(const UpdateDir: string); raise EDBUpdateValidationError.CreateFmt(sEmptyDirError, [Dir]); // Check contents - MetaData := TMainDBMetaDataFactory.UpdateMetaDataInstance(Dir); + MetaData := TUpdateDBMetaData.Create(Dir); // check if data files are recognised as valid database if not MetaData.IsRecognised then From 935fc19d4a1cdb21e7fb1793e7a6843341f4cd2e Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 18 Nov 2024 09:18:19 +0000 Subject: [PATCH 105/222] Remove "user database" checks from UCodeShareMgr TCodeShareMgr was requiring that snippets were available in the "user database" before permitting code to be exported. This was changed to a simple check that the entire database is non-empty. TCodeShareMgr was also refusing to extract a snippet object from a snippetview if the snippet didn't come from the "user database". This check was eliminated. Code comments referring to the "user database" were edited. All class and method comments were converted to XMLDoc format. --- Src/UCodeShareMgr.pas | 67 +++++++++++++++---------------------------- 1 file changed, 23 insertions(+), 44 deletions(-) diff --git a/Src/UCodeShareMgr.pas b/Src/UCodeShareMgr.pas index 367a02b27..add374d25 100644 --- a/Src/UCodeShareMgr.pas +++ b/Src/UCodeShareMgr.pas @@ -6,8 +6,7 @@ * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * * Implements a static class that manages sharing of user defined snippets. - * Provides support for exporting snippets, importing snippets and submitting - * snippets to the online database. + * Provides support for exporting and importing snippets. } @@ -19,39 +18,37 @@ interface uses // Project - DB.USnippet, UBaseObjects, UView; + DB.USnippet, + UBaseObjects, + UView; type - { - TCodeShareMgr: - Sealed static class that manages sharing of user defined snippets. Provides - support for exporting snippets, importing snippets and submitting snippets - to the online database. - } + /// Manages sharing snippets. Provides support for exporting and + /// importing snippets. TCodeShareMgr = class sealed(TNoConstructObject) strict private + /// Gets reference to any snippet represented by a view item. + /// + /// IView [in] View item fromm which snippet + /// is to be extracted, if present. + /// TSnippet. Reference to the required snippet or nil if + /// the view item does not represent a snippet. class function GetSnippetFromView(ViewItem: IView): TSnippet; - {Gets reference to any user defined snippet represented by a view item. - @param ViewItem [in] View item for which snippet is required. - @return Reference to required snippet or nil if view item does not - represent a snippet or if snippet is not user defined. - } public + /// Checks if there are any snippets that can be shared (i.e. + /// exported). + /// Boolean. True if database is not empty, + /// False otherwise. class function CanShare: Boolean; - {Checks if there are any user defined snippets that can be shared (i.e. - exported or submitted. - @return True if user defined snippets exist in database. - } + /// Exports snippets to an export file. + /// IView [in] View item that may contain a + /// snippet. If so the snippet is included in the export file by default. + /// class procedure ExportCode(ViewItem: IView); - {Exports user defined code to an export file. - @param ViewItem [in] View item that may contain a user defined snippet. - If so the snippet is included in the export file by default. - } + /// Imports snippets from an export file. class procedure ImportCode; - {Imports user defined code from an export file. - } end; @@ -72,45 +69,27 @@ implementation { TCodeShareMgr } class function TCodeShareMgr.CanShare: Boolean; - {Checks if there are any user defined snippets that can be shared (i.e. - exported or submitted. - @return True if user defined snippets exist in database. - } begin - Result := not Database.Snippets.IsEmpty( - TCollectionID.__TMP__UserDBCollectionID - ); + Result := not Database.Snippets.IsEmpty; end; class procedure TCodeShareMgr.ExportCode(ViewItem: IView); - {Exports user defined code to an export file. - @param ViewItem [in] View item that may contain a user defined snippet. If - so the snippet is included in the export file by default. - } begin TCodeExportDlg.Execute(nil, GetSnippetFromView(ViewItem)); end; class function TCodeShareMgr.GetSnippetFromView( ViewItem: IView): TSnippet; - {Gets reference to any user defined snippet represented by a view item. - @param ViewItem [in] View item for which snippet is required. - @return Reference to required snippet or nil if view item does not represent - a snippet or if snippet is not user defined. - } var SnippetView: ISnippetView; // ViewItem as snippet view if supported begin - if Supports(ViewItem, ISnippetView, SnippetView) - and (SnippetView.Snippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) then + if Supports(ViewItem, ISnippetView, SnippetView) then Result := SnippetView.Snippet else Result := nil; end; class procedure TCodeShareMgr.ImportCode; - {Imports user defined code from an export file. - } var ImportMgr: TCodeImportMgr; // manages import of code begin From 56fd7b84a86d1e4cef457a4e07542d31bda68988 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 18 Nov 2024 15:18:17 +0000 Subject: [PATCH 106/222] Add hashers and comparers to TSnippet & TSnippetID Added new Hash method to TSnippetID and new CompareTo and Hash methods to TSnippet. Redefined TSnippet.IsEqual in terms of TSnippet.CompareTo. Added new TComparer nested classes to both TSnippetID and TSnippet. Changed TSnippetList and TSnippetIDList to use the new TComparer classes when creating their privte TList<> object, instead of using a TDelegatedComparer class and defining the comparison explicitly. --- Src/DB.USnippet.pas | 72 +++++++++++++++++++++++++++++++++++---------- Src/USnippetIDs.pas | 57 ++++++++++++++++++++++++++++------- 2 files changed, 104 insertions(+), 25 deletions(-) diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 573955009..21fe6c33d 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -107,13 +107,24 @@ TSnippetList = class; TSnippet = class(TObject) public /// Comparer for snippets by display name. - type TDisplayNameComparer = class(TComparer) - public - /// Compares snippets Left and Right. Returns -ve if Left's - /// display name sorts before Right's, 0 if the same or +ve if Left's - /// display name is greater than Right's. - function Compare(const Left, Right: TSnippet): Integer; override; - end; + type + TComparer = class(TInterfacedObject, + IComparer, IEqualityComparer + ) + public + function Compare(const Left, Right: TSnippet): Integer; + function Equals(const Left, Right: TSnippet): Boolean; + reintroduce; + function GetHashCode(const Value: TSnippet): Integer; + reintroduce; + end; + TDisplayNameComparer = class(TComparer) + public + /// Compares snippets Left and Right. Returns -ve if Left's + /// display name sorts before Right's, 0 if the same or +ve if Left's + /// display name is greater than Right's. + function Compare(const Left, Right: TSnippet): Integer; override; + end; strict private fKind: TSnippetKind; // Kind of snippet this is fCategory: string; // Name of snippet's category @@ -165,6 +176,13 @@ type TDisplayNameComparer = class(TComparer) destructor Destroy; override; {Destructor. Tears down object. } + /// Compares this snippet with another. + /// TSnippet [in] Snippet to compare with. + /// + /// Integer. 0 if the snippets are the same, -ve if + /// this snippet is less than Snippets or +ve if this snippet is + /// greater than Snippet. + function CompareTo(const Snippet: TSnippet): Integer; function IsEqual(const Snippet: TSnippet): Boolean; {Checks if this snippet is same as another snippet. Snippets are considered equal if they have the same key and come from the same @@ -176,6 +194,8 @@ type TDisplayNameComparer = class(TComparer) {Checks if snippet can be compiled. @return True if compilation supported and False if not. } + /// Returns the snippets hash code. + function Hash: Integer; property Kind: TSnippetKind read fKind; {Kind of snippet represented by this object} property ID: TSnippetID read GetID; @@ -415,6 +435,11 @@ function TSnippet.CanCompile: Boolean; Result := Kind <> skFreeform; end; +function TSnippet.CompareTo(const Snippet: TSnippet): Integer; +begin + Result := Self.ID.CompareTo(Snippet.ID); +end; + constructor TSnippet.Create(const AKey: string; const ACollectionID: TCollectionID; const Props: TSnippetData); begin @@ -468,6 +493,12 @@ function TSnippet.GetID: TSnippetID; Result := TSnippetID.Create(fKey, fCollectionID); end; +function TSnippet.Hash: Integer; +begin + // Snippet's hash code is the same as the snippet ID's hash code + Result := GetID.Hash; +end; + function TSnippet.IsEqual(const Snippet: TSnippet): Boolean; {Checks if this snippet is same as another snippet. Snippets are considered equal if they have the same key and come from the same collection. @@ -475,7 +506,7 @@ function TSnippet.IsEqual(const Snippet: TSnippet): Boolean; @return True if snippets are equal, False if not. } begin - Result := Snippet.ID = Self.ID; + Result := CompareTo(Snippet) = 0; end; procedure TSnippet.SetKey(const AKey: string); @@ -500,6 +531,23 @@ procedure TSnippet.SetProps(const Data: TSnippetData); fTestInfo := Data.TestInfo; end; +{ TSnippet.TComparer } + +function TSnippet.TComparer.Compare(const Left, Right: TSnippet): Integer; +begin + Result := Left.CompareTo(Right); +end; + +function TSnippet.TComparer.Equals(const Left, Right: TSnippet): Boolean; +begin + Result := Left.IsEqual(Right); +end; + +function TSnippet.TComparer.GetHashCode(const Value: TSnippet): Integer; +begin + Result := Value.Hash; +end; + { TSnippet.TDisplayNameComparer } function TSnippet.TDisplayNameComparer.Compare(const Left, @@ -686,13 +734,7 @@ constructor TSnippetList.Create(const OwnsObjects: Boolean = False); begin inherited Create; fList := TSortedObjectList.Create( - TDelegatedComparer.Create( - function (const Left, Right: TSnippet): Integer - begin - Result := Left.ID.CompareTo(Right.ID); - end - ), - OwnsObjects + TSnippet.TComparer.Create, OwnsObjects ); fList.PermitDuplicates := False; end; diff --git a/Src/USnippetIDs.pas b/Src/USnippetIDs.pas index 0cad2c12b..adfd71065 100644 --- a/Src/USnippetIDs.pas +++ b/Src/USnippetIDs.pas @@ -19,6 +19,7 @@ interface uses // Delphi Generics.Collections, + Generics.Defaults, // Project IntfCommon, DB.UCollections; @@ -37,6 +38,18 @@ TSnippetID = record procedure SetKey(const AValue: string); procedure SetCollectionID(const AValue: TCollectionID); public + type + TComparer = class(TInterfacedObject, + IComparer, IEqualityComparer + ) + public + function Compare(const Left, Right: TSnippetID): Integer; + function Equals(const Left, Right: TSnippetID): Boolean; + reintroduce; + function GetHashCode(const Value: TSnippetID): Integer; + reintroduce; + end; + /// Snippet's key. property Key: string read fKey write SetKey; @@ -59,6 +72,9 @@ TSnippetID = record /// SID or +ve if this record greater than SID. function CompareTo(const SID: TSnippetID): Integer; + /// Returns the snippet ID's hash code. + function Hash: Integer; + /// Compares two snippet keys. /// string [in] First key. /// string [in] Second key. @@ -154,7 +170,7 @@ implementation uses // Delphi - SysUtils, Generics.Defaults, + SysUtils, // Project UStrUtils; @@ -175,7 +191,6 @@ function TSnippetID.CompareTo(const SID: TSnippetID): Integer; begin Result := CompareKeys(Key, SID.Key); if Result = 0 then - // TODO -cNote: New comparison changes ordering (no problem tho!) Result := TCollectionID.Compare(CollectionID, SID.CollectionID); end; @@ -191,6 +206,18 @@ constructor TSnippetID.Create(const AKey: string; Result := SID1.CompareTo(SID2) = 0; end; +function TSnippetID.Hash: Integer; +var + PartialHash: Integer; + KeyBytes: TBytes; +begin + // Hash is created from hash of CollectionID property combined with hash of + // Key property after converting to a byte array in UTF8 format. + PartialHash := fCollectionID.Hash; + KeyBytes := TEncoding.UTF8.GetBytes(fKey); + Result := BobJenkinsHash(KeyBytes[0], Length(KeyBytes), PartialHash); +end; + class operator TSnippetID.NotEqual(const SID1, SID2: TSnippetID): Boolean; begin Result := not (SID1 = SID2); @@ -208,6 +235,23 @@ procedure TSnippetID.SetKey(const AValue: string); Assert(fKey <> '', 'TSnippetID.SetKey: Value is whitespace or empty'); end; +{ TSnippetID.TComparer } + +function TSnippetID.TComparer.Compare(const Left, Right: TSnippetID): Integer; +begin + Result := Left.CompareTo(Right); +end; + +function TSnippetID.TComparer.Equals(const Left, Right: TSnippetID): Boolean; +begin + Result := Left = Right; +end; + +function TSnippetID.TComparer.GetHashCode(const Value: TSnippetID): Integer; +begin + Result := Value.Hash; +end; + { TSnippetIDList } function TSnippetIDList.Add(const SnippetID: TSnippetID): Integer; @@ -244,14 +288,7 @@ function TSnippetIDList.Count: Integer; constructor TSnippetIDList.Create; begin inherited; - fList := TList.Create( - TDelegatedComparer.Create( - function(const Left, Right: TSnippetID): Integer - begin - Result := Left.CompareTo(Right); - end - ) - ); + fList := TList.Create(TSnippetID.TComparer.Create); end; destructor TSnippetIDList.Destroy; From 805a6a78cf896f9e7c9cce9fb0baa2346e714a19 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 18 Nov 2024 16:46:20 +0000 Subject: [PATCH 107/222] Update code importer snippet dependency rules. Previously UCodeImportMgr checked whether any snippets in an imported snippet's depends list were in either the user or main databases and deleted them if not found in either. The importer now requires that imported snippets can only list snippets in their depends list if those snippets are also in the import. Any snippets that are not in the import are removed from depends lists. This was required to remove code that required the DCS collection to be present, which can no longer be guaranteed. Additionally, it's dangerous to assume that any snippet outside the import whose key is referenced from the import is the same snippet as was intended. All imported snippets are now given a new key within the chosen collection. UCodeImportMgr had to be heavily overhauled to get this new system to work. In particular the use of new keys meant that the depends lists needed to be fixed up with new keys. --- Src/UCodeImportMgr.pas | 137 ++++++++++++++++++++++++++++------------- 1 file changed, 93 insertions(+), 44 deletions(-) diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index 1a5ff89b6..775d9f28f 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -36,14 +36,18 @@ TImportInfo = record strict private // Property values fOrigKey: string; + fNewKey: string; fDisplayName: string; fSkip: Boolean; public /// Initialises properties to given values. - constructor Create(const AOrigKey, ADisplayName: string; + constructor Create(const AOrigKey, ANewKey, ADisplayName: string; const ASkip: Boolean = False); /// Snippet key per import file. property OrigKey: string read fOrigKey; + /// New, unique snippet key under which the snippet will be + /// imported. + property NewKey: string read fNewKey; /// Snippet's display name. property DisplayName: string read fDisplayName; /// Flag indicating if snippet is to be skipped (ignored) when @@ -120,9 +124,12 @@ TCodeImportMgr = class sealed(TObject) /// customisation. procedure Import(const FileName: string); /// Updates database based on imported snippets and customisation - /// described by ImportInfo property. - /// Any existing snippets with same name as imported snippets are - /// overwritten. + /// described by ImportInfo property, using collection specified in + /// RequestCollectionCallback. + /// Any snippets referenced in the an imported snippet's + /// Depends or XRefs property must also be included in the + /// import otherwise the snippet is stripped from the dependency list. + /// procedure UpdateDatabase; /// List of information describing if and how to import snippets /// in import file. Permits customisation of import. @@ -153,6 +160,7 @@ implementation ActiveText.UMain, DB.UMain, DB.USnippet, + IntfCommon, UIOUtils, USnippetIDs, UStrUtils; @@ -207,6 +215,9 @@ procedure TCodeImportMgr.InitImportInfoList; fImportInfoList.Add( TImportInfo.Create( SnippetInfo.Key, + (Database as IDatabaseEdit).GetUniqueSnippetKey( + RequestCollectionCallback + ), StrIf( SnippetInfo.Data.Props.DisplayName = '', SnippetInfo.Key, @@ -219,70 +230,108 @@ procedure TCodeImportMgr.InitImportInfoList; procedure TCodeImportMgr.UpdateDatabase; - // Adjusts a snippet's dependency list so that main database is searched for a - // required snippet if it is not in the user database. - procedure AdjustDependsList(const Depends: ISnippetIDList); + // Adjusts a snippet's references list to exclude snippets not included in the + // import. + function AdjustRefsList(const ARefs: ISnippetIDList): ISnippetIDList; var - Idx: Integer; // loops through dependencies SnippetID: TSnippetID; // each snippet ID in dependency list - CollectionID: TCollectionID; + Info: TImportInfo; begin - // NOTE: The data file format does not record which database a required - // snippet belongs to, so we first look in the user database and if it's - // not there, we assume the main database - for Idx := 0 to Pred(Depends.Count) do + // We only include snippets in depends list if it is included in the import + Result := TSnippetIDList.Create; + for SnippetID in ARefs do begin - SnippetID := Depends[Idx]; - CollectionID := TCollectionID.__TMP__UserDBCollectionID; - if Database.Snippets.Find(SnippetID.Key, CollectionID) = nil then - CollectionID := TCollectionID.__TMP__MainDBCollectionID; - SnippetID.CollectionID := CollectionID; - Depends[Idx] := SnippetID; + if fImportInfoList.FindByKey(SnippetID.Key, Info) and not Info.Skip then + Result.Add(TSnippetID.Create(Info.NewKey, SnippetID.CollectionID)); end; end; +type + // Record used to save a snippet's references + TSavedReferences = record + Snippet: TSnippet; + Data: TSnippetEditData; + end; + var - Editor: IDatabaseEdit; // object used to update user database - Snippet: TSnippet; // reference any existing snippet to overwrite - SnippetInfo: TSnippetInfo; // info about each snippet from import file - ImportInfo: TImportInfo; // info about how / whether to import a snippet - CollectionID: TCollectionID; - SnippetKey: string; + Editor: IDatabaseEdit; // object used to update user database + SnippetInfo: TSnippetInfo; // info about each snippet from import file + ImportInfo: TImportInfo; // info about how / whether to import a snippet + CollectionID: TCollectionID; // collection into which we're importing + SavedRefs: TList; // preserved references for each snippet + SavedRef: TSavedReferences; // each record in Refs list + SnippetDataNoRefs: TSnippetEditData; // snippet data with references cleared resourcestring // Error message sBadNameError = 'Can''t find snippet with key "%s" in import data'; begin + {TODO -cRefactor: Tidy up messy use of both fSnippetInfoList and + fImportInfoList: include all required info in fImportInfoList? + } + Editor := Database as IDatabaseEdit; CollectionID := RequestCollectionCallback(); - for SnippetInfo in fSnippetInfoList do - begin - if not fImportInfoList.FindByKey(SnippetInfo.Key, ImportInfo) then - raise EBug.CreateFmt(sBadNameError, [SnippetInfo.Key]); - if ImportInfo.Skip then - Continue; + SavedRefs := TList.Create( + TDelegatedComparer.Create( + function (const Left, Right: TSavedReferences): Integer + begin + Result := Left.Snippet.CompareTo(Right.Snippet); + end + ) + ); + try + for SnippetInfo in fSnippetInfoList do + begin + if not fImportInfoList.FindByKey(SnippetInfo.Key, ImportInfo) then + raise EBug.CreateFmt(sBadNameError, [SnippetInfo.Key]); + + if ImportInfo.Skip then + Continue; + + // Exclude snippet from depends list if snippet not included in import. + (SnippetInfo.Data.Refs.Depends as IAssignable).Assign( + AdjustRefsList(SnippetInfo.Data.Refs.Depends) + ); + + // store snippet data with references + SavedRef.Data.Assign(SnippetInfo.Data); + + // clear references before adding snippet: it will probably delete most + // anyway if reference is to a snippet after this one in the import list + SnippetDataNoRefs.Assign(SnippetInfo.Data); + // .. XRef should be clear regardless, because XRefs not included in + // export files. + SnippetDataNoRefs.Refs.XRef.Clear; + SnippetDataNoRefs.Refs.Depends.Clear; + + // add snippet without any dependency + SavedRef.Snippet := Editor.AddSnippet( + ImportInfo.NewKey, CollectionID, SnippetDataNoRefs + ); + + // save snippet with its dependencies + SavedRefs.Add(SavedRef); + end; - AdjustDependsList(SnippetInfo.Data.Refs.Depends); + // Add back the saved snippet references + for SavedRef in SavedRefs do + if SavedRef.Data.Refs.Depends.Count > 0 then + Editor.UpdateSnippet(SavedRef.Snippet, SavedRef.Data); - Snippet := Database.Snippets.Find(ImportInfo.OrigKey, CollectionID); - if Assigned(Snippet) then - SnippetKey := (Database as IDatabaseEdit).GetUniqueSnippetKey( - CollectionID - ) - else - SnippetKey := ImportInfo.OrigKey; - Editor.AddSnippet(SnippetKey, CollectionID, SnippetInfo.Data); - {TODO -cVault: Reintroduce the option to overwrite a snippet with matching - ID, but allow user to select whether this can happen.} + finally + SavedRefs.Free; end; + end; { TImportInfo } -constructor TImportInfo.Create(const AOrigKey, ADisplayName: string; +constructor TImportInfo.Create(const AOrigKey, ANewKey, ADisplayName: string; const ASkip: Boolean = False); begin fOrigKey := AOrigKey; + fNewKey := ANewKey; fSkip := ASkip; fDisplayName := ADisplayName; end; @@ -315,7 +364,7 @@ function TImportInfoList.FindByKey(const Key: string; function TImportInfoList.IndexOfKey(const Key: string): Integer; begin - Result := IndexOf(TImportInfo.Create(Key, '')); + Result := IndexOf(TImportInfo.Create(Key, '', '')); end; procedure TImportInfoList.SetSkip(const AKey: string; const AFlag: Boolean); From 48bd621f9098c14dd5c47db24914612d54a43ba4 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 18 Nov 2024 17:04:30 +0000 Subject: [PATCH 108/222] Revise snippet exporter re changes in importer TCodeExporter was modified to not include the keys of snippets in depends lists for snippets not themselved included in the export. Also fixed an error where the old snippet ID for snippets included in the export was being used in depend lists. This meant that no snippet depends lists were ever imported. TCodeExporter was modified to ensure that exported dependency lists use the same key as the changed snippet key. --- Src/UCodeImportExport.pas | 44 ++++++++++++++++++++++++++------------- 1 file changed, 30 insertions(+), 14 deletions(-) diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index c90d10d7d..44047f7e5 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -20,12 +20,14 @@ interface SysUtils, Classes, XMLIntf, + Generics.Collections, // Project DB.UCategory, DB.USnippet, UBaseObjects, UEncodings, UIStringList, + USnippetIDs, UXMLDocHelper, UXMLDocumentEx; @@ -103,6 +105,7 @@ ECodeImporter = class(ECodeSnipXML); TCodeExporter = class(TNoPublicConstructObject) strict private var + fSnippetKeyMap: TDictionary; /// List of snippets to be exported. fSnippets: TSnippetList; /// Extended XML document object. @@ -112,8 +115,11 @@ TCodeExporter = class(TNoPublicConstructObject) /// /// An exception is always raised. procedure HandleException(const EObj: TObject); - /// Returns a list of snippet names from snippets list. - function SnippetNames(const SnipList: TSnippetList): IStringList; + /// Returns a list of snippet keys for each snippet in + /// SnipList. Returned keys are found by looking up the new key + /// corresponding to the snippet's original key in fSnippetKeyMap. + /// + function SnippetKeys(const SnipList: TSnippetList): IStringList; /// Writes a XML node that contains a list of pascal names. /// /// IXMLNode [in] Node under which this name list @@ -180,7 +186,6 @@ implementation DB.USnippetKind, UAppInfo, USnippetExtraHelper, - USnippetIDs, UStructs, UStrUtils, UXMLDocConsts; @@ -198,6 +203,7 @@ implementation destructor TCodeExporter.Destroy; begin + fSnippetKeyMap.Free; fXMLDoc := nil; inherited; end; @@ -254,19 +260,30 @@ procedure TCodeExporter.HandleException(const EObj: TObject); end; constructor TCodeExporter.InternalCreate(const SnipList: TSnippetList); +var + Snippet: TSnippet; begin inherited InternalCreate; fSnippets := SnipList; + fSnippetKeyMap := TDictionary.Create( + TSnippetID.TComparer.Create + ); + // Create map of actual snippet ID to new unique key with default collection + for Snippet in SnipList do + fSnippetKeyMap.Add( + Snippet.ID, + (Database as IDatabaseEdit).GetUniqueSnippetKey(TCollectionID.Default) + ); end; -function TCodeExporter.SnippetNames( - const SnipList: TSnippetList): IStringList; +function TCodeExporter.SnippetKeys(const SnipList: TSnippetList): IStringList; var Snippet: TSnippet; // references each snippet in list begin Result := TIStringList.Create; for Snippet in SnipList do - Result.Add(Snippet.Key); + if fSnippetKeyMap.ContainsKey(Snippet.ID) then + Result.Add(fSnippetKeyMap[Snippet.ID]); end; procedure TCodeExporter.WriteProgInfo(const ParentNode: IXMLNode); @@ -293,14 +310,13 @@ procedure TCodeExporter.WriteSnippet(const ParentNode: IXMLNode; var SnippetNode: IXMLNode; // new snippet node begin - // Create snippet node with attribute that specifies snippet key + // Create snippet node with attribute that specifies snippet key. + // Snippet is exported under a new, unique key within the Default collection. + // Since no collection information is saved, we need choose one collection in + // order to generate the key, and the Default collection is the only one + // guaranteed to be present. SnippetNode := fXMLDoc.CreateElement(ParentNode, cSnippetNode); - // Export snippet under a new unique key within the default collection - // we use default collection because code importer assumes snippet id from - // that collection. We create new unique key because more than one snippet - // could be exported that have the same key but are in different collections. - SnippetNode.Attributes[cSnippetNameAttr] := - (Database as IDatabaseEdit).GetUniqueSnippetKey(TCollectionID.Default); + SnippetNode.Attributes[cSnippetNameAttr] := fSnippetKeyMap[Snippet.ID]; // Add nodes for properties: (ignore category and xrefs) // description node is written even if empty (which it shouldn't be) fXMLDoc.CreateElement( @@ -335,7 +351,7 @@ procedure TCodeExporter.WriteSnippet(const ParentNode: IXMLNode; ); // depends and units lists WriteReferenceList( - SnippetNode, cDependsNode, SnippetNames(Snippet.Depends) + SnippetNode, cDependsNode, SnippetKeys(Snippet.Depends) ); WriteReferenceList( SnippetNode, cUnitsNode, TIStringList.Create(Snippet.Units) From ddb1f74e79cd28919202d1fabcf930dcc7986582 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 18 Nov 2024 17:31:16 +0000 Subject: [PATCH 109/222] Simplify CSS class names in Details pane Replaced the three separate CSS classes used to colour the heading in the Details pane, depending on whether the view being displayed was a group or a snippet. Inter-alia removed check for main and user database to determine CSS class name. A single, hard coded class name is now used and FrDetailView now determines the correct colour for the class, depending on the view. Removed related <% %> templates from .html template files and removed associated template resolution code from UDetailPageHTML. --- Src/FrDetailView.pas | 9 ++------- Src/Res/HTML/info-empty-selection-tplt.html | 2 +- Src/Res/HTML/info-snippet-list-tplt.html | 2 +- Src/Res/HTML/info-snippet-tplt.html | 2 +- Src/UDetailPageHTML.pas | 15 --------------- 5 files changed, 5 insertions(+), 25 deletions(-) diff --git a/Src/FrDetailView.pas b/Src/FrDetailView.pas index e8e8cbff5..74a90931a 100644 --- a/Src/FrDetailView.pas +++ b/Src/FrDetailView.pas @@ -235,13 +235,8 @@ procedure TDetailViewFrame.BuildCSS(const CSSBuilder: TCSSBuilder); CSSBuilder.AddSelector('.optionbox') .AddProperty(TCSS.BorderProp(cssAll, 1, cbsSolid, clBorder)); - // Heading colours for user & main databases - {TODO -vault: replace all following classes with single ".heading" class} - CSSBuilder.AddSelector('.userdb') - .AddProperty(TCSS.ColorProp(fHeadingColour)); - CSSBuilder.AddSelector('.maindb') - .AddProperty(TCSS.ColorProp(fHeadingColour)); - CSSBuilder.AddSelector('.group-heading') + // Heading colour + CSSBuilder.AddSelector('.heading') .AddProperty(TCSS.ColorProp(fHeadingColour)); // Sets CSS for style of New Tab text diff --git a/Src/Res/HTML/info-empty-selection-tplt.html b/Src/Res/HTML/info-empty-selection-tplt.html index dd2b9fdd3..208243076 100644 --- a/Src/Res/HTML/info-empty-selection-tplt.html +++ b/Src/Res/HTML/info-empty-selection-tplt.html @@ -23,7 +23,7 @@ -

+

<%Heading%>

diff --git a/Src/Res/HTML/info-snippet-list-tplt.html b/Src/Res/HTML/info-snippet-list-tplt.html index e762589f9..3e929ec7a 100644 --- a/Src/Res/HTML/info-snippet-list-tplt.html +++ b/Src/Res/HTML/info-snippet-list-tplt.html @@ -27,7 +27,7 @@ -

+

<%Heading%>

diff --git a/Src/Res/HTML/info-snippet-tplt.html b/Src/Res/HTML/info-snippet-tplt.html index a362b8bdc..82eebbeaf 100644 --- a/Src/Res/HTML/info-snippet-tplt.html +++ b/Src/Res/HTML/info-snippet-tplt.html @@ -64,7 +64,7 @@ >Edit Snippet -

+

<%SnippetName%>

diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 78727dab8..39bfc4bc0 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -238,11 +238,6 @@ TSnippetListPageHTML = class abstract(TDetailPageTpltHTML) /// snippets to be displayed. function IsSnippetRequired(const Snippet: TSnippet): Boolean; virtual; abstract; - /// Returns name of CSS class to be used for page heading. - /// - /// Provides default class name. Descendant classes should - /// override as necessary. - function GetH1ClassName: string; virtual; /// Returns page's heading text. /// Returns view's description by default. Descendants can /// override if different behaviour is required. @@ -517,10 +512,6 @@ procedure TSnippetInfoPageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); 'overflowXFixScript', 'window.onload = null;' ); - if GetSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID then - Tplt.ResolvePlaceholderHTML('SnippetCSSClass', 'userdb') - else - Tplt.ResolvePlaceholderHTML('SnippetCSSClass', 'maindb'); Tplt.ResolvePlaceholderHTML( 'TestingInfo', TCSS.BlockDisplayProp(GetSnippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID) ); @@ -576,11 +567,6 @@ destructor TSnippetListPageHTML.Destroy; inherited; end; -function TSnippetListPageHTML.GetH1ClassName: string; -begin - Result := 'group-heading'; -end; - function TSnippetListPageHTML.GetHeading: string; begin Result := View.Description; @@ -602,7 +588,6 @@ function TSnippetListPageHTML.HaveSnippets: Boolean; procedure TSnippetListPageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); begin inherited; - Tplt.ResolvePlaceholderHTML('H1Class', GetH1ClassName); Tplt.ResolvePlaceholderText('Heading', GetHeading); if HaveSnippets then begin From 1982c43d7b350241952cdce9fe823c387c1a2091 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 18 Nov 2024 19:32:15 +0000 Subject: [PATCH 110/222] Restyle snippet details pane The snippets details pane used to appear differently depending on whether the snippet came from the "user" or "main" databases. The former displayed an "Edit Snippet" link while the latter displayed a test info glyph in the same place. Now all snippets display both pieces of information. The test info glyph now appears after the snippet display name and an edit snippet clickable glyph remains on the right of the heading line, but without the "Edit Snippet" text. Implementing this change required some changes to the info-snippet-tplt.html template file and the CSS in detail.css. Some other CSS was moved from the HTML file into details.css. --- Src/Res/CSS/detail.css | 11 +++++++++-- Src/Res/HTML/info-snippet-tplt.html | 19 +++---------------- Src/UDetailPageHTML.pas | 9 +-------- 3 files changed, 13 insertions(+), 26 deletions(-) diff --git a/Src/Res/CSS/detail.css b/Src/Res/CSS/detail.css index 47e097417..1df9e3dd8 100644 --- a/Src/Res/CSS/detail.css +++ b/Src/Res/CSS/detail.css @@ -170,10 +170,17 @@ pre { } .testing-img { - float: right; width: 16px; height: 16px; padding: 0; - margin: 2px 0 0 8px; + margin: 0 0 0 8px; + vertical-align: middle; } +#editlink { + padding-top: 2px; + margin: 0; + float: right; + vertical-align: baseline; + text-align: right; +} diff --git a/Src/Res/HTML/info-snippet-tplt.html b/Src/Res/HTML/info-snippet-tplt.html index 82eebbeaf..1d44327f4 100644 --- a/Src/Res/HTML/info-snippet-tplt.html +++ b/Src/Res/HTML/info-snippet-tplt.html @@ -34,15 +34,9 @@
-
- <%TestingInfoImg%> -
- - +

- <%SnippetName%> + <%SnippetName%><%TestingInfoImg%>

diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 39bfc4bc0..1f7905dac 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -512,12 +512,6 @@ procedure TSnippetInfoPageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); 'overflowXFixScript', 'window.onload = null;' ); - Tplt.ResolvePlaceholderHTML( - 'TestingInfo', TCSS.BlockDisplayProp(GetSnippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID) - ); - Tplt.ResolvePlaceholderHTML( - 'EditLink', TCSS.BlockDisplayProp(GetSnippet.CollectionID <> TCollectionID.__TMP__MainDBCollectionID) - ); Tplt.ResolvePlaceholderText( 'EditEventHandler', TJavaScript.LiteralFunc( @@ -526,8 +520,7 @@ procedure TSnippetInfoPageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); ); SnippetHTML := TSnippetHTML.Create(GetSnippet); try - if GetSnippet.CollectionID = TCollectionID.__TMP__MainDBCollectionID then - Tplt.ResolvePlaceholderHTML('TestingInfoImg', SnippetHTML.TestingImage); + Tplt.ResolvePlaceholderHTML('TestingInfoImg', SnippetHTML.TestingImage); Tplt.ResolvePlaceholderHTML('SnippetName', SnippetHTML.SnippetName); finally SnippetHTML.Free; From 5d313fda819fb24b3d5fa6d0cb2002ba57744d96 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 18 Nov 2024 19:43:01 +0000 Subject: [PATCH 111/222] Replace update action testing for nonempty user db The ActNonEmptyUserDBUpdate action update event handler that tested for a non-empty user database was removed and calls to it were replaced by calls to ActNonEmptyDBUpdate that makes no such tests. NOTE: menu actions that used this event handler to enable/disable them are still "User Database" specific and need to be removed or replaced. --- Src/FmMain.dfm | 6 +++--- Src/FmMain.pas | 8 -------- 2 files changed, 3 insertions(+), 11 deletions(-) diff --git a/Src/FmMain.dfm b/Src/FmMain.dfm index 902e71720..038f30d30 100644 --- a/Src/FmMain.dfm +++ b/Src/FmMain.dfm @@ -619,7 +619,7 @@ inherited MainForm: TMainForm Hint = 'Backup user database|Backup the user-defined snippet database' ImageIndex = 33 OnExecute = actBackupDatabaseExecute - OnUpdate = ActNonEmptyUserDBUpdate + OnUpdate = ActNonEmptyDBUpdate end object actRestoreDatabase: TAction Category = 'Database' @@ -850,7 +850,7 @@ inherited MainForm: TMainForm 'Move user database|Move the user-defined snippet database to a n' + 'ew directory' OnExecute = actMoveUserDatabaseExecute - OnUpdate = ActNonEmptyUserDBUpdate + OnUpdate = ActNonEmptyDBUpdate end object actSWAGImport: TAction Category = 'Snippets' @@ -875,7 +875,7 @@ inherited MainForm: TMainForm 'Delete User Database|Deletes the user'#39's snippets database - USE ' + 'WITH CAUTION' OnExecute = actDeleteUserDatabaseExecute - OnUpdate = ActNonEmptyUserDBUpdate + OnUpdate = ActNonEmptyDBUpdate end end object mnuMain: TMainMenu diff --git a/Src/FmMain.pas b/Src/FmMain.pas index 25e81385b..0d9c56435 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -500,7 +500,6 @@ TMainForm = class(THelpAwareForm) /// position is permitted and blocks the move if not. procedure splitVertCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); - procedure ActNonEmptyUserDBUpdate(Sender: TObject); strict private var /// Object that notifies user-initiated events by triggering @@ -941,13 +940,6 @@ procedure TMainForm.ActNonEmptyDBUpdate(Sender: TObject); (Sender as TAction).Enabled := not Database.Snippets.IsEmpty; end; -procedure TMainForm.ActNonEmptyUserDBUpdate(Sender: TObject); -begin - (Sender as TAction).Enabled := not Database.Snippets.IsEmpty( - TCollectionID.__TMP__UserDBCollectionID - ); -end; - procedure TMainForm.ActOverviewTabExecute(Sender: TObject); begin // Action's Tag property specifies index of tab being selected From 41902456fc7cc5c3ea9ed9304a08424a3e7188f1 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 18 Nov 2024 23:37:33 +0000 Subject: [PATCH 112/222] Change Database move code to move any collection The code in UUserDBMove was modified to move any collection's data files instead of only the "user database". FmUserDataPathDlg was also modified to work with the revised UUserDBMove. In addition, the facility to restore the "user database" to its default location was removed since there is no concept as a default location for collections. Text in FmUserDataPathDlg and UUserDBMove was changed to refer to collections instead of databases. Comments in both units were similarly updated. Text and hints in the relevant menu item in FmMain was changed to refer to collection instead of user database. --- Src/FmMain.dfm | 6 +- Src/FmUserDataPathDlg.dfm | 219 +++++++++++++++----------------------- Src/FmUserDataPathDlg.pas | 191 ++++++++++++++++++--------------- Src/UUserDBMove.pas | 63 +++++------ 4 files changed, 231 insertions(+), 248 deletions(-) diff --git a/Src/FmMain.dfm b/Src/FmMain.dfm index 038f30d30..e8cf1d1b8 100644 --- a/Src/FmMain.dfm +++ b/Src/FmMain.dfm @@ -845,10 +845,10 @@ inherited MainForm: TMainForm end object actMoveUserDatabase: TAction Category = 'Database' - Caption = 'Move User Database...' + Caption = 'Move Collection Data Files...' Hint = - 'Move user database|Move the user-defined snippet database to a n' + - 'ew directory' + 'Move a collection|Move a collection'#39's data files to a new direct' + + 'ory' OnExecute = actMoveUserDatabaseExecute OnUpdate = ActNonEmptyDBUpdate end diff --git a/Src/FmUserDataPathDlg.dfm b/Src/FmUserDataPathDlg.dfm index 014df9466..450a69321 100644 --- a/Src/FmUserDataPathDlg.dfm +++ b/Src/FmUserDataPathDlg.dfm @@ -1,5 +1,5 @@ inherited UserDataPathDlg: TUserDataPathDlg - Caption = 'Move User Database' + Caption = 'Move Collection Data' ExplicitWidth = 474 ExplicitHeight = 375 PixelsPerInch = 96 @@ -16,20 +16,20 @@ inherited UserDataPathDlg: TUserDataPathDlg Height = 25 AutoSize = False Caption = - 'Use this dialogue box to move the user database to a new directo' + - 'ry or to restore the directory to its default location. Choose t' + - 'he appropriate option below.' + 'Use this dialogue box to move a collection'#39's data to a new direc' + + 'tory.'#13#10'Choose the collection whose data you wish to move then en' + + 'ter the directory you wish to move the data to.' WordWrap = True end object lblWarning: TLabel Left = 0 - Top = 32 + Top = 31 Width = 377 - Height = 20 + Height = 34 AutoSize = False Caption = - 'You are strongly advised to make a backup of the database before' + - ' continuing.' + 'You are strongly advised to make a backup of the collection befo' + + 're continuing.' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 @@ -38,137 +38,45 @@ inherited UserDataPathDlg: TUserDataPathDlg ParentFont = False WordWrap = True end - object gbMove: TGroupBox + object lblPath: TLabel Left = 0 - Top = 59 - Width = 377 - Height = 140 - Caption = 'Move database to new directory' + Top = 125 + Width = 217 + Height = 13 + Caption = 'Enter the full path of the new data &directory:' + FocusControl = edPath Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' - Font.Style = [fsBold] + Font.Style = [] ParentFont = False - TabOrder = 0 - object lblPath: TLabel - Left = 8 - Top = 20 - Width = 240 - Height = 13 - Caption = 'Enter the full path to the new database &directory:' - FocusControl = edPath - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - end - object lblExplainMove: TLabel - Left = 8 - Top = 66 - Width = 361 - Height = 34 - AutoSize = False - Caption = - 'The directory must be empty and must not be a sub-directory of t' + - 'he current database directory. If the directory does not exist a' + - ' new one will be created.' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - WordWrap = True - end - object edPath: TEdit - Left = 8 - Top = 39 - Width = 325 - Height = 21 - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 0 - end - object btnBrowse: TButton - Left = 341 - Top = 39 - Width = 27 - Height = 21 - Action = actBrowse - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 1 - end - object btnMove: TButton - Left = 112 - Top = 86 - Width = 153 - Height = 41 - Action = actMove - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 2 - end end - object gbRestore: TGroupBox + object lblExplainMove: TLabel Left = 0 - Top = 208 - Width = 377 - Height = 112 - Caption = 'Restore database to default directory' + Top = 171 + Width = 361 + Height = 62 + AutoSize = False + Caption = + 'The directory must be empty and must not be a sub-directory of t' + + 'he current collection'#39's data directory. If the directory does no' + + 't exist a new one will be created.' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' - Font.Style = [fsBold] + Font.Style = [] ParentFont = False - TabOrder = 1 - object lblExplainDefaultPath: TLabel - Left = 8 - Top = 20 - Width = 361 - Height = 34 - AutoSize = False - Caption = - 'Use this button to restore the database to its default directory' + - '. This option is only available if the database has been moved.' - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - WordWrap = True - end - object btnDefaultPath: TButton - Left = 112 - Top = 61 - Width = 153 - Height = 41 - Action = actDefaultPath - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - ParentFont = False - TabOrder = 0 - end + WordWrap = True + end + object lblCollection: TLabel + Left = 0 + Top = 71 + Width = 122 + Height = 13 + Caption = 'Select &collection to move:' + FocusControl = cbCollection end inline frmProgress: TProgressFrame Left = 57 @@ -176,14 +84,66 @@ inherited UserDataPathDlg: TUserDataPathDlg Width = 320 Height = 82 ParentBackground = False - TabOrder = 2 + TabOrder = 4 Visible = False ExplicitLeft = 57 ExplicitHeight = 82 inherited pnlBody: TPanel Height = 82 + ExplicitLeft = 55 + ExplicitTop = 72 + ExplicitHeight = 82 end end + object btnMove: TButton + Left = 87 + Top = 199 + Width = 153 + Height = 41 + Action = actMove + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 3 + end + object edPath: TEdit + Left = 0 + Top = 144 + Width = 325 + Height = 21 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 1 + end + object btnBrowse: TButton + Left = 331 + Top = 144 + Width = 27 + Height = 21 + Action = actBrowse + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 2 + end + object cbCollection: TComboBox + Left = 0 + Top = 88 + Width = 358 + Height = 21 + Style = csDropDownList + TabOrder = 0 + end end object alDlg: TActionList Left = 152 @@ -192,11 +152,6 @@ inherited UserDataPathDlg: TUserDataPathDlg Caption = '...' OnExecute = actBrowseExecute end - object actDefaultPath: TAction - Caption = '&Restore Default Path' - OnExecute = actDefaultPathExecute - OnUpdate = actDefaultPathUpdate - end object actMove: TAction Caption = '&Move' OnExecute = actMoveExecute diff --git a/Src/FmUserDataPathDlg.pas b/Src/FmUserDataPathDlg.pas index 9c6bbbbbe..314057ac8 100644 --- a/Src/FmUserDataPathDlg.pas +++ b/Src/FmUserDataPathDlg.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2013-2023, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a dialogue box that can be used to move the user database to a + * Implements a dialogue box that can be used to move collection data to a * different directory. } @@ -18,66 +18,67 @@ interface uses // Delphi - SysUtils, Forms, Classes, ActnList, StdCtrls, Controls, ExtCtrls, + SysUtils, + Forms, + Classes, + ActnList, + StdCtrls, + Controls, + ExtCtrls, // Project - FmGenericViewDlg, FrProgress, UBaseObjects, - UControlStateMgr, UUserDBMove; + FmGenericViewDlg, + FrProgress, + UBaseObjects, + UCollectionListAdapter, + UControlStateMgr, + UUserDBMove; type - /// Dialogue box that is used to move the user database to a new - /// directory or to restore a previously moved database to its default + /// Dialogue box that is used to move the collection data to a new /// directory. /// IMPORTANT: This dialogue box is for use only with the standard /// edition of CodeSnip. It MUST NOT be displayed from the portable edition. /// TUserDataPathDlg = class(TGenericViewDlg, INoPublicConstruct) actBrowse: TAction; - actDefaultPath: TAction; actMove: TAction; alDlg: TActionList; - btnBrowse: TButton; - btnDefaultPath: TButton; - btnMove: TButton; - gbMove: TGroupBox; - gbRestore: TGroupBox; - lblExplainDefaultPath: TLabel; - lblExplainMove: TLabel; lblInstructions: TLabel; - lblPath: TLabel; lblWarning: TLabel; - edPath: TEdit; frmProgress: TProgressFrame; + lblPath: TLabel; + lblExplainMove: TLabel; + btnMove: TButton; + edPath: TEdit; + btnBrowse: TButton; + lblCollection: TLabel; + cbCollection: TComboBox; /// Dispays Browse For Folder dialogue box and copies any chosen /// folder to the edPath edit control. procedure actBrowseExecute(Sender: TObject); - /// Moves user database back to default directory and records the - /// changed path. - /// Raises exception if default path can't be used for any - /// reason or if there was an error copying the database. - procedure actDefaultPathExecute(Sender: TObject); - /// Enables / disables Default Path action according to whether - /// database is already in default path. - procedure actDefaultPathUpdate(Sender: TObject); - /// Moves user database to path entered by user and records the - /// changed path. - /// Raises exception given path can't be used for any reason or - /// if there was an error copying the database. + /// Moves the chosen collection to the path entered by the user + /// and records the changed path. + /// Raises exception if the given path can't be used for any + /// reason or if there was an error copying the collection. procedure actMoveExecute(Sender: TObject); /// Enables / disables Move action according to whether a suitable /// path has been entered by user. procedure actMoveUpdate(Sender: TObject); - /// Constructs and initialises form's owned object. + /// Constructs and initialises form's owned objects. procedure FormCreate(Sender: TObject); /// Destroys form's owned objects. procedure FormDestroy(Sender: TObject); strict private var - /// Object that moves the user database to a new location. + /// Object that moves a collection's data to a new location. /// fMover: TUserDBMove; /// Object used to disable and enable all controls on the form. /// fControlStateMgr: TControlStateMgr; + /// Object used to provide and interogate a sorted list of + /// collection names displated in cbCollection. + fCollList: TCollectionListAdapter; /// Sets visibility of all child controls of a parent control. /// /// TWinControl [in] Parent of affected controls. @@ -85,31 +86,33 @@ TUserDataPathDlg = class(TGenericViewDlg, INoPublicConstruct) /// Boolean [in] Flag indicating required visibility. /// Pass True to show the controls and False to hide them. procedure SetVisibility(const ParentCtrl: TWinControl; const Show: Boolean); - /// Performs the database move to the directory given by NewDir, - /// displaying a progress base located over the given host window. - /// + /// Move the chosen collection data to the directory given by + /// NewDir, displaying a progress base located over the given host + /// window. /// The new directory is checked to be empty and the user is asked /// for confirmation. procedure DoMove(const NewDir: string; const ProgressHostCtrl: TWinControl); - /// Handles the database mover object's OnCopyFile event by - /// updating the progress frame. + /// Handles the collection data mover object's OnCopyFile + /// event by updating the progress frame. procedure CopyFileHandler(Sender: TObject; const Percent: Byte); - /// Handles the database mover object's OnDeleteFile event by - /// updating the progress frame. + /// Handles the collectio data mover object's OnDeleteFile + /// event by updating the progress frame. procedure DeleteFileHandler(Sender: TObject; const Percent: Byte); - /// Gets directory entered in edPath edit control. - /// Edit control contents are trimmed of spaces and any trailing - /// path delimiter. + /// Gets the directory entered in the edPath edit control. + /// + /// The edit control contents are trimmed of spaces and any + /// trailing path delimiter. function NewDirFromEditCtrl: string; - /// Handles given exception, converting expected exceptions into - /// ECodeSnip and re-raising all other unchanged. + /// Handles the given exception E, converting expected + /// exceptions into ECodeSnip exceptions and re-raising all other + /// exceptions unchanged. /// Always raises a new exception. /// This method is designed to handle exceptions raised when the - /// user database is moved. + /// collection data is moved. procedure HandleException(const E: Exception); strict protected - /// Sets controls with ParentFont=False to use system default - /// fonts, preserving font styles for those fonts that need them. + /// Initialises the form's controls and associated objects. + /// procedure ConfigForm; override; /// Arranges form's controls and sizes the dialogue box to fit. /// @@ -117,8 +120,8 @@ TUserDataPathDlg = class(TGenericViewDlg, INoPublicConstruct) public /// Displays the dialogue box aligned over the given owner /// control. - /// Raises EBug if called by the portable edition of CodeSnip. - /// + /// Raises EBug if called from the portable edition of + /// CodeSnip. class procedure Execute(AOwner: TComponent); end; @@ -128,10 +131,17 @@ implementation uses // Delphi - IOUtils, + IOUtils, // Project - UAppInfo, UBrowseForFolderDlg, UCtrlArranger, UExceptions, UFontHelper, - UMessageBox, UStrUtils, UStructs; + DB.UCollections, + UAppInfo, + UBrowseForFolderDlg, + UCtrlArranger, + UExceptions, + UFontHelper, + UMessageBox, + UStrUtils, + UStructs; {$R *.dfm} @@ -141,7 +151,7 @@ procedure TUserDataPathDlg.actBrowseExecute(Sender: TObject); var Dlg: TBrowseForFolderDlg; // browse for folder standard dialogue box resourcestring - sDlgTitle = 'Choose Database Directory'; + sDlgTitle = 'Choose Collection Data Directory'; sDlgHeading = 'Choose an empty directory or create a new one'; begin Dlg := TBrowseForFolderDlg.Create(nil); @@ -156,27 +166,18 @@ procedure TUserDataPathDlg.actBrowseExecute(Sender: TObject); end; end; -procedure TUserDataPathDlg.actDefaultPathExecute(Sender: TObject); -begin - DoMove(TAppInfo.DefaultUserDataDir, gbRestore); -end; - -procedure TUserDataPathDlg.actDefaultPathUpdate(Sender: TObject); -begin - actDefaultPath.Enabled := - not StrSameText(TAppInfo.UserDataDir, TAppInfo.DefaultUserDataDir) - and Self.Enabled; -end; - procedure TUserDataPathDlg.actMoveExecute(Sender: TObject); begin - DoMove(NewDirFromEditCtrl, gbMove); + DoMove(NewDirFromEditCtrl, Self); end; procedure TUserDataPathDlg.actMoveUpdate(Sender: TObject); begin actMove.Enabled := (NewDirFromEditCtrl <> '') - and not StrSameText(NewDirFromEditCtrl, TAppInfo.UserDataDir) + and not StrSameText( + NewDirFromEditCtrl, + fCollList.Collection(cbCollection.ItemIndex).Location.Directory + ) and Self.Enabled; end; @@ -186,37 +187,56 @@ procedure TUserDataPathDlg.ArrangeForm; pnlBody.ClientWidth := TCtrlArranger.TotalControlWidth(pnlBody); - TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf(lblPath, 4), [edPath, btnBrowse] + TCtrlArranger.AlignLefts( + [ + lblInstructions, lblWarning, lblCollection, cbCollection, lblPath, edPath, + lblExplainMove + ], + 0 ); - TCtrlArranger.MoveBelow([edPath, btnBrowse], lblExplainMove, 8); - TCtrlArranger.MoveBelow(lblExplainMove, btnMove, 8); - gbMove.ClientHeight := TCtrlArranger.TotalControlHeight(gbMove) + 8; - - TCtrlArranger.MoveBelow(lblExplainDefaultPath, btnDefaultPath, 12); - gbRestore.ClientHeight := TCtrlArranger.TotalControlHeight(gbRestore) + 12; - + // Row 1 + lblInstructions.Top := 0; + lblInstructions.Width := pnlBody.ClientWidth; + // Row 2 TCtrlArranger.MoveBelow(lblInstructions, lblWarning, 8); - TCtrlArranger.MoveBelow(lblWarning, gbMove, 12); - TCtrlArranger.MoveBelow(gbMove, gbRestore, 12); + lblWarning.Width := pnlBody.ClientWidth; + // Row 3 + TCtrlArranger.MoveBelow(lblWarning, lblCollection, 12); + // Row 4 + TCtrlArranger.MoveBelow(lblCollection, cbCollection, 6); + cbCollection.Width := pnlBody.ClientWidth; + // Row 5 + TCtrlArranger.MoveBelow(cbCollection, lblPath, 12); + // Row 6 + TCtrlArranger.AlignRights([btnBrowse], pnlBody.ClientWidth); + edPath.Width := btnBrowse.Left - 6 - edPath.Left; + TCtrlArranger.AlignVCentres( + TCtrlArranger.BottomOf(lblPath, 6), [edPath, btnBrowse] + ); + // Row 7 + TCtrlArranger.MoveBelow([edPath, btnBrowse], lblExplainMove, 12); + lblExplainMove.Width := pnlBody.ClientWidth; + // Row 8 + TCtrlArranger.MoveBelow(lblExplainMove, btnMove, 12); + btnMove.Left := (pnlBody.Width - btnMove.Width) div 2; pnlBody.ClientHeight := TCtrlArranger.TotalControlHeight(pnlBody) + 8; + inherited; end; procedure TUserDataPathDlg.ConfigForm; begin inherited; - TFontHelper.SetDefaultBaseFonts([ - gbMove.Font, gbRestore.Font, lblWarning.Font] - ); + TFontHelper.SetDefaultBaseFonts([lblWarning.Font]); TFontHelper.SetDefaultFonts([ lblPath.Font, edPath.Font, lblExplainMove.Font, - btnBrowse.Font, btnMove.Font, lblExplainDefaultPath.Font, - btnDefaultPath.Font + btnBrowse.Font, btnMove.Font ]); frmProgress.Visible := False; frmProgress.Range := TRange.Create(0, 100); + fCollList.ToStrings(cbCollection.Items); + cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); end; procedure TUserDataPathDlg.CopyFileHandler(Sender: TObject; @@ -245,7 +265,7 @@ procedure TUserDataPathDlg.DoMove(const NewDir: string; const ProgressHostCtrl: TWinControl); resourcestring sNonEmptyDir = 'The specified directory is not empty.'; - sConfirmMsg = 'Are you sure you want to move the database?'; + sConfirmMsg = 'Are you sure you want to move the collection data?'; begin if TDirectory.Exists(NewDir) and not TDirectory.IsEmpty(NewDir) then @@ -258,7 +278,9 @@ procedure TUserDataPathDlg.DoMove(const NewDir: string; SetVisibility(ProgressHostCtrl, False); frmProgress.Show(ProgressHostCtrl); try - fMover.MoveTo(NewDir); + fMover.MoveTo( + fCollList.Collection(cbCollection.ItemIndex), NewDir + ); except on E: Exception do HandleException(E); @@ -278,6 +300,7 @@ class procedure TUserDataPathDlg.Execute(AOwner: TComponent); {$ENDIF} begin {$IFDEF PORTABLE} + {TODO -cVault: Permit this, but restrict to sub-dirs of install dir} raise EBug.Create(ClassName + '.Execute: Call forbidden in portable edition'); {$ELSE} Dlg := InternalCreate(AOwner); @@ -296,10 +319,12 @@ procedure TUserDataPathDlg.FormCreate(Sender: TObject); fMover.OnCopyFile := CopyFileHandler; fMover.OnDeleteFile := DeleteFileHandler; fControlStateMgr := TControlStateMgr.Create(Self); + fCollList := TCollectionListAdapter.Create; end; procedure TUserDataPathDlg.FormDestroy(Sender: TObject); begin + fCollList.Free; fControlStateMgr.Free; fMover.Free; inherited; diff --git a/Src/UUserDBMove.pas b/Src/UUserDBMove.pas index 946062070..98f3a6fb0 100644 --- a/Src/UUserDBMove.pas +++ b/Src/UUserDBMove.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2013-2021, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a class that moves the user defined database to a new location. + * Implements a class that moves a collection's data to a new location. } @@ -17,17 +17,18 @@ interface uses // Project + DB.UCollections, UDirectoryCopier; type - /// Class that moves the user defined database to a new location. + /// Class that moves a collection's data to a new location. /// TUserDBMove = class(TObject) public type - /// Type of event triggered by TUserDBMove to report progress - /// when moving the database files. + /// Type of event triggered to report progress when moving a + /// collection's data files. /// TObject [in] TUserDBMove instance that triggered /// the event. /// Byte [in] Percentage of operation that has been @@ -40,39 +41,42 @@ TUserDBMove = class(TObject) fOnCopyFile: TProgress; /// Reference to event handler for OnDeleteFile event. fOnDeleteFile: TProgress; - /// Directory of existing user database. + /// Directory containg existing collection data. fSourceDir: string; - /// Required new database directory. + /// Required new collection data directory. fDestDir: string; + /// Collection to be moved. + fCollection: TCollection; /// Instance of class used to perform directory move. fDirCopier: TDirectoryCopier; /// Validates source and destination directories. /// Raises EInOutError exception if either directory is not /// valid. procedure ValidateDirectories; - /// Handles TDirectoryCopier.OnAfterCopyDir event to update user - /// database location. - /// Database location is updated once the database has been copied - /// but before old database directory is deleted. + /// Handles TDirectoryCopier.OnAfterCopyDir event to update the + /// collection data directory. + /// Collection data location is updated once the collection's data + /// has been copied but before the old collection data directory is + /// deleted. procedure SetNewDBDirectory(Sender: TObject); /// Handles TDirectoryCopier.OnCopyFileProgress event and passes - /// the given progress percentage on to this class' similar OnCopyFile + /// the given progress percentage on to this class' similar OnCopyFile /// event. procedure ReportCopyProgress(Sender: TObject; const Percent: Single); /// Handles TDirectoryCopier.OnDeleteFileProgress event and passes - /// the given progress percentage on to this class' similar - /// OnDeleteFile event. + /// the given progress percentage on to this class' similar OnDeleteFile + /// event. procedure ReportDeleteProgress(Sender: TObject; const Percent: Single); public /// Constructs and initialises new object instance. constructor Create; /// Destroys current object instance. destructor Destroy; override; - /// Moves user database from its current directory to the given + /// Moves collection data from its current directory to the given /// new directory. /// Raises EInOutError exceptions if an error occurs. /// - procedure MoveTo(const ADirectory: string); + procedure MoveTo(const ACollection: TCollection; const ADirectory: string); /// Event triggered just before file copying begins and once for /// each file copied. Reports progress towards completion of copy /// operation. @@ -91,7 +95,6 @@ implementation // Delphi SysUtils, IOUtils, // Project - DB.UCollections, UAppInfo, UStrUtils; @@ -113,9 +116,11 @@ destructor TUserDBMove.Destroy; inherited; end; -procedure TUserDBMove.MoveTo(const ADirectory: string); +procedure TUserDBMove.MoveTo(const ACollection: TCollection; + const ADirectory: string); begin - fSourceDir := ExcludeTrailingPathDelimiter(TAppInfo.UserDataDir); + fCollection := ACollection; + fSourceDir := ExcludeTrailingPathDelimiter(ACollection.Location.Directory); fDestDir := ExcludeTrailingPathDelimiter(ADirectory); ValidateDirectories; fDirCopier.Move(fSourceDir, fDestDir); @@ -137,14 +142,12 @@ procedure TUserDBMove.ReportDeleteProgress(Sender: TObject; procedure TUserDBMove.SetNewDBDirectory(Sender: TObject); var - Collection: TCollection; Collections: TCollections; begin - // record new location BEFORE deleting old directory Collections := TCollections.Instance; - Collection := Collections.GetCollection(TCollectionID.__TMP__UserDBCollectionID); - Collection.Location.Directory := fDestDir; - Collections.Update(Collection); + // record new location BEFORE deleting old directory + fCollection.Location.Directory := fDestDir; + Collections.Update(fCollection); // Persist collections immediately to save new directory ASAP to prevent // directory change being lost following a program crash. Collections.Save; @@ -152,14 +155,14 @@ procedure TUserDBMove.SetNewDBDirectory(Sender: TObject); procedure TUserDBMove.ValidateDirectories; resourcestring - sSameNames = 'The new database directory is the same as the current ' + sSameNames = 'The new collection data directory is the same as the current ' + 'directory.'; - sSourceMissing = 'No user database found'; - sCantMoveToSubDir = 'Can''t move database into a sub-directory of the ' - + 'existing database directory'; - sDestMustBeRooted = 'A full path to the new database directory must be ' + sSourceMissing = 'No collection data found'; + sCantMoveToSubDir = 'Can''t move the collection into a sub-directory of the ' + + 'its existing data directory'; + sDestMustBeRooted = 'A full path to the new collectio data directory must be ' + 'provided.'; - sDestMustBeEmpty = 'The new database directory must be empty'; + sDestMustBeEmpty = 'The new collection data directory must be empty'; begin if not TPath.IsPathRooted(fDestDir) then raise EInOutError.Create(sDestMustBeRooted); @@ -174,7 +177,7 @@ procedure TUserDBMove.ValidateDirectories; raise EInOutError.Create(sSameNames); if StrStartsText( - IncludeTrailingPathDelimiter(TAppInfo.UserDataDir), fDestDir + IncludeTrailingPathDelimiter(fCollection.Location.Directory), fDestDir ) then raise EInOutError.Create(sCantMoveToSubDir); end; From 978c3e2665851b69be17bb24d3907df8af09a35d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 19 Nov 2024 13:59:55 +0000 Subject: [PATCH 113/222] Add new v5 folder backup file format & make default A new v5 folder backup file format was added. This new format adds a custom field to the file header. This is a variable length array of bytes preceeded by a 16 bit byte count. The custom header field can be from 0 to High(Int16) bytes long. The FileID from previous formats was retained. The v5 file format is now the default file used for writing backup files. Ability to read formats v1 to v4 in addition to v5 has been retained. The idea of the new custom header is to allow a byte array representation of a collection ID to be stored in the file header thus enabling a check to be made that a backup file contains a specific collection's data files. --- Src/UFolderBackup.pas | 208 +++++++++++++++++++++++++++++++----------- 1 file changed, 157 insertions(+), 51 deletions(-) diff --git a/Src/UFolderBackup.pas b/Src/UFolderBackup.pas index f4ca63668..2ed119b70 100644 --- a/Src/UFolderBackup.pas +++ b/Src/UFolderBackup.pas @@ -17,6 +17,13 @@ interface +uses + // Delphi + SysUtils, + // Project + UExceptions; + + type /// @@ -28,47 +35,71 @@ TFolderBackup = class(TObject) var fSrcFolder: string; // Folder to be backed up or restored var fBakFile: string; // Full path to backup file var fFileID: SmallInt; // Identifies the type of file + var fCustomHeader: TBytes; public - /// - /// Creates object for a specific folder and backup file type. + /// Creates object for a specific folder and backup file type. /// - /// Folder containing files to be backed up. - /// Sub-directories are ignored. - /// Name of backup file. - /// Backup file type identifier. Specified backup file - /// must have this identifier. + /// string [in] Folder containing files to + /// be backed up. Sub-directories are ignored. + /// string [in] Name of backup file. + /// SmallInt [in] Backup file type identifier. + /// + /// When restoring a folder BakFile must have the file ID + /// specified by FileID and no custom header. constructor Create(const SrcFolder, BakFile: string; - const FileID: SmallInt); - /// - /// Backs up the files from the source folder passed to constructor into a - /// single backup file. - /// + const FileID: SmallInt); overload; + + /// Creates object for a specific folder, backup file type and + /// custom header. + /// string [in] Folder containing files to + /// be backed up. Sub-directories are ignored. + /// string [in] Name of backup file. + /// SmallInt [in] Backup file type identifier. + /// + /// TBytes [in] Backup file's custom + /// header. Can contain zero to High(SmallInt) bytes. /// - /// Backup file is marked with the file ID passed to constructor. + /// When restoring a folder BakFile must have the file ID + /// specified by FileID and the custom header specified by + /// CustomHeader. + /// This constructor can only be used with file format v5 or later, + /// unless CustomHeader has length 0. /// + constructor Create(const SrcFolder, BakFile: string; + const FileID: SmallInt; const CustomHeader: TBytes); overload; + + /// Backs up the files from the source folder passed to + /// constructor into a single file. + /// Backup file is marked with the file ID and any custom header + /// passed to constructor. procedure Backup; - /// - /// Restores files from backup file into source folder passed to - /// constructor - /// - /// - /// An exception is raised if file type id is not the one passed to the - /// constructor or if any checksum errors are detected. - /// + /// Restores files from backup file into source folder passed to + /// constructor. + /// An exception is raised if file type id or any optional custom + /// header are not the sames as those passed to the constructor, or if any + /// checksum errors are detected. procedure Restore; end; + /// Type of exception raised by backup file loader objects. + EBackupFileLoader = class(ECodeSnip); + implementation uses // Delphi - SysUtils, Classes, Generics.Collections, + Classes, + Generics.Collections, // DelphiDabbler library PJMD5, // Project - UBaseObjects, UDataStreamIO, UDOSDateTime, UEncodings, UExceptions, UIOUtils, + UBaseObjects, + UDataStreamIO, + UDOSDateTime, + UEncodings, + UIOUtils, UUtils; @@ -91,18 +122,20 @@ TBackupFileInfo = class(TNoConstructObject) /// Class that writes files to a backup file using the latest file format. TBackupFileWriter = class(TObject) strict private - var fFiles: TStrings; // Files to be backed up - var fStream: TStream; // Stream to receive backed up files - var fFileID: SmallInt; // ID of backup file + var + fFiles: TStrings; // Files to be backed up + fStream: TStream; // Stream to receive backed up files + fFileID: SmallInt; // ID of backup file + fCustomHeader: TBytes; // Bytes of optional custom header /// Writes file header procedure WriteHeader; /// Writes meta information and contents of a specified file. procedure WriteFileInfo(const FileName: string); public /// Sets up object to write specified files to a given stream marked with - /// given file ID. + /// given file ID and optional custom header. constructor Create(const Files: TStrings; const Stream: TStream; - const FileID: SmallInt); + const FileID: SmallInt; const CustomHeader: TBytes); overload; /// Generates backup file and writes it to stream passed to constructor. procedure Generate; end; @@ -122,6 +155,7 @@ TFileInfo = record const NulFileID = 0; // Used for File ID is formats that don't support it strict private var fFileID: SmallInt; // Value of FileID property + var fCustomHeader: TBytes; var fFiles: TList; // List of file info records var fEncoding: TEncoding; // Text encoding used in backup file var fStream: TStream; // Stream containing backup data being read @@ -138,7 +172,8 @@ TFileInfo = record /// Skips over watermark at start of file. procedure SkipWatermark; /// Reads header information from the backup file. - procedure ReadHeader(out FileID, FileCount: SmallInt); virtual; abstract; + procedure ReadHeader(out FileID: SmallInt; out CustomHeader: TBytes; + out FileCount: SmallInt); virtual; abstract; /// Reads information about a file to be restored from the backup file. procedure ReadFileInfo(out FileInfo: TFileInfo); virtual; abstract; /// Reference to encoding used to read text from the backup file stream. @@ -155,6 +190,9 @@ TFileInfo = record procedure Load; /// Backup file identifier. property FileID: SmallInt read fFileID; + + property CustomHeader: TBytes read fCustomHeader; + /// Gets enumerator for file list. function GetEnumerator: TEnumerator; /// Gets file's unique watermark @@ -184,7 +222,8 @@ TV1BackupFileLoader = class(TTextBackupFileLoader) /// Returns the backup file's text encoding function GetFileEncoding: TEncoding; override; /// Reads header information from the backup file. - procedure ReadHeader(out FileID, FileCount: SmallInt); override; + procedure ReadHeader(out FileID: SmallInt; out CustomHeader: TBytes; + out FileCount: SmallInt); override; /// Reads information about a file to be restored from the backup file. procedure ReadFileInfo(out FileInfo: TBackupFileLoader.TFileInfo); override; /// Returns the watermark that identifies the file format. In the v1 file @@ -199,7 +238,8 @@ TV2BackupFileLoader = class(TTextBackupFileLoader) /// Returns the backup file's text encoding function GetFileEncoding: TEncoding; override; /// Reads header information from the backup file. - procedure ReadHeader(out FileID, FileCount: SmallInt); override; + procedure ReadHeader(out FileID: SmallInt; out CustomHeader: TBytes; + out FileCount: SmallInt); override; /// Reads information about a file to be restored from the backup file. procedure ReadFileInfo(out FileInfo: TBackupFileLoader.TFileInfo); override; /// Returns the watermark that identifies the file format. @@ -213,7 +253,8 @@ TV3BackupFileLoader = class(TTextBackupFileLoader) /// Returns the backup file's text encoding function GetFileEncoding: TEncoding; override; /// Reads header information from the backup file. - procedure ReadHeader(out FileID, FileCount: SmallInt); override; + procedure ReadHeader(out FileID: SmallInt; out CustomHeader: TBytes; + out FileCount: SmallInt); override; /// Reads information about a file to be restored from the backup file. procedure ReadFileInfo(out FileInfo: TBackupFileLoader.TFileInfo); override; /// Returns the watermark that identifies the file format. @@ -227,7 +268,23 @@ TV4BackupFileLoader = class(TBinaryBackupFileLoader) /// Returns the backup file's text encoding function GetFileEncoding: TEncoding; override; /// Reads header information from the backup file. - procedure ReadHeader(out FileID, FileCount: SmallInt); override; + procedure ReadHeader(out FileID: SmallInt; out CustomHeader: TBytes; + out FileCount: SmallInt); override; + /// Reads information about a file to be restored from the backup file. + procedure ReadFileInfo(out FileInfo: TBackupFileLoader.TFileInfo); override; + /// Returns the watermark that identifies the file format. + class function GetWatermark: TBytes; override; + end; + + /// Loads and provides access to data from a backup file that has + /// the version 5 file format. + TV5BackupFileLoader = class(TBinaryBackupFileLoader) + strict protected + /// Returns the backup file's text encoding + function GetFileEncoding: TEncoding; override; + /// Reads header information from the backup file. + procedure ReadHeader(out FileID: SmallInt; out CustomHeader: TBytes; + out FileCount: SmallInt); override; /// Reads information about a file to be restored from the backup file. procedure ReadFileInfo(out FileInfo: TBackupFileLoader.TFileInfo); override; /// Returns the watermark that identifies the file format. @@ -254,9 +311,6 @@ TBackupFileLoaderFactory = class sealed(TNoConstructObject) class function Create(const Stream: TStream): TBackupFileLoader; end; - /// Type of exception raised by backup file loader objects. - EBackupFileLoader = class(ECodeSnip); - { TFolderBackup } procedure TFolderBackup.Backup; @@ -270,7 +324,9 @@ procedure TFolderBackup.Backup; ListFiles(fSrcFolder, '*.*', Files, False); FS := TFileStream.Create(fBakFile, fmCreate); try - FileWriter := TBackupFileWriter.Create(Files, FS, fFileID); + FileWriter := TBackupFileWriter.Create( + Files, FS, fFileID, fCustomHeader + ); try FileWriter.Generate; finally @@ -291,18 +347,27 @@ constructor TFolderBackup.Create(const SrcFolder, BakFile: string; fSrcFolder := ExcludeTrailingPathDelimiter(SrcFolder); fBakFile := BakFile; fFileID := FileID; + SetLength(fCustomHeader, 0); +end; + +constructor TFolderBackup.Create(const SrcFolder, BakFile: string; + const FileID: SmallInt; const CustomHeader: TBytes); +begin + Create(SrcFolder, BakFile, FileID); + fCustomHeader := Copy(CustomHeader); end; procedure TFolderBackup.Restore; var BakFileStream: TStream; // stream onto backup file BakFileLoader: TBackupFileLoader; // loads & analyses backup file - FileSpec: string; // name & path of each file to restore + RestoreFileSpec: string; // name & path of each file to restore DOSDateTime: IDOSDateTime; // date stamp of each file to restore FileInfo: TBackupFileLoader.TFileInfo; // info about each file to restore resourcestring // Error message sBadFileID = 'Invalid file ID for file "%s"'; + sBadCustomHeader = 'Invalid custom header for file "%s"'; begin // Make sure restore folder exists EnsureFolders(fSrcFolder); @@ -315,16 +380,19 @@ procedure TFolderBackup.Restore; // Test for correct file ID if present (NulFileID indicates not present) if (BakFileLoader.FileID <> TBackupFileLoader.NulFileID) and (BakFileLoader.FileID <> fFileID) then - raise EBackupFileLoader.CreateFmt(sBadFileID, [FileSpec]); + raise EBackupFileLoader.CreateFmt(sBadFileID, [fBakFile]); + if not IsEqualBytes(BakFileLoader.CustomHeader, fCustomHeader) then + raise EBackupFileLoader.CreateFmt(sBadCustomHeader, [fBakFile]); // Restore each file for FileInfo in BakFileLoader do begin - FileSpec := IncludeTrailingPathDelimiter(fSrcFolder) + FileInfo.Name; + RestoreFileSpec := IncludeTrailingPathDelimiter(fSrcFolder) + + FileInfo.Name; DOSDateTime := TDOSDateTimeFactory.CreateFromDOSTimeStamp( FileInfo.TimeStamp ); - TFileIO.WriteAllBytes(FileSpec, FileInfo.Content); - DOSDateTime.ApplyToFile(FileSpec); + TFileIO.WriteAllBytes(RestoreFileSpec, FileInfo.Content); + DOSDateTime.ApplyToFile(RestoreFileSpec); end; finally BakFileLoader.Free; @@ -367,7 +435,7 @@ procedure TBackupFileLoader.Load; begin try SkipWatermark; - ReadHeader(fFileID, FileCount); + ReadHeader(fFileID, fCustomHeader, FileCount); for I := 1 to FileCount do begin ReadFileInfo(FI); @@ -435,9 +503,11 @@ procedure TV1BackupFileLoader.ReadFileInfo( FileInfo.Content := Reader.ReadSizedRawData16; end; -procedure TV1BackupFileLoader.ReadHeader(out FileID, FileCount: SmallInt); +procedure TV1BackupFileLoader.ReadHeader(out FileID: SmallInt; + out CustomHeader: TBytes; out FileCount: SmallInt); begin FileID := NulFileID; + SetLength(CustomHeader, 0); FileCount := Reader.ReadInt16; end; @@ -464,9 +534,11 @@ procedure TV2BackupFileLoader.ReadFileInfo( FileInfo.Content := Reader.ReadSizedRawData32; end; -procedure TV2BackupFileLoader.ReadHeader(out FileID, FileCount: SmallInt); +procedure TV2BackupFileLoader.ReadHeader(out FileID: SmallInt; + out CustomHeader: TBytes; out FileCount: SmallInt); begin FileID := NulFileID; + SetLength(CustomHeader, 0); FileCount := Reader.ReadInt16; end; @@ -497,9 +569,11 @@ procedure TV3BackupFileLoader.ReadFileInfo( FileInfo.Content := Reader.ReadSizedRawData32; end; -procedure TV3BackupFileLoader.ReadHeader(out FileID, FileCount: SmallInt); +procedure TV3BackupFileLoader.ReadHeader(out FileID: SmallInt; + out CustomHeader: TBytes; out FileCount: SmallInt); begin FileID := Reader.ReadInt16; + SetLength(CustomHeader, 0); FileCount := Reader.ReadInt16; end; @@ -524,21 +598,51 @@ procedure TV4BackupFileLoader.ReadFileInfo( FileInfo.Content := Reader.ReadSizedRawData32; end; -procedure TV4BackupFileLoader.ReadHeader(out FileID, FileCount: SmallInt); +procedure TV4BackupFileLoader.ReadHeader(out FileID: SmallInt; + out CustomHeader: TBytes; out FileCount: SmallInt); begin FileID := Reader.ReadInt16; + SetLength(CustomHeader, 0); FileCount := Reader.ReadInt16; end; -{ TBackupFileWriter } +{ TV5BackupFileLoader } + +function TV5BackupFileLoader.GetFileEncoding: TEncoding; +begin + Result := TEncoding.UTF8; +end; + +class function TV5BackupFileLoader.GetWatermark: TBytes; +begin + Result := TBackupFileInfo.WatermarkBytes('FFFF000500000000'); +end; + +procedure TV5BackupFileLoader.ReadFileInfo( + out FileInfo: TBackupFileLoader.TFileInfo); +begin + FileInfo.Name := Reader.ReadSizedString16; + FileInfo.TimeStamp := Reader.ReadInt32; + FileInfo.Checksum := Reader.ReadBytes(SizeOf(FileInfo.Checksum)); + FileInfo.Content := Reader.ReadSizedRawData32; +end; + +procedure TV5BackupFileLoader.ReadHeader(out FileID: SmallInt; + out CustomHeader: TBytes; out FileCount: SmallInt); +begin + FileID := Reader.ReadInt16; + CustomHeader := Reader.ReadSizedBytes16; + FileCount := Reader.ReadInt16; +end; constructor TBackupFileWriter.Create(const Files: TStrings; - const Stream: TStream; const FileID: SmallInt); + const Stream: TStream; const FileID: SmallInt; const CustomHeader: TBytes); begin inherited Create; fFiles := Files; fStream := Stream; fFileID := FileID; + fCustomHeader := Copy(CustomHeader); end; procedure TBackupFileWriter.Generate; @@ -581,6 +685,7 @@ procedure TBackupFileWriter.WriteHeader; TBackupFileInfo.CurrentLoader.GetWatermark ); BinWriter.WriteInt16(fFileID); + BinWriter.WriteSizedBytes16(fCustomHeader); BinWriter.WriteInt16(fFiles.Count); finally BinWriter.Free; @@ -616,7 +721,8 @@ class function TBackupFileLoaderFactory.Create( begin fClassList := TArray.Create( TV1BackupFileLoader, TV2BackupFileLoader, - TV3BackupFileLoader, TV4BackupFileLoader + TV3BackupFileLoader, TV4BackupFileLoader, + TV5BackupFileLoader ); end; @@ -694,7 +800,7 @@ class function TBackupFileLoaderFactory.GetLoaderClass( class function TBackupFileInfo.CurrentLoader: TBackupFileLoaderClass; begin - Result := TV4BackupFileLoader; + Result := TV5BackupFileLoader; end; class function TBackupFileInfo.WatermarkBytes(const Watermark: string): From 23116cc46aa3ec626c0efec4ca0169beb0ab47cd Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 19 Nov 2024 14:13:16 +0000 Subject: [PATCH 114/222] Change Database backup code to backup any collection The code in UUserDBBackup and UUserDBMgr was modified to backup and restore a specified collection's data files. Before only the "user database" was handled. A new FmCollectionBackup dialogue box was added to the project. This is used when backing up and restoring to get the collection to be backed up / restored and the name of the backup file. The backup and restore menu items and hints were updated to refer to collections instead of the user database. Many comments and method names still refer to the "user" database and need to be updated. --- Src/CodeSnip.dpr | 3 +- Src/CodeSnip.dproj | 3 + Src/FmCollectionBackup.dfm | 70 +++++++++++++++ Src/FmCollectionBackup.pas | 152 +++++++++++++++++++++++++++++++ Src/FmMain.dfm | 10 +-- Src/UUserDBBackup.pas | 29 +++++- Src/UUserDBMgr.pas | 180 +++++++++++++++---------------------- 7 files changed, 330 insertions(+), 117 deletions(-) create mode 100644 Src/FmCollectionBackup.dfm create mode 100644 Src/FmCollectionBackup.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 73f6da5c6..1d97e2f80 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -378,7 +378,8 @@ uses UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas', DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas', UCollectionListAdapter in 'UCollectionListAdapter.pas', - DBIO.MetaData.DCSC in 'DBIO.MetaData.DCSC.pas'; + DBIO.MetaData.DCSC in 'DBIO.MetaData.DCSC.pas', + FmCollectionBackup in 'FmCollectionBackup.pas' {CollectionBackupDlg}; // Include resources {$Resource ExternalObj.tlb} // Type library file diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index d5132b5a5..3c4760e24 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -585,6 +585,9 @@ + +
CollectionBackupDlg
+ Base diff --git a/Src/FmCollectionBackup.dfm b/Src/FmCollectionBackup.dfm new file mode 100644 index 000000000..86282bbfa --- /dev/null +++ b/Src/FmCollectionBackup.dfm @@ -0,0 +1,70 @@ +inherited CollectionBackupDlg: TCollectionBackupDlg + Caption = 'Choose Collection & Backup File' + ExplicitWidth = 474 + ExplicitHeight = 375 + PixelsPerInch = 96 + TextHeight = 13 + inherited pnlBody: TPanel + object lblCollection: TLabel + Left = 0 + Top = 7 + Width = 80 + Height = 13 + Caption = 'Select &collection:' + FocusControl = cbCollection + end + object lblPath: TLabel + Left = 0 + Top = 61 + Width = 180 + Height = 13 + Caption = 'Enter the full path of the back up &file:' + FocusControl = edPath + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + end + object cbCollection: TComboBox + Left = 0 + Top = 24 + Width = 358 + Height = 21 + Style = csDropDownList + TabOrder = 0 + end + object edPath: TEdit + Left = 0 + Top = 80 + Width = 325 + Height = 21 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 1 + end + object btnBrowse: TButton + Left = 331 + Top = 80 + Width = 27 + Height = 21 + Caption = '...' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + ParentFont = False + TabOrder = 2 + OnClick = btnBrowseClick + end + end + inherited btnOK: TButton + OnClick = btnOKClick + end +end diff --git a/Src/FmCollectionBackup.pas b/Src/FmCollectionBackup.pas new file mode 100644 index 000000000..d39d4aa33 --- /dev/null +++ b/Src/FmCollectionBackup.pas @@ -0,0 +1,152 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). + * + * Implements a dialogue box that enables the user to choose a collection to + * backup or restore along with the directory to backup to or restore from. +} + + +unit FmCollectionBackup; + +interface + +uses + // Delphi + Classes, + Controls, + StdCtrls, + ExtCtrls, + // Project + DB.UCollections, + FmGenericOKDlg, + UCollectionListAdapter; + +type + TCollectionBackupDlg = class(TGenericOKDlg) + lblCollection: TLabel; + cbCollection: TComboBox; + lblPath: TLabel; + edPath: TEdit; + btnBrowse: TButton; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnBrowseClick(Sender: TObject); + procedure btnOKClick(Sender: TObject); + strict private + var + fFileName: string; + fCollection: TCollection; + fCollList: TCollectionListAdapter; + function GetFilePathFromEditCtrl: string; + strict protected + procedure ConfigForm; override; + procedure ArrangeForm; override; + public + class function Execute(AOwner: TComponent; + out AFileName: string; out ACollection: TCollection): Boolean; + end; + +implementation + +{$R *.dfm} + +uses + // Delphi + IOUtils, + Dialogs, + // Project + UCtrlArranger, + UMessageBox, + UOpenDialogHelper, + USaveDialogEx, + UStrUtils; + +procedure TCollectionBackupDlg.ArrangeForm; +begin + TCtrlArranger.AlignLefts([lblCollection, cbCollection, lblPath, edPath], 0); + // row 1 + lblCollection.Top := 0; + // row 2 + TCtrlArranger.MoveBelow(lblCollection, cbCollection, 6); + // row 3 + TCtrlArranger.MoveBelow(cbCollection, lblPath, 12); + // row 4 + TCtrlArranger.MoveToRightOf(edPath, btnBrowse, 6); + TCtrlArranger.AlignVCentres( + TCtrlArranger.BottomOf(lblPath, 6), [edPath, btnBrowse] + ); + pnlBody.ClientWidth := TCtrlArranger.TotalControlWidth(pnlBody); + pnlBody.ClientHeight := TCtrlArranger.TotalControlHeight(pnlBody) + 8; + inherited; +end; + +procedure TCollectionBackupDlg.btnBrowseClick(Sender: TObject); +var + SaveDlg: TSaveDialogEx; // save dialog box used to name backup file +resourcestring + // Dialog box caption + sCaption = 'Save Backup'; +begin + // Get backup file name from user via standard save dialog box + SaveDlg := TSaveDialogEx.Create(nil); + try + SaveDlg.Title := sCaption; + SaveDlg.Options := [ofShowHelp, ofExtensionDifferent, ofPathMustExist, + ofNoTestFileCreate, ofEnableSizing]; + SaveDlg.HelpKeyword := 'SaveBackupDlg'; + if SaveDlg.Execute then + edPath.Text := SaveDlg.FileName; + finally + SaveDlg.Free; + end; +end; + +procedure TCollectionBackupDlg.btnOKClick(Sender: TObject); +begin + fFileName := GetFilePathFromEditCtrl; + fCollection := fCollList.Collection(cbCollection.ItemIndex); +end; + +procedure TCollectionBackupDlg.ConfigForm; +begin + inherited; + fCollList.ToStrings(cbCollection.Items); + cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); +end; + +class function TCollectionBackupDlg.Execute(AOwner: TComponent; + out AFileName: string; out ACollection: TCollection): Boolean; +var + Dlg: TCollectionBackupDlg; +begin + Dlg := TCollectionBackupDlg.Create(AOwner); + Result := Dlg.ShowModal = mrOK; + if Result then + begin + AFileName := Dlg.fFileName; + ACollection := Dlg.fCollection; + end; +end; + +procedure TCollectionBackupDlg.FormCreate(Sender: TObject); +begin + inherited; + fCollList := TCollectionListAdapter.Create; +end; + +procedure TCollectionBackupDlg.FormDestroy(Sender: TObject); +begin + fCollList.Free; + inherited; +end; + +function TCollectionBackupDlg.GetFilePathFromEditCtrl: string; +begin + Result := StrTrim(edPath.Text); +end; + +end. diff --git a/Src/FmMain.dfm b/Src/FmMain.dfm index e8cf1d1b8..5193d9d86 100644 --- a/Src/FmMain.dfm +++ b/Src/FmMain.dfm @@ -615,18 +615,18 @@ inherited MainForm: TMainForm end object actBackupDatabase: TAction Category = 'Database' - Caption = 'Backup User Database...' - Hint = 'Backup user database|Backup the user-defined snippet database' + Caption = 'Backup Collection Data...' + Hint = 'Backup a collection|Backup a collection'#39's data files' ImageIndex = 33 OnExecute = actBackupDatabaseExecute OnUpdate = ActNonEmptyDBUpdate end object actRestoreDatabase: TAction Category = 'Database' - Caption = 'Restore User Database...' + Caption = 'Restore Collection Data...' Hint = - 'Restore user database|Restore the user-defined snippet database ' + - 'from a backup' + 'Restore a collection|Restore a collection'#39's data files from a ba' + + 'ckup' ImageIndex = 32 OnExecute = actRestoreDatabaseExecute end diff --git a/Src/UUserDBBackup.pas b/Src/UUserDBBackup.pas index 7c50ff22c..dd063eda2 100644 --- a/Src/UUserDBBackup.pas +++ b/Src/UUserDBBackup.pas @@ -12,11 +12,15 @@ unit UUserDBBackup; +{TODO -cRefactoring: Rename this unit/classes/methods: the names refer to the + CodeSnip 4 database structure but the code now works with collections} + interface uses // Project + DB.UCollections, UFolderBackup; @@ -29,9 +33,10 @@ interface } TUserDBBackup = class sealed(TFolderBackup) strict private - const cFileID = SmallInt($DBAC); // User database backup file ID + class function MakeFileID(const ACollection: TCollection): SmallInt; public - constructor Create(const BackupFile: string); + constructor Create(const BackupFile: string; + const ACollection: TCollection); {Class constructor. Sets up object to backup user database to a specified file. @param BackupFile [in] Name of backup file. @@ -43,19 +48,35 @@ implementation uses + // Delphi + SysUtils, // Project UAppInfo; { TUserDBBackup } -constructor TUserDBBackup.Create(const BackupFile: string); +constructor TUserDBBackup.Create(const BackupFile: string; + const ACollection: TCollection); {Class constructor. Sets up object to backup user database to a specified file. @param BackupFile [in] Name of backup file. } begin - inherited Create(TAppInfo.UserDataDir, BackupFile, cFileID); + inherited Create( + ACollection.Location.Directory, + BackupFile, + MakeFileID(ACollection), + ACollection.UID.ToArray + ); +end; + +class function TUserDBBackup.MakeFileID(const ACollection: TCollection): + SmallInt; +begin + // Backup file ID is $Fxxx where xxx is ordinal value of format kind. + // The $F indicates that the file is a backup of a collection data format. + Result := SmallInt($F000 or UInt16(Ord(ACollection.CollectionFormatKind))); end; end. diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index a02e62759..beed308e2 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -14,6 +14,8 @@ interface +{TODO -cRefactoring: Rename this unit/classes/methods: the names refer to the + CodeSnip 4 database structure but the code now works with collections} uses // Delphi @@ -30,21 +32,6 @@ interface /// Static class that manages user's interaction with user database /// and performs move and backup operations on it. TUserDBMgr = class(TNoConstructObject) - strict private - /// OnClose event handler for open dialogue box. Checks if - /// dialogue box can close. - /// TObject [in] Reference to dialogue box in - /// question. - /// Boolean [in/out] Set to True to permit dialogue - /// to close or False to inhibit closure. - class procedure CanOpenDialogClose(Sender: TObject; var CanClose: Boolean); - /// OnClose event handler for save dialogue box. Checks if - /// dialogue box can close. - /// TObject [in] Reference to dialogue box in - /// question. - /// Boolean [in/out] Set to True to permit dialogue - /// to close or False to inhibit closure. - class procedure CanSaveDialogClose(Sender: TObject; var CanClose: Boolean); public /// Enables user to adds a new user defined snippet to the /// database using the snippets editor. @@ -101,19 +88,32 @@ implementation uses // Delphi - SysUtils, Dialogs, Windows {for inlining}, IOUtils, + SysUtils, + Dialogs, + Windows {for inlining}, + IOUtils, // Project - DB.UCollections, DB.UMain, DB.USnippet, - FmAddCategoryDlg, FmDeleteCategoryDlg, FmDuplicateSnippetDlg, - FmRenameCategoryDlg, FmSnippetsEditorDlg, + DB.UCollections, + DB.UMain, + DB.USnippet, + FmAddCategoryDlg, + FmCollectionBackup, + FmDeleteCategoryDlg, + FmDeleteUserDBDlg, + FmDuplicateSnippetDlg, + FmRenameCategoryDlg, + FmSnippetsEditorDlg, {$IFNDEF PORTABLE} FmUserDataPathDlg, {$ENDIF} - FmDeleteUserDBDlg, FmWaitDlg, + FmWaitDlg, UAppInfo, - UConsts, UExceptions, UIStringList, UMessageBox, UOpenDialogEx, - UOpenDialogHelper, USaveDialogEx, - UUserDBBackup, UWaitForThreadUI; + UConsts, + UExceptions, + UIStringList, + UMessageBox, + UUserDBBackup, + UWaitForThreadUI; type /// Base class for classes that execute a user database management @@ -177,13 +177,16 @@ TRestoreThread = class(TThread) var /// Name of backup file to be restored. fBakFileName: string; + + fCollection: TCollection; strict protected /// Restores the user database from a backup. procedure Execute; override; public /// Constructs a new, suspended, thread that can restore the /// database from the given backup file. - constructor Create(const BakFileName: string); + constructor Create(const BakFileName: string; + const ACollection: TCollection); end; public /// Performs a user database restoration operation from in a @@ -194,7 +197,8 @@ TRestoreThread = class(TThread) /// box, over which it is aligned. /// string [in] Name of backup file to be /// restored. - class procedure Execute(AOwner: TComponent; const BakFileName: string); + class procedure Execute(AOwner: TComponent; const BakFileName: string; + const ACollection: TCollection); end; type @@ -209,13 +213,16 @@ TBackupThread = class(TThread) var /// Name of backup file to be created. fBakFileName: string; + + fCollection: TCollection; strict protected /// Backs up the user database. procedure Execute; override; public /// Constructs a new, suspended, thread that can backup the /// database to the given backup file. - constructor Create(const BakFileName: string); + constructor Create(const BakFileName: string; + const ACollection: TCollection); end; public /// Performs a user database backup operation from in a background @@ -225,7 +232,8 @@ TBackupThread = class(TThread) /// box, over which it is aligned. /// string [in] Name of backup file to be /// created. - class procedure Execute(AOwner: TComponent; const BakFileName: string); + class procedure Execute(AOwner: TComponent; const BakFileName: string; + const ACollection: TCollection); end; { TUserDBMgr } @@ -244,24 +252,19 @@ class procedure TUserDBMgr.AddSnippet; class procedure TUserDBMgr.BackupDatabase(ParentCtrl: TComponent); var - SaveDlg: TSaveDialogEx; // save dialog box used to name backup file + FileName: string; + Collection: TCollection; resourcestring - // Dialog box caption - sCaption = 'Save Backup'; + sOverwritePrompt = '"%s" already exists. OK to overwrite?'; begin - // Get backup file name from user via standard save dialog box - SaveDlg := TSaveDialogEx.Create(nil); - try - SaveDlg.OnCanClose := CanSaveDialogClose; - SaveDlg.Title := sCaption; - SaveDlg.Options := [ofShowHelp, ofExtensionDifferent, ofPathMustExist, - ofNoTestFileCreate, ofEnableSizing]; - SaveDlg.HelpKeyword := 'SaveBackupDlg'; - if SaveDlg.Execute then - // Perform backup - TUserDBBackupUI.Execute(ParentCtrl, SaveDlg.FileName); - finally - SaveDlg.Free; + if TCollectionBackupDlg.Execute(ParentCtrl, FileName, Collection) then + begin + if TFile.Exists(FileName) + and not TMessageBox.Confirm( + ParentCtrl, Format(sOverwritePrompt, [FileName]) + ) then + Exit; + TUserDBBackupUI.Execute(ParentCtrl, FileName, Collection); end; end; @@ -286,29 +289,6 @@ class function TUserDBMgr.CanEdit(ViewItem: IView): Boolean; Result := Supports(ViewItem, ISnippetView); end; -class procedure TUserDBMgr.CanOpenDialogClose(Sender: TObject; - var CanClose: Boolean); -var - FileName: string; // name of file entered in dialog box -resourcestring - // Error message - sFileDoesNotExist = '"%s" does not exist.'; -begin - CanClose := False; - FileName := FileOpenEditedFileName(Sender as TOpenDialogEx); - if not FileExists(FileName) then - begin - // Specified file doesn't exist: inhibit closure - TMessageBox.Error( - Sender as TOpenDialogEx, - Format(sFileDoesNotExist, [FileName]) - ); - Exit; - end; - // All OK: allow closure - CanClose := True; -end; - class function TUserDBMgr.CanRenameACategory: Boolean; begin Result := True; @@ -320,23 +300,6 @@ class function TUserDBMgr.CanSave: Boolean; Result := (Database as IDatabaseEdit).Updated; end; -class procedure TUserDBMgr.CanSaveDialogClose(Sender: TObject; - var CanClose: Boolean); -var - FileName: string; // name of file entered in dialog box -resourcestring - // Error message - sOverwritePrompt = '"%s" already exists. OK to overwrite?'; -begin - FileName := FileOpenEditedFileName(Sender as TSaveDialogEx); - if FileExists(FileName) then - // File exists: allow closure if user permits file to be overwritten - CanClose := TMessageBox.Confirm( - Sender as TSaveDialogEx, - Format(sOverwritePrompt, [FileName]) - ); -end; - class procedure TUserDBMgr.DeleteACategory; var CatList: TCategoryList; // list of deletable categories @@ -471,24 +434,23 @@ class procedure TUserDBMgr.RenameACategory; class function TUserDBMgr.RestoreDatabase(ParentCtrl: TComponent): Boolean; var - Dlg: TOpenDialogEx; // open dialog box used to select backup file + FileName: string; + Collection: TCollection; resourcestring - sCaption = 'Open Backup File'; // dialog box caption + sFileDoesNotExist = '"%s" does not exist.'; begin - // Get name of backup file from user via standard open dialog box - Dlg := TOpenDialogEx.Create(nil); - try - Dlg.OnCanClose := CanOpenDialogClose; - Dlg.Title := sCaption; - Dlg.Options := [ofShowHelp, ofPathMustExist, ofHideReadOnly, - ofEnableSizing]; - Dlg.HelpKeyword := 'RestoreBackupDlg'; - Result := Dlg.Execute; - if Result then - // Perform restoration - TUserDBRestoreUI.Execute(ParentCtrl, Dlg.FileName); - finally - Dlg.Free; + Result := TCollectionBackupDlg.Execute(ParentCtrl, FileName, Collection); + if Result then + begin + if not TFile.Exists(FileName) then + begin + // Specified file doesn't exist: inhibit closure + TMessageBox.Error( + ParentCtrl, Format(sFileDoesNotExist, [FileName]) + ); + Exit; + end; + TUserDBRestoreUI.Execute(ParentCtrl, FileName, Collection); end; end; @@ -546,14 +508,14 @@ procedure TUserDBSaveUI.TSaveThread.Execute; { TUserDBRestoreUI } class procedure TUserDBRestoreUI.Execute(AOwner: TComponent; - const BakFileName: string); + const BakFileName: string; const ACollection: TCollection); resourcestring // Caption for wait dialog sWaitCaption = 'Restoring database files...'; var Thread: TRestoreThread; // thread that performs restore operation begin - Thread := TRestoreThread.Create(BakFileName); + Thread := TRestoreThread.Create(BakFileName, ACollection); try RunThreadWithWaitDlg(Thread, AOwner, sWaitCaption); finally @@ -563,17 +525,19 @@ class procedure TUserDBRestoreUI.Execute(AOwner: TComponent; { TUserDBRestoreUI.TRestoreThread } -constructor TUserDBRestoreUI.TRestoreThread.Create(const BakFileName: string); +constructor TUserDBRestoreUI.TRestoreThread.Create(const BakFileName: string; + const ACollection: TCollection); begin inherited Create(True); fBakFileName := BakFileName; + fCollection := ACollection; end; procedure TUserDBRestoreUI.TRestoreThread.Execute; var UserDBBackup: TUserDBBackup; begin - UserDBBackup := TUserDBBackup.Create(fBakFileName); + UserDBBackup := TUserDBBackup.Create(fBakFileName, fCollection); try UserDBBackup.Restore; finally @@ -584,14 +548,14 @@ procedure TUserDBRestoreUI.TRestoreThread.Execute; { TUserDBBackupUI } class procedure TUserDBBackupUI.Execute(AOwner: TComponent; - const BakFileName: string); + const BakFileName: string; const ACollection: TCollection); resourcestring // Caption for wait dialog sWaitCaption = 'Backing up database...'; var Thread: TBackupThread; // thread that performs restore operation begin - Thread := TBackupThread.Create(BakFileName); + Thread := TBackupThread.Create(BakFileName, ACollection); try RunThreadWithWaitDlg(Thread, AOwner, sWaitCaption); finally @@ -601,10 +565,12 @@ class procedure TUserDBBackupUI.Execute(AOwner: TComponent; { TUserDBBackupUI.TBackupThread } -constructor TUserDBBackupUI.TBackupThread.Create(const BakFileName: string); +constructor TUserDBBackupUI.TBackupThread.Create(const BakFileName: string; + const ACollection: TCollection); begin inherited Create(True); fBakFileName := BakFileName; + fCollection := ACollection; end; procedure TUserDBBackupUI.TBackupThread.Execute; @@ -614,7 +580,7 @@ procedure TUserDBBackupUI.TBackupThread.Execute; // Dialog box caption sCaption = 'Save Backup'; begin - UserDBBackup := TUserDBBackup.Create(fBakFileName); + UserDBBackup := TUserDBBackup.Create(fBakFileName, fCollection); try UserDBBackup.Backup; finally From 72550dc0210a4e1f776d6589f49e18fa57b71d0f Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 19 Nov 2024 14:21:45 +0000 Subject: [PATCH 115/222] Update DCSCv2 saver to use new v5 backup file format The code that saves the DelphiDabbler Code Snippets Collection's content to storage backs up the collection before saving so that it can be restored should anything go wrong. This backup / restore code was modified to call TUserDBBackup instead of directly calling TFolderBackup so that the correct FileID and Custom header for this file format backups are written to the backup file. --- Src/DB.UDatabaseIO.pas | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index d265d42cb..09efcb63f 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -138,9 +138,9 @@ implementation DBIO.UXMLDataIO, UAppInfo, UConsts, - UFolderBackup, UIStringList, - USnippetIDs; + USnippetIDs, + UUserDBBackup; type @@ -347,8 +347,6 @@ TDCSCV2FormatSaver = class(TFormatSaver, IDataFormatSaver ) strict private - const - BakFileID = SmallInt($DC52); var fBakFile: string; // Backup file used in case of failure @@ -800,11 +798,9 @@ procedure TFormatSaver.WriteSnippets; procedure TDCSCV2FormatSaver.Backup; var - FB: TFolderBackup; + FB: TUserDBBackup; // TODO -cRefactoring: this is correct class (will change) begin - FB := TFolderBackup.Create( - Collection.Location.Directory, fBakFile, BakFileID - ); + FB := TUserDBBackup.Create(fBakFile, Collection); try FB.Backup; finally @@ -830,11 +826,9 @@ function TDCSCV2FormatSaver.CreateWriter: IDataWriter; procedure TDCSCV2FormatSaver.Restore; var - FB: TFolderBackup; + FB: TUserDBBackup; begin - FB := TFolderBackup.Create( - Collection.Location.Directory, fBakFile, BakFileID - ); + FB := TUserDBBackup.Create(fBakFile, Collection); try FB.Restore; finally From a45f38d5a09a18929bbe31db56bc97d5425be49c Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 19 Nov 2024 16:41:09 +0000 Subject: [PATCH 116/222] Change database delete code to work with collections The code in UUserDBMgr was changed to delete all snippets in a given collection rather than to delete just the "user database". The FmDeleteUserDBDlg was modified to not only get permission to delete the collection but also to get the user to select collection whose data is to be deleted. The delete database menu item and hints were updated to refer to collections instead of the user database. The explanatory HTML that appears in FmDeleteUserDBDlg was modified re the change to deleting a selected collection. --- Src/FmDeleteUserDBDlg.dfm | 37 +++++++++++++---- Src/FmDeleteUserDBDlg.pas | 72 ++++++++++++++++++++++++++++------ Src/FmMain.dfm | 6 +-- Src/Res/HTML/dlg-dbdelete.html | 8 ++-- Src/UUserDBMgr.pas | 13 ++++-- 5 files changed, 105 insertions(+), 31 deletions(-) diff --git a/Src/FmDeleteUserDBDlg.dfm b/Src/FmDeleteUserDBDlg.dfm index 1bd52b82a..d915e4668 100644 --- a/Src/FmDeleteUserDBDlg.dfm +++ b/Src/FmDeleteUserDBDlg.dfm @@ -1,16 +1,32 @@ inherited DeleteUserDBDlg: TDeleteUserDBDlg - Caption = 'Delete User Database' + Caption = 'Delete All Snippets From Collection' ExplicitWidth = 474 ExplicitHeight = 375 PixelsPerInch = 96 TextHeight = 13 inherited pnlBody: TPanel - object edConfirm: TEdit + object lblConfirm: TLabel + Left = 0 + Top = 256 + Width = 82 + Height = 13 + Caption = 'Confirm &deletion:' + FocusControl = edConfirm + end + object lblCollection: TLabel Left = 0 - Top = 216 - Width = 201 + Top = 224 + Width = 87 + Height = 13 + Caption = 'Choose &collection:' + FocusControl = cbCollection + end + object edConfirm: TEdit + Left = 120 + Top = 248 + Width = 249 Height = 21 - TabOrder = 0 + TabOrder = 2 end inline frmWarning: TFixedHTMLDlgFrame Left = 0 @@ -18,8 +34,7 @@ inherited DeleteUserDBDlg: TDeleteUserDBDlg Width = 369 Height = 210 Align = alTop - TabOrder = 1 - TabStop = True + TabOrder = 0 ExplicitWidth = 369 ExplicitHeight = 210 inherited pnlBrowser: TPanel @@ -41,6 +56,14 @@ inherited DeleteUserDBDlg: TDeleteUserDBDlg end end end + object cbCollection: TComboBox + Left = 120 + Top = 221 + Width = 249 + Height = 21 + Style = csDropDownList + TabOrder = 1 + end end inherited btnOK: TButton OnClick = btnOKClick diff --git a/Src/FmDeleteUserDBDlg.pas b/Src/FmDeleteUserDBDlg.pas index d51be0681..b98b722c8 100644 --- a/Src/FmDeleteUserDBDlg.pas +++ b/Src/FmDeleteUserDBDlg.pas @@ -5,8 +5,8 @@ * * Copyright (C) 2022-2023, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a dialogue box that asks user to confirm deletion of user-defined - * snippets database. + * Implements a dialogue box that enables the user to choose a collection from + * which to delete all snippets. } @@ -16,30 +16,46 @@ interface uses // Delphi - Forms, StdCtrls, Controls, ExtCtrls, Classes, + Forms, + StdCtrls, + Controls, + ExtCtrls, + Classes, // Project + DB.UCollections, FmGenericOKDlg, - FrBrowserBase, FrHTMLDlg, FrFixedHTMLDlg, - UBaseObjects; + FrBrowserBase, + FrHTMLDlg, + FrFixedHTMLDlg, + UBaseObjects, + UCollectionListAdapter; type TDeleteUserDBDlg = class(TGenericOKDlg, INoPublicConstruct) edConfirm: TEdit; frmWarning: TFixedHTMLDlgFrame; + lblConfirm: TLabel; + lblCollection: TLabel; + cbCollection: TComboBox; procedure btnOKClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); strict private const cConfirmText = 'DELETE MY SNIPPETS'; var fPermissionGranted: Boolean; + fCollection: TCollection; + fCollList: TCollectionListAdapter; + function SelectedCollection: TCollection; + function IsValidPassword: Boolean; strict protected /// Protected constructor that sets up form. constructor InternalCreate(AOwner: TComponent); override; procedure ConfigForm; override; procedure ArrangeForm; override; - function IsValidPassword: Boolean; public - class function Execute(AOwner: TComponent): Boolean; + class function Execute(AOwner: TComponent; out ACollection: TCollection): Boolean; end; implementation @@ -48,16 +64,24 @@ implementation // Delphi SysUtils, // Project - UCtrlArranger, UMessageBox; + UCtrlArranger, + UMessageBox; {$R *.dfm} procedure TDeleteUserDBDlg.ArrangeForm; begin frmWarning.Height := frmWarning.DocHeight; - edConfirm.Left := 0; - TCtrlArranger.MoveBelow(frmWarning, edConfirm, 12); - TCtrlArranger.AlignHCentresTo([frmWarning], [edConfirm]); + TCtrlArranger.AlignLefts([frmWarning, lblConfirm, lblCollection], 0); + TCtrlArranger.AlignRights([frmWarning, cbCollection, edConfirm]); + TCtrlArranger.AlignVCentres( + TCtrlArranger.BottomOf(frmWarning, 12), + [lblCollection, cbCollection] + ); + TCtrlArranger.AlignVCentres( + TCtrlArranger.BottomOf([lblCollection, cbCollection], 12), + [lblConfirm, edConfirm] + ); pnlBody.ClientHeight := TCtrlArranger.TotalControlHeight(pnlBody) + 8; inherited; end; @@ -68,6 +92,7 @@ procedure TDeleteUserDBDlg.btnOKClick(Sender: TObject); begin inherited; fPermissionGranted := IsValidPassword; + fCollection := SelectedCollection; if not fPermissionGranted then begin TMessageBox.Error(Self, sBadPassword); @@ -79,11 +104,13 @@ procedure TDeleteUserDBDlg.btnOKClick(Sender: TObject); procedure TDeleteUserDBDlg.ConfigForm; begin inherited; -// frmWarning.OnBuildCSS := BuildCSS; frmWarning.Initialise('dlg-dbdelete.html'); + fCollList.ToStrings(cbCollection.Items); + cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); end; -class function TDeleteUserDBDlg.Execute(AOwner: TComponent): Boolean; +class function TDeleteUserDBDlg.Execute(AOwner: TComponent; + out ACollection: TCollection): Boolean; var Dlg: TDeleteUserDBDlg; begin @@ -91,11 +118,25 @@ class function TDeleteUserDBDlg.Execute(AOwner: TComponent): Boolean; try Dlg.ShowModal; Result := Dlg.fPermissionGranted; + if Result then + ACollection := Dlg.fCollection; finally Dlg.Free; end; end; +procedure TDeleteUserDBDlg.FormCreate(Sender: TObject); +begin + inherited; + fCollList := TCollectionListAdapter.Create; +end; + +procedure TDeleteUserDBDlg.FormDestroy(Sender: TObject); +begin + fCollList.Free; + inherited; +end; + constructor TDeleteUserDBDlg.InternalCreate(AOwner: TComponent); begin Assert(Supports(Self, INoPublicConstruct), ClassName + '.InternalCreate: ' @@ -108,4 +149,9 @@ function TDeleteUserDBDlg.IsValidPassword: Boolean; Result := edConfirm.Text = cConfirmText; end; +function TDeleteUserDBDlg.SelectedCollection: TCollection; +begin + Result := fCollList.Collection(cbCollection.ItemIndex); +end; + end. diff --git a/Src/FmMain.dfm b/Src/FmMain.dfm index 5193d9d86..319c83542 100644 --- a/Src/FmMain.dfm +++ b/Src/FmMain.dfm @@ -870,10 +870,10 @@ inherited MainForm: TMainForm end object actDeleteUserDatabase: TAction Category = 'Database' - Caption = 'Delete User Database...' + Caption = 'Delete All Snippets From Collection' Hint = - 'Delete User Database|Deletes the user'#39's snippets database - USE ' + - 'WITH CAUTION' + 'Delete All Snippets From A Collection|Deletes all the snippets f' + + 'rom a selected collection - USE WITH CAUTION' OnExecute = actDeleteUserDatabaseExecute OnUpdate = ActNonEmptyDBUpdate end diff --git a/Src/Res/HTML/dlg-dbdelete.html b/Src/Res/HTML/dlg-dbdelete.html index b21cfb4c7..4272c61ef 100644 --- a/Src/Res/HTML/dlg-dbdelete.html +++ b/Src/Res/HTML/dlg-dbdelete.html @@ -28,19 +28,19 @@

- Before going any further you are strongly advised to take a backup of your snippets database. Use the Database | Backup User Database menu option to do this. + This action cannot be undone. You will loose all the snippets in the collection. The collection itself will remain but will be empty.

- This action cannot be undone: you will loose all your user-defined snippets. + Before going any further you are strongly advised to take a backup of the collection you are planning to delete. Use the Database | Backup Collection Data menu option to do this.

- To confirm enter DELETE MY SNIPPETS (in capital letters) in the box below, then click OK. + To proceed, first choose the collection you want to delete from the Choose collection drop down list. Then confirm the action by entering DELETE MY SNIPPETS (in capital letters) in the Confirm deletion edit box.

- There will be no further chances to change your mind. + When you click OK there will be no further chances to change your mind.

diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index beed308e2..ce6b9222b 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -78,7 +78,10 @@ TUserDBMgr = class(TNoConstructObject) /// Moves the user database to a new location specified by the /// user. class procedure MoveDatabase; - /// Deletes the user database, with permission. + /// Deletes all the snippets in a collection specified by the + /// user. + /// Boolean. True if the collection's data was + /// deleted, False otherwise. class function DeleteDatabase: Boolean; end; @@ -318,12 +321,14 @@ class procedure TUserDBMgr.DeleteACategory; end; class function TUserDBMgr.DeleteDatabase: Boolean; +var + CollectionToDelete: TCollection; begin - if not TDeleteUserDBDlg.Execute(nil) then + if not TDeleteUserDBDlg.Execute(nil, CollectionToDelete) then Exit(False); - if not TDirectory.Exists(TAppInfo.UserDataDir) then + if not TDirectory.Exists(CollectionToDelete.Location.Directory) then Exit(False); - TDirectory.Delete(TAppInfo.UserDataDir, True); + TDirectory.Delete(CollectionToDelete.Location.Directory, True); Result := True; end; From aa33488cc41f3ab6ee0091079b6eb638a9631080 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 19 Nov 2024 17:04:07 +0000 Subject: [PATCH 117/222] Remove redundant TAppInfo.UserDataDir method This method returned the location of the "user database". All code that used it has now been changed to work with all collections, so there is no further use for this method. --- Src/UAppInfo.pas | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/Src/UAppInfo.pas b/Src/UAppInfo.pas index aad6fdcf5..1a033a289 100644 --- a/Src/UAppInfo.pas +++ b/Src/UAppInfo.pas @@ -55,10 +55,6 @@ TAppInfo = class(TNoConstructObject) {Returns the directory where CodeSnip stores the "database" files. @return Full path to database sub directory. } - class function UserDataDir: string; - {Returns the directory where CodeSnip stores the user's "database" files. - @return Full path to database sub directory. - } class function DefaultUserDataDir: string; {Returns the default directory where CodeSnip stores the uer's "database" files. @@ -257,27 +253,6 @@ class function TAppInfo.UserConfigFileName: string; Result := UserAppDir + '\User.config'; end; -class function TAppInfo.UserDataDir: string; - {Returns the directory where CodeSnip stores the user's "database" files. - @return Full path to database sub directory. - } -{$IFNDEF PORTABLE} -var - Collections: TCollections; - Collection: TCollection; -{$ENDIF} -begin - {$IFNDEF PORTABLE} - Collections := TCollections.Instance; - Collection := Collections.GetCollection(TCollectionID.__TMP__UserDBCollectionID); - Result := Collection.Location.Directory; - if Result = '' then - Result := DefaultUserDataDir; - {$ELSE} - Result := DefaultUserDataDir; - {$ENDIF} -end; - class function TAppInfo.UserFavouritesFileName: string; begin Result := UserAppDir + '\Favourites'; From b78f631d7b39993e47cca38e6f1a7634f0aada14 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 19 Nov 2024 17:23:23 +0000 Subject: [PATCH 118/222] Prevent default collection linking to DCSC snippets TNativeV4FormatLoader was setting snippets dependency and xref properties to include snippets in the "main database" (now DelphiDabbler Code Snippets Collection - DCSC). While this was OK when there were just the "main" and "user" databases, it is not permitted with collections: we can't assumed anything special about the DCSC, which may not even be installed. Therefore snippets in collections loaded by TNativeV4FormatLoader will have any links to the old "main" database ignored. This change meant that TNativeV4FormatLoader.FindSnippet was now implemented identically to TDCSCV2FormatLoader.FindSnippet, so the implementation was pushed up into the base class and the methods were removed. --- Src/DB.UDatabaseIO.pas | 57 ++++++------------------------------------ 1 file changed, 7 insertions(+), 50 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 09efcb63f..2fd8f31f9 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -184,7 +184,7 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) @return Reader object instance. } function FindSnippet(const SnippetKey: string; - const SnipList: TSnippetList): TSnippet; virtual; abstract; + const SnipList: TSnippetList): TSnippet; virtual; {Finds the snippet object with a specified key. @param SnippetKey [in] Key of required snippet. @param SnipList [in] List of snippets to search. @@ -240,15 +240,6 @@ TDCSCV2FormatLoader = class(TDatabaseLoader, IDataFormatLoader) created. @return Reader object instance. } - function FindSnippet(const SnippetKey: string; - const SnipList: TSnippetList): TSnippet; override; - {Finds the snippet object with a specified key in the main database. - @param SnippetKey [in] Key of required snippet. - @param SnipList [in] List of snippets to search. - @return Reference to required snippet object or nil if snippet is not - found. - } - function ErrorMessageHeading: string; override; {Returns heading to use in error messages. Identifies main database. @return Required heading. @@ -266,16 +257,6 @@ TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) created. @return Reader object instance. } - function FindSnippet(const SnippetKey: string; - const SnipList: TSnippetList): TSnippet; override; - {Finds the snippet object with a specified key. If snippet is not in this - (user) database the main database is searched. - @param SnippetKey [in] Key of required snippet. - @param SnipList [in] List of snippets to search. - @return Reference to required snippet object or nil if snippet is not - found. - } - function ErrorMessageHeading: string; override; {Returns heading to use in error messages. Identifies main database. @return Required heading. @@ -493,6 +474,12 @@ procedure TDatabaseLoader.CreateCategory(const CatID: string; fCategories.Add(fFactory.CreateCategory(CatID, CatData)); end; +function TDatabaseLoader.FindSnippet(const SnippetKey: string; + const SnipList: TSnippetList): TSnippet; +begin + Result := SnipList.Find(SnippetKey, Collection.UID); +end; + procedure TDatabaseLoader.HandleException(const E: Exception); {Handles exceptions generated by loader and converts ECodeSnip and descendant exceptions into EDatabaseLoader exceptions. @@ -668,18 +655,6 @@ function TDCSCV2FormatLoader.ErrorMessageHeading: string; Result := sError; end; -function TDCSCV2FormatLoader.FindSnippet(const SnippetKey: string; - const SnipList: TSnippetList): TSnippet; - {Finds the snippet object with a specified key in the main database. - @param SnippetKey [in] Key of required snippet. - @param SnipList [in] List of snippets to search. - @return Reference to required snippet object or nil if snippet is not found. - } -begin - // We only search main database - Result := SnipList.Find(SnippetKey, Collection.UID); -end; - { TNativeV4FormatLoader } function TNativeV4FormatLoader.CreateReader: IDataReader; @@ -703,24 +678,6 @@ function TNativeV4FormatLoader.ErrorMessageHeading: string; Result := sError; end; -function TNativeV4FormatLoader.FindSnippet(const SnippetKey: string; - const SnipList: TSnippetList): TSnippet; - {Finds the snippet object with a specified key. If snippet is not in this - (user) database the main database is searched. - @param SnippetKey [in] Key of required snippet. - @param SnipList [in] List of snippets to search. - @return Reference to required snippet object or nil if snippet is not found. - } -begin - // Search in user database - Result := SnipList.Find(SnippetKey, Collection.UID); - {TODO -cVault: Delete the following - only allow references in same collection - } - if not Assigned(Result) then - // Not in user database: try main database - Result := SnipList.Find(SnippetKey, TCollectionID.__TMP__MainDBCollectionID); -end; - { TFormatSaver } constructor TFormatSaver.Create(const ACollection: TCollection); From 1a56dc5285e6ea23990e4442444ec1be4f5a3652 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 19 Nov 2024 23:04:09 +0000 Subject: [PATCH 119/222] Change database load/save to cycle thru collections TDatabase's Load and Save methods previously had the "user" and "main" databases (later DCSC and Default collections) loaded/saved explicitly. This was changed so that the methods loop through all available collections, loading and saving them. This means that the methods will now load and save whatever collections are available. --- Src/DB.UMain.pas | 92 +++++++++++++----------------------------------- 1 file changed, 25 insertions(+), 67 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 2ca5089c8..b8e73511f 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -478,9 +478,10 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) {Gets list of all snippets in database. @return Required list. } + + /// Load database from all available collections. procedure Load; - {Loads object's data from main and user defined databases. - } + procedure Clear; {Clears the object's data. } @@ -623,9 +624,11 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) {Checks if user database has been updated since last save. @return True if database has been updated, False otherwise. } + + /// Saves snippets from database to their respective collections. + /// procedure Save; - {Saves user defined snippets and all categories to user database. - } + end; /// Class that provides data about the categories and snippets in @@ -1072,54 +1075,32 @@ procedure TDatabase.Load; {Loads object's data from main and user defined databases. } var - Factory: IDBDataItemFactory; // object reader uses to create snippets objects - MainCollectionIdx: Integer; - Loader: IDataFormatLoader; - Collections: TCollections; + DataItemFactory: IDBDataItemFactory; + CollectionLoader: IDataFormatLoader; Collection: TCollection; CatLoader: IGlobalCategoryLoader; begin + // Clear the database Clear; - // Create factory that reader calls into to create category and snippet // objects. This is done to keep updating of snippet and categories private // to this unit - Factory := TDBDataItemFactory.Create; - - Collections := TCollections.Instance; - - {TODO: -cVault: The following code is a kludge to maintain compatibility with - CodeSnip 4. In CodeSnip Vault we should iterate over all collections - creating a loader for each one. } - + DataItemFactory := TDBDataItemFactory.Create; try - MainCollectionIdx := TCollections.Instance.IndexOfID( - TCollectionID.__TMP__MainDBCollectionID - ); - if MainCollectionIdx >= 0 then + // Load all collections + for Collection in TCollections.Instance do begin - Collection := Collections[MainCollectionIdx]; - Loader := TDatabaseIOFactory.CreateDBLoader(Collection); - if Assigned(Loader) then - Loader.Load(fSnippets, fCategories, Factory); + CollectionLoader := TDatabaseIOFactory.CreateDBLoader(Collection); + if Assigned(CollectionLoader) then + CollectionLoader.Load(fSnippets, fCategories, DataItemFactory); end; - - // Load default collection - Collection := Collections.Default; - Loader := TDatabaseIOFactory.CreateDBLoader(Collection); - Assert(Assigned(Loader), - ClassName + '.Load: No loader for default collection'); - Loader.Load(fSnippets, fCategories, Factory); - // Read categories from categories file to get any empty categories not // created by format loaders CatLoader := TDatabaseIOFactory.CreateGlobalCategoryLoader; - CatLoader.Load(fCategories, Factory); - + CatLoader.Load(fCategories, DataItemFactory); // Ensure that the default category is present, if it's not already loaded if not Assigned(fCategories.Find(TCategory.DefaultID)) then fCategories.Add(TCategoryEx.CreateDefault); - fUpdated := False; except // If an exception occurs clear the database @@ -1140,47 +1121,24 @@ procedure TDatabase.Save; {Saves user defined snippets and all categories to user database. } var - MainProvider, DefaultProvider: IDBDataProvider; - MainCollectionIdx: Integer; - Saver: IDataFormatSaver; - Collections: TCollections; + Provider: IDBDataProvider; + CollectionSaver: IDataFormatSaver; Collection: TCollection; CatSaver: IGlobalCategorySaver; begin // Save categories CatSaver := TDatabaseIOFactory.CreateGlobalCategorySaver; CatSaver.Save(fCategories); - - Collections := TCollections.Instance; - - {TODO: -cVault: The following code is a kludge to maintain compatibility with - CodeSnip 4. In CodeSnip Vault we should iterate over all collections - creating a writer for each one. } - - // *** The following code is a stub for later versions. - MainCollectionIdx := TCollections.Instance.IndexOfID( - TCollectionID.__TMP__MainDBCollectionID - ); - if MainCollectionIdx >= 0 then + // Save all collections + for Collection in TCollections.Instance do begin - Collection := Collections[MainCollectionIdx]; - MainProvider := TCollectionDataProvider.Create( + Provider := TCollectionDataProvider.Create( Collection.UID, fSnippets, fCategories ); - Saver := TDatabaseIOFactory.CreateDBSaver(Collection); - if Assigned(Saver) then - Saver.Save(fSnippets, fCategories, MainProvider); + CollectionSaver := TDatabaseIOFactory.CreateDBSaver(Collection); + if Assigned(CollectionSaver) then + CollectionSaver.Save(fSnippets, fCategories, Provider); end; - - Collection := Collections.Default; - DefaultProvider := TCollectionDataProvider.Create( - Collection.UID, fSnippets, fCategories - ); - Saver := TDatabaseIOFactory.CreateDBSaver(Collection); - Assert(Assigned(Saver), - ClassName + '.Save: No saver for default collection'); - Saver.Save(fSnippets, fCategories, DefaultProvider); - fUpdated := False; end; From 2bb2a5f70c82dc18058c0575e4d2313bb864c47c Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 19 Nov 2024 23:14:06 +0000 Subject: [PATCH 120/222] Remove explicit creation of main database collection The "main" database, aka the DCSC collection, is no longer explicit created when TCollections initialises if it has not already been read from the config file. TCollections only ensures that the Default collection is available. --- Src/DB.UCollections.pas | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index f12ae768f..84516c8a7 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -472,19 +472,6 @@ procedure TCollections.Initialize; TCollectionFormatKind.Native_v4 ) ); - { TODO -cCollections: following line is for v4 main database compatibility - Remove when reduce to only one compulsory collection } - if not ContainsID(TCollectionID.__TMP__MainDBCollectionID) then - Add( - TCollection.Create( - TCollectionID.__TMP__MainDBCollectionID, - { TODO -cVault: change name - this text matches name used in CodeSnip - v4} - 'DelphiDabbler Code Snippets Database', - TCollectionLocation.Create(TAppInfo.AppDataDir), - TCollectionFormatKind.DCSC_v2 - ) - ); end; procedure TCollections.Save; From d31ccb2ba97d372bc3c365951acc263e1101c9c0 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 19 Nov 2024 23:23:42 +0000 Subject: [PATCH 121/222] Removed temporary methods etc from DB.UCollections The __TMP__ methods that were used to explicitly refer to the former "user" and "main" databases are now redundant and have been removed. The DCSC_v2_ID and SWAG_v1_ID explicitly specified collection IDs were also removed as redundant. --- Src/DB.UCollections.pas | 20 +------------------- 1 file changed, 1 insertion(+), 19 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 84516c8a7..e94e89ff0 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -93,11 +93,6 @@ TComparer = class(TInterfacedObject, function GetHashCode(const Value: TCollectionID): Integer; reintroduce; end; - const - {TODO -cCollections: remove DCSC_v2_ID and SWAG_v1_ID once there are no - built-in collections except Default} - DCSC_v2_ID: TGUID = '{9F3A4A8A-0A2B-4088-B7C9-AE1D32D3FF9A}'; - SWAG_v1_ID: TGUID = '{ADA985E0-0929-4986-A3FE-B2C981D430F1}'; constructor Create(const ABytes: TBytes); overload; constructor Create(const AStr: string); overload; constructor Create(const AGUID: TGUID); overload; @@ -113,9 +108,6 @@ TComparer = class(TInterfacedObject, class function Compare(Left, Right: TCollectionID): Integer; static; class operator Equal(Left, Right: TCollectionID): Boolean; class operator NotEqual(Left, Right: TCollectionID): Boolean; - {TODO -c__TMP__: remove following __TMP__*** methods} - class function __TMP__MainDBCollectionID: TCollectionID; static; - class function __TMP__UserDBCollectionID: TCollectionID; static; end; ECollectionID = class(ECodeSnip); @@ -272,7 +264,7 @@ implementation IOUtils, Math, // Project - UAppInfo, // TODO -cVault: needed only for v4 emulation + UAppInfo, UStrUtils, UUtils; @@ -590,16 +582,6 @@ function TCollectionID.ToHexString: string; Result := BytesToHexString(fID); end; -class function TCollectionID.__TMP__MainDBCollectionID: TCollectionID; -begin - Result := TCollectionID.Create(DCSC_v2_ID); -end; - -class function TCollectionID.__TMP__UserDBCollectionID: TCollectionID; -begin - Result := TCollectionID.Default; -end; - { TCollectionID.TComparer } function TCollectionID.TComparer.Compare(const Left, From b8e64b7f405520187ba884301ce269e6e1a40073 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 20 Nov 2024 00:28:53 +0000 Subject: [PATCH 122/222] Update TAppInfo with collection related directories Added per-user directories TAppInfo.UserCollectionsDir and TAppInfo.UserDefaultCollectionDir. The former is the parent directory under which it is recommended that collections are stored. The latter is the directory where CodeSnip will initially create the Default collection, which is a sub-directory of TAppInfo.UserCollectionsDir. TCollections.Initialize was modified to create the Default directory, when necessary, in TAppInfo.UserDefaultCollectionDir instead of TAppInfo.DefaultUserDataDir. TAppInfo.DefaultUserDataDir was removed as it is now redundant. --- Src/DB.UCollections.pas | 4 +++- Src/UAppInfo.pas | 51 ++++++++++++++++++++++++++--------------- 2 files changed, 36 insertions(+), 19 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index e94e89ff0..c0fcff1db 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -460,7 +460,9 @@ procedure TCollections.Initialize; TCollection.Create( TCollectionID.Default, 'Default', - TCollectionLocation.Create(TAppInfo.DefaultUserDataDir, '', etUTF8), + TCollectionLocation.Create( + TAppInfo.UserDefaultCollectionDir, '', etUTF8 + ), TCollectionFormatKind.Native_v4 ) ); diff --git a/Src/UAppInfo.pas b/Src/UAppInfo.pas index 1a033a289..8a51d0666 100644 --- a/Src/UAppInfo.pas +++ b/Src/UAppInfo.pas @@ -41,6 +41,7 @@ TAppInfo = class(TNoConstructObject) const ProgramID = 'codesnip'; {TODO -cVault: Remove unused ProgramID const} {Machine readable identifier of program} + public class function UserAppDir: string; {Gets the CodeSnip data directory stored within the user's application data directory. @@ -52,14 +53,31 @@ TAppInfo = class(TNoConstructObject) @return Full path to common application data directory. } class function AppDataDir: string; + {TODO -cCollections: Remove AppDataDir method: used for "main" database} {Returns the directory where CodeSnip stores the "database" files. @return Full path to database sub directory. } - class function DefaultUserDataDir: string; - {Returns the default directory where CodeSnip stores the uer's "database" - files. - @return Full path to required directory. - } + + /// Returns the path where collections are recommended to be + /// stored for the current user. + /// + /// Collections each have their own sub-directory of this directory. + /// + /// The user may ignore this recommendation and install collections + /// anywhere they choose. + /// + class function UserCollectionsDir: string; + + /// Returns the path where the Default collection is recommended + /// to be stored for the current user. + /// + /// If the Default collection is not present then CodeSnip will + /// automatically create it in this directory. + /// The user may move the Default collection anywhere they choose. + /// + /// + class function UserDefaultCollectionDir: string; + class function AppExeFilePath: string; {Returns fully specified name of program's executable file. @return Name of file. @@ -169,19 +187,6 @@ class function TAppInfo.CommonAppDir: string; {$ENDIF} end; -class function TAppInfo.DefaultUserDataDir: string; - {Returns the default directory where CodeSnip stores the uer's "database" - files. - @return Full path to required directory. - } -begin - {$IFNDEF PORTABLE} - Result := UserAppDir + '\UserDatabase'; - {$ELSE} - Result := UserAppDir + '\UserDB'; - {$ENDIF} -end; - class function TAppInfo.HelpFileName: string; {Returns fully specified name of CodeSnip's help file. @return Name of help file. @@ -248,11 +253,21 @@ class function TAppInfo.UserCategoriesFileName: string; Result := UserAppDir + '\Categories'; end; +class function TAppInfo.UserCollectionsDir: string; +begin + Result := UserAppDir + '\Collections'; +end; + class function TAppInfo.UserConfigFileName: string; begin Result := UserAppDir + '\User.config'; end; +class function TAppInfo.UserDefaultCollectionDir: string; +begin + Result := UserCollectionsDir + '\Default'; +end; + class function TAppInfo.UserFavouritesFileName: string; begin Result := UserAppDir + '\Favourites'; From 94fa9f495acc15858521c2bf234265c8ab6a62c3 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 20 Nov 2024 00:47:13 +0000 Subject: [PATCH 123/222] Fix bug in TMainDBMetaData not finding moved DCSC When the DelphiDabbler Code Snippets Database is moved from the location specified by TAppInfo.AppDataDir (which was compulosory in CodeSnip 4), TMainDBMetaData could no longer read meta data because it was always looking for it in TAppInfo.AppDataDir. TMainDBMetaData was changed to look for the data in the location specified by a TCollection instance passed to to the constructor. --- Src/DBIO.MetaData.DCSC.pas | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/Src/DBIO.MetaData.DCSC.pas b/Src/DBIO.MetaData.DCSC.pas index b2e07bb17..f4b3d2286 100644 --- a/Src/DBIO.MetaData.DCSC.pas +++ b/Src/DBIO.MetaData.DCSC.pas @@ -401,8 +401,13 @@ TAbstractMainDBMetaData = class abstract(TRegisterableMetaData) /// Class that provides meta data for the main database. TMainDBMetaData = class sealed(TAbstractMainDBMetaData, IDBMetaData) + strict private + var + fCollection: TCollection; strict protected function GetDBDir: string; override; + public + constructor Create(const ACollection: TCollection); end; /// Class that provides meta data for update database directories. @@ -424,7 +429,6 @@ implementation Classes, IOUtils, // VCL - UAppInfo, UEncodings, UIOUtils, UResourceUtils, @@ -493,7 +497,7 @@ function TAbstractMainDBMetaData.GetVersion: TVersionNumber; class function TAbstractMainDBMetaData.Instance( ACollection: DB.UCollections.TCollection): IDBMetaData; begin - Result := TMainDBMetaData.Create; + Result := TMainDBMetaData.Create(ACollection); end; function TAbstractMainDBMetaData.IsCorrupt: Boolean; @@ -557,9 +561,16 @@ procedure TAbstractMainDBMetaData.Refresh; { TMainDBMetaData } +constructor TMainDBMetaData.Create( + const ACollection: DB.UCollections.TCollection); +begin + inherited Create; + fCollection := ACollection; +end; + function TMainDBMetaData.GetDBDir: string; begin - Result := TAppInfo.AppDataDir; + Result := fCollection.Location.Directory; end; { TUpdateDBMetaData } From 6980a51b09f75ab73fe5b8fedf4253b82191ab1d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 20 Nov 2024 01:02:42 +0000 Subject: [PATCH 124/222] Fix bug reading tab separated files with no data A bug in TTabSeparatedReader was raising an exception for tabbed separated text files with a valid watermark but no tabbed separated data lines, which is a valid state. --- Src/UTabSeparatedFileIO.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Src/UTabSeparatedFileIO.pas b/Src/UTabSeparatedFileIO.pas index 0c411c570..7028a3797 100644 --- a/Src/UTabSeparatedFileIO.pas +++ b/Src/UTabSeparatedFileIO.pas @@ -189,7 +189,7 @@ procedure TTabSeparatedReader.Parse(const ALineCallback: TLineCallback); Idx: Integer; begin // check for watermark in 1st line - if (fLines.Count <= 1) or (fLines[0] <> fWatermark) then + if (fLines.Count < 1) or (fLines[0] <> fWatermark) then raise ETabSeparatedReader.Create(sBadFileFormat); // delete watermark line fLines.Delete(0); From 7ddb3719aa7fcaa7afbe96a09629749c501825fa Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 26 Nov 2024 01:41:20 +0000 Subject: [PATCH 125/222] Add means to get metadata caps via class method Added TRegisterableMetaData.Capabilities abstract class method that provides a means of getting a data format's meta data capabilities without having to create an instance of the class. Added an implementation of the method to TAbstractMainDBMetaData. Added implementation of IDBMetaData.GetCapabilities to TRegisterableMetaData that simply calls the new class method. IDBMetaData.GetCapabilities remains necessary because it provides a means of getting capabilities from an IDBMetaData instance. Removed the IDBMetaData.GetCapabilities implementation from TAbstractMainDBMetaData in favour of the implementation TRegisterableMetaData. Added new TMetaDataFactory.CapabilitiesOf class method that gets the meta data capabilities for a given data format. This method calls the TRegisterableMetaData.Capabilities class method of relevant data format class. --- Src/DB.UMetaData.pas | 43 ++++++++++++++++++++++++++++++++++++-- Src/DBIO.MetaData.DCSC.pas | 20 +++++++++++------- 2 files changed, 53 insertions(+), 10 deletions(-) diff --git a/Src/DB.UMetaData.pas b/Src/DB.UMetaData.pas index af4eefb8f..88f83d657 100644 --- a/Src/DB.UMetaData.pas +++ b/Src/DB.UMetaData.pas @@ -152,6 +152,19 @@ TRegisterableMetaData = class abstract(TInterfacedObject) /// IDBMetaData. Required meta data object. class function Instance(ACollection: TCollection): IDBMetaData; virtual; abstract; + /// Gets the meta data capabilities for the collection data + /// format. + /// TMetaDataCapabilities. Required meta data capabilities. + /// + /// This method enables meta data capabilities to be obtained + /// without creating an instance of the object. + class function Capabilities: TMetaDataCapabilities; virtual; abstract; + /// Returns information about what, if any, meta data is supported + /// by a collection. + /// This method provides a means of accessing the data returned by + /// the Capabilities class method from IDBMetaData instances. + /// + function GetCapabilities: TMetaDataCapabilities; virtual; end; TRegisterableMetaDataClass = class of TRegisterableMetaData; @@ -161,8 +174,10 @@ TRegisterableMetaDataClass = class of TRegisterableMetaData; TMetaDataFactory = record strict private class var - /// Map of collection format kinds to functions that create - /// meta data objects of the required type. + {TODO -Refactor: rename fCallbackMap since it does not contain callback, + but does contain class types.} + /// Map of collection format kinds to classes that implement the + /// format's meta data. fCallbackMap: TDictionary< TCollectionFormatKind, TRegisterableMetaDataClass >; @@ -186,6 +201,14 @@ TMetaDataFactory = record /// ACollection. class function CreateInstance(const ACollection: TCollection): IDBMetaData; static; + /// Gets the meta data capabilities for a collection data format. + /// + /// TCollectionFormatKind [in] Collection data + /// format for which meta data capabilities are required. + /// TMetaDataCapabilities. Required meta data capabilities. + /// + class function CapabilitiesOf(const AFormat: TCollectionFormatKind): + TMetaDataCapabilities; static; end; implementation @@ -294,8 +317,24 @@ function TDBCopyrightInfo.ToString: string; Result := sCopyright + ' ' + Result; end; +{ TRegisterableMetaData } + +function TRegisterableMetaData.GetCapabilities: TMetaDataCapabilities; +begin + Result := Capabilities; +end; + { TMetaDataFactory } +class function TMetaDataFactory.CapabilitiesOf( + const AFormat: TCollectionFormatKind): TMetaDataCapabilities; +begin + if fCallbackMap.ContainsKey(AFormat) then + Result := fCallbackMap[AFormat].Capabilities + else + Result := []; +end; + class constructor TMetaDataFactory.Create; begin fCallbackMap := TDictionary< diff --git a/Src/DBIO.MetaData.DCSC.pas b/Src/DBIO.MetaData.DCSC.pas index f4b3d2286..d1db872bd 100644 --- a/Src/DBIO.MetaData.DCSC.pas +++ b/Src/DBIO.MetaData.DCSC.pas @@ -336,11 +336,15 @@ TAbstractMainDBMetaData = class abstract(TRegisterableMetaData) /// collection's format. /// Must be called from a concrete descendant class. class function Instance(ACollection: TCollection): IDBMetaData; override; + /// Gets the meta data capabilities for the collection data + /// format. + /// TMetaDataCapabilities. Required meta data capabilities. + /// + /// This method enables meta data capabilities to be obtained + /// without creating an instance of the object. + class function Capabilities: TMetaDataCapabilities; override; procedure AfterConstruction; override; destructor Destroy; override; - /// Returns information about what, if any, meta data is supported - /// by a collection. - function GetCapabilities: TMetaDataCapabilities; /// Returns database version number. /// /// A null version number is returned if the meta data does not come @@ -442,15 +446,15 @@ procedure TAbstractMainDBMetaData.AfterConstruction; Refresh; end; -destructor TAbstractMainDBMetaData.Destroy; +class function TAbstractMainDBMetaData.Capabilities: TMetaDataCapabilities; begin - fMetaFiles.Free; - inherited; + Result := [mdcVersion, mdcLicense, mdcCopyright, mdcContributors, mdcTesters]; end; -function TAbstractMainDBMetaData.GetCapabilities: TMetaDataCapabilities; +destructor TAbstractMainDBMetaData.Destroy; begin - Result := [mdcVersion, mdcLicense, mdcCopyright, mdcContributors, mdcTesters]; + fMetaFiles.Free; + inherited; end; function TAbstractMainDBMetaData.GetContributors: IStringList; From ae4be0b32d734c14b36b978dacdf6fd22eea0d1d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 26 Nov 2024 01:58:59 +0000 Subject: [PATCH 126/222] Updated TCollectionFormatInfo Added new GetSupportedFormats method and DefaultFormat public constant to TCollectionFormatInfo. Also revised the names of the supported formats and re-ordered the lookup table so the the default format is listed first. --- Src/DB.UCollections.pas | 30 +++++++++++++++++++++++++++--- 1 file changed, 27 insertions(+), 3 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index c0fcff1db..64f621f9c 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -62,17 +62,26 @@ TMapRecord = record // There are so few entries in this table it's not worth the overhead // of using a dicitionary for the lookup. LookupTable: array[0..1] of TMapRecord = ( - (Kind: TCollectionFormatKind.DCSC_v2; - Name: 'DelphiDabbler Code Snippets Collection format v2'), (Kind: TCollectionFormatKind.Native_v4; - Name: 'CodeSnip v4 native snippet collection format') + Name: 'CodeSnip Native Snippet Collection v4'), + (Kind: TCollectionFormatKind.DCSC_v2; + Name: 'DelphiDabbler Code Snippets Collection v2') ); class function IndexOf(const AKind: TCollectionFormatKind): Integer; static; + public + const + /// Specifies the data format used for the default collection. + /// + DefaultFormat = TCollectionFormatKind.Native_v4; public /// Gets the name of the data format specified by /// AKind. Returns an empty string if no name is associated with /// AKind. class function GetName(const AKind: TCollectionFormatKind): string; static; + /// Returns an array of all supported data formats. + /// TArray<TCollectionFormatKind>. Array of values + /// that identify the supported data formats. + class function GetSupportedFormats: TArray; static; end; type @@ -697,6 +706,21 @@ class function TCollectionFormatInfo.GetName( Result := LookupTable[Idx].Name; end; +class function TCollectionFormatInfo.GetSupportedFormats: + TArray; +var + Idx: Integer; + Item: TMapRecord; +begin + SetLength(Result, Length(LookupTable)); + Idx := 0; + for Item in LookupTable do + begin + Result[Idx] := Item.Kind; + Inc(Idx); + end; +end; + class function TCollectionFormatInfo.IndexOf( const AKind: TCollectionFormatKind): Integer; var From 739fac4c79cee1fde43b7063cd20f965b361aac8 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 26 Nov 2024 11:42:45 +0000 Subject: [PATCH 127/222] Move collection data format code to new unit Added new DB.DataFormats unit to project Removed TCollectionFormatKind enumerated type and TCollectionFormatInfo record with methods from DB.UCollections into DB.DataFormats and renamed them as TDataFormatKind and TDataFormatInfo respectively. Updated all units affected by the change of unit and name changes. --- Src/CodeSnip.dpr | 3 +- Src/CodeSnip.dproj | 1 + Src/DB.DataFormats.pas | 103 +++++++++++++++++++++++++++++++ Src/DB.UCollections.pas | 122 ++++--------------------------------- Src/DB.UDatabaseIO.pas | 9 +-- Src/DB.UMetaData.pas | 15 +++-- Src/DBIO.MetaData.DCSC.pas | 7 ++- 7 files changed, 134 insertions(+), 126 deletions(-) create mode 100644 Src/DB.DataFormats.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 1d97e2f80..f9d75bbb9 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -379,7 +379,8 @@ uses DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas', UCollectionListAdapter in 'UCollectionListAdapter.pas', DBIO.MetaData.DCSC in 'DBIO.MetaData.DCSC.pas', - FmCollectionBackup in 'FmCollectionBackup.pas' {CollectionBackupDlg}; + FmCollectionBackup in 'FmCollectionBackup.pas' {CollectionBackupDlg}, + DB.DataFormats in 'DB.DataFormats.pas'; // Include resources {$Resource ExternalObj.tlb} // Type library file diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 3c4760e24..d0995c58d 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -588,6 +588,7 @@
CollectionBackupDlg
 + Base diff --git a/Src/DB.DataFormats.pas b/Src/DB.DataFormats.pas new file mode 100644 index 000000000..519c409f4 --- /dev/null +++ b/Src/DB.DataFormats.pas @@ -0,0 +1,103 @@ +unit DB.DataFormats; + +interface + +type + + /// Enumeration of the kinds of supported snippet collection data + /// formats. + /// + /// Error -- Invalid format. Used to indicate an unknown format + /// or other error. + /// DCSC_v2 -- Format used by the DelphiDabbler Code Snippets + /// Collection v2. + /// Native_v4 -- Native format used by CodeSnip v4 to store user + /// snippets. + /// + TDataFormatKind = ( + // NEVER specify a literal ordinal value in this enumeration. + // NEVER delete or re-order the enumeration items: the ordinal values may + // be written to a config file and changing the ordinal value here can + // cause hard to trace bugs. If an item goes out of use then leave it + // in place & possibly rename the item to indicate its redundancy. + // NEVER associate error with a format loader or saver class. + Error, + DCSC_v2, + Native_v4 + ); + + + TDataFormatInfo = record + strict private + type + TMapRecord = record + /// Collection data format kind. + Kind: TDataFormatKind; + /// Collection data format name. + Name: string; + end; + const + // There are so few entries in this table it's not worth the overhead + // of using a dicitionary for the lookup. + LookupTable: array[0..1] of TMapRecord = ( + (Kind: TDataFormatKind.Native_v4; + Name: 'CodeSnip Native Snippet Collection v4'), + (Kind: TDataFormatKind.DCSC_v2; + Name: 'DelphiDabbler Code Snippets Collection v2') + ); + class function IndexOf(const AKind: TDataFormatKind): Integer; static; + public + const + /// Specifies the data format used for the default collection. + /// + DefaultFormat = TDataFormatKind.Native_v4; + public + /// Gets the name of the data format specified by + /// AKind. Returns an empty string if no name is associated with + /// AKind. + class function GetName(const AKind: TDataFormatKind): string; static; + /// Returns an array of all supported data formats. + /// TArray<TDataFormatKind>. Array of values + /// that identify the supported data formats. + class function GetSupportedFormats: TArray; static; + end; + +implementation + +{ TDataFormatInfo } + +class function TDataFormatInfo.GetName(const AKind: TDataFormatKind): string; +var + Idx: Integer; +begin + Idx := IndexOf(AKind); + if Idx < 0 then + Exit(''); + Result := LookupTable[Idx].Name; +end; + +class function TDataFormatInfo.GetSupportedFormats: TArray; +var + Idx: Integer; + Item: TMapRecord; +begin + SetLength(Result, Length(LookupTable)); + Idx := 0; + for Item in LookupTable do + begin + Result[Idx] := Item.Kind; + Inc(Idx); + end; +end; + +class function TDataFormatInfo.IndexOf(const AKind: TDataFormatKind): Integer; +var + Idx: Integer; +begin + Result := -1; + for Idx := Low(LookupTable) to High(LookupTable) do + if LookupTable[Idx].Kind = AKind then + Exit(Idx); +end; + +end. diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 64f621f9c..0764fe91d 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -19,71 +19,13 @@ interface SysUtils, Generics.Collections, Generics.Defaults, + + DB.DataFormats, UEncodings, UExceptions, USettings, USingleton; -type - - /// Enumeration of the kinds of supported snippet collection data - /// formats. - /// - /// Error -- Invalid format. Used to indicate an unknown format - /// or other error. - /// DCSC_v2 -- Format used by the DelphiDabbler Code Snippets - /// Collection v2. - /// Native_v4 -- Native format used by CodeSnip v4 to store user - /// snippets. - /// - TCollectionFormatKind = ( // TODO: move to more appropriate unit - // NEVER specify a literal ordinal value in this enumeration. - // NEVER delete or re-order the enumeration items: the ordinal values may - // be written to a config file and changing the ordinal value here can - // cause hard to trace bugs. If an item goes out of use then leave it - // in place & possibly rename the item to indicate its redundancy. - // NEVER associate error with a format loader or saver class. - Error, - DCSC_v2, - Native_v4 - ); - - - TCollectionFormatInfo = record // TODO: move to more appropriate unit - strict private - type - TMapRecord = record - /// Collection data format kind. - Kind: TCollectionFormatKind; - /// Collection data format name. - Name: string; - end; - const - // There are so few entries in this table it's not worth the overhead - // of using a dicitionary for the lookup. - LookupTable: array[0..1] of TMapRecord = ( - (Kind: TCollectionFormatKind.Native_v4; - Name: 'CodeSnip Native Snippet Collection v4'), - (Kind: TCollectionFormatKind.DCSC_v2; - Name: 'DelphiDabbler Code Snippets Collection v2') - ); - class function IndexOf(const AKind: TCollectionFormatKind): Integer; static; - public - const - /// Specifies the data format used for the default collection. - /// - DefaultFormat = TCollectionFormatKind.Native_v4; - public - /// Gets the name of the data format specified by - /// AKind. Returns an empty string if no name is associated with - /// AKind. - class function GetName(const AKind: TCollectionFormatKind): string; static; - /// Returns an array of all supported data formats. - /// TArray<TCollectionFormatKind>. Array of values - /// that identify the supported data formats. - class function GetSupportedFormats: TArray; static; - end; - type TCollectionID = record @@ -177,7 +119,7 @@ TCollection = record fUID: TCollectionID; fName: string; fLocation: TCollectionLocation; - fCollectionFormatKind: TCollectionFormatKind; + fCollectionFormatKind: TDataFormatKind; public type TComparer = class(TInterfacedObject, @@ -197,7 +139,7 @@ TComparer = class(TInterfacedObject, /// unique. Must not be empty or only whitespace. constructor Create(const AUID: TCollectionID; const AName: string; const ALocation: TCollectionLocation; - const ACollectionFormatKind: TCollectionFormatKind); + const ACollectionFormatKind: TDataFormatKind); /// Collection identifier. Must be unique. property UID: TCollectionID read fUID; @@ -209,8 +151,7 @@ TComparer = class(TInterfacedObject, read fLocation; /// Kind of collection format used for to store data for this /// collection. - property CollectionFormatKind: TCollectionFormatKind - read fCollectionFormatKind; + property CollectionFormatKind: TDataFormatKind read fCollectionFormatKind; /// Checks if this record's fields are valid. function IsValid: Boolean; /// Checks if this record is the default collection. @@ -314,7 +255,7 @@ procedure TCollectionLocation.SetDirectory(const ANewDirectory: string); constructor TCollection.Create(const AUID: TCollectionID; const AName: string; const ALocation: TCollectionLocation; - const ACollectionFormatKind: TCollectionFormatKind); + const ACollectionFormatKind: TDataFormatKind); var TrimmedName: string; begin @@ -323,7 +264,7 @@ constructor TCollection.Create(const AUID: TCollectionID; Assert(TrimmedName <> '', 'TCollection.Create: AName is empty or only whitespace'); Assert(ALocation.IsValid, 'TCollection.Create: ALocation is not valid'); - Assert(ACollectionFormatKind <> TCollectionFormatKind.Error, + Assert(ACollectionFormatKind <> TDataFormatKind.Error, 'TCollection.Create: ACollectionFormatKind = TCollectionFormatKind.Error'); fUID := AUID.Clone; fName := TrimmedName; @@ -343,7 +284,7 @@ function TCollection.IsValid: Boolean; Result := not fUID.IsNull and (fName <> '') and fLocation.IsValid - and (fCollectionFormatKind <> TCollectionFormatKind.Error); + and (fCollectionFormatKind <> TDataFormatKind.Error); end; { TCollections } @@ -472,7 +413,7 @@ procedure TCollections.Initialize; TCollectionLocation.Create( TAppInfo.UserDefaultCollectionDir, '', etUTF8 ), - TCollectionFormatKind.Native_v4 + TDataFormatKind.Native_v4 ) ); end; @@ -636,7 +577,7 @@ class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; UID: TCollectionID; Name: string; Collection: TCollection; - DataFormat: TCollectionFormatKind; + DataFormat: TDataFormatKind; begin Storage := Settings.ReadSection(ssCollection, IntToStr(AOrdinal)); UID := TCollectionID.Create(Storage.GetBytes(UIDKey)); @@ -653,8 +594,8 @@ class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; ) ) ); - DataFormat := TCollectionFormatKind( - Storage.GetInteger(DataFormatKey, Ord(TCollectionFormatKind.Error)) + DataFormat := TDataFormatKind( + Storage.GetInteger(DataFormatKey, Ord(TDataFormatKind.Error)) ); Collection := TCollection.Create(UID, Name, Location, DataFormat); ACollections.Add(Collection); @@ -693,45 +634,6 @@ class procedure TCollectionsPersist.SaveCollection(const AOrdinal: Cardinal; Storage.Save; end; -{ TCollectionFormatInfo } - -class function TCollectionFormatInfo.GetName( - const AKind: TCollectionFormatKind): string; -var - Idx: Integer; -begin - Idx := IndexOf(AKind); - if Idx < 0 then - Exit(''); - Result := LookupTable[Idx].Name; -end; - -class function TCollectionFormatInfo.GetSupportedFormats: - TArray; -var - Idx: Integer; - Item: TMapRecord; -begin - SetLength(Result, Length(LookupTable)); - Idx := 0; - for Item in LookupTable do - begin - Result[Idx] := Item.Kind; - Inc(Idx); - end; -end; - -class function TCollectionFormatInfo.IndexOf( - const AKind: TCollectionFormatKind): Integer; -var - Idx: Integer; -begin - Result := -1; - for Idx := Low(LookupTable) to High(LookupTable) do - if LookupTable[Idx].Kind = AKind then - Exit(Idx); -end; - { TCollection.TComparer } function TCollection.TComparer.Compare(const Left, Right: TCollection): Integer; diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 2fd8f31f9..565b7e8bd 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -131,6 +131,7 @@ implementation Generics.Collections, IOUtils, // Project + DB.DataFormats, DBIO.UCategoryIO, DBIO.UFileIOIntf, DBIO.UIniData, @@ -422,9 +423,9 @@ class function TDatabaseIOFactory.CreateDBLoader(const Collection: TCollection): {TODO -cUDatabaseIO: Revise database loaders to get file path and other info from collection instead of hard wiring it.} case Collection.CollectionFormatKind of - TCollectionFormatKind.DCSC_v2: + TDataFormatKind.DCSC_v2: Result := TDCSCV2FormatLoader.Create(Collection); - TCollectionFormatKind.Native_v4: + TDataFormatKind.Native_v4: Result := TNativeV4FormatLoader.Create(Collection); else Result := nil; @@ -435,9 +436,9 @@ class function TDatabaseIOFactory.CreateDBSaver( const Collection: TCollection): IDataFormatSaver; begin case Collection.CollectionFormatKind of - TCollectionFormatKind.DCSC_v2: + TDataFormatKind.DCSC_v2: Result := TDCSCV2FormatSaver.Create(Collection); - TCollectionFormatKind.Native_v4: + TDataFormatKind.Native_v4: Result := TNativeV4FormatSaver.Create(Collection); else Result := nil; diff --git a/Src/DB.UMetaData.pas b/Src/DB.UMetaData.pas index 88f83d657..442630bc0 100644 --- a/Src/DB.UMetaData.pas +++ b/Src/DB.UMetaData.pas @@ -21,6 +21,7 @@ interface Generics.Collections, // Project DB.UCollections, + DB.DataFormats, UIStringList, UVersionInfo; @@ -178,9 +179,7 @@ TMetaDataFactory = record but does contain class types.} /// Map of collection format kinds to classes that implement the /// format's meta data. - fCallbackMap: TDictionary< - TCollectionFormatKind, TRegisterableMetaDataClass - >; + fCallbackMap: TDictionary; public class constructor Create; class destructor Destroy; @@ -190,7 +189,7 @@ TMetaDataFactory = record /// format for which the meta data class is being registered. /// TRegisterableMetaDataClass [in] Type of /// class to create. - class procedure RegisterCreator(AFormat: TCollectionFormatKind; + class procedure RegisterCreator(AFormat: TDataFormatKind; AClass: TRegisterableMetaDataClass); static; /// Creates a meta data object instance that can read a given /// collection data format. @@ -207,7 +206,7 @@ TMetaDataFactory = record /// format for which meta data capabilities are required. /// TMetaDataCapabilities. Required meta data capabilities. /// - class function CapabilitiesOf(const AFormat: TCollectionFormatKind): + class function CapabilitiesOf(const AFormat: TDataFormatKind): TMetaDataCapabilities; static; end; @@ -327,7 +326,7 @@ function TRegisterableMetaData.GetCapabilities: TMetaDataCapabilities; { TMetaDataFactory } class function TMetaDataFactory.CapabilitiesOf( - const AFormat: TCollectionFormatKind): TMetaDataCapabilities; + const AFormat: TDataFormatKind): TMetaDataCapabilities; begin if fCallbackMap.ContainsKey(AFormat) then Result := fCallbackMap[AFormat].Capabilities @@ -338,7 +337,7 @@ class function TMetaDataFactory.CapabilitiesOf( class constructor TMetaDataFactory.Create; begin fCallbackMap := TDictionary< - TCollectionFormatKind, TRegisterableMetaDataClass + TDataFormatKind, TRegisterableMetaDataClass >.Create; end; @@ -359,7 +358,7 @@ class function TMetaDataFactory.CreateInstance(const ACollection: TCollection): end; class procedure TMetaDataFactory.RegisterCreator( - AFormat: TCollectionFormatKind; AClass: TRegisterableMetaDataClass); + AFormat: TDataFormatKind; AClass: TRegisterableMetaDataClass); begin fCallbackMap.AddOrSetValue(AFormat, AClass); end; diff --git a/Src/DBIO.MetaData.DCSC.pas b/Src/DBIO.MetaData.DCSC.pas index d1db872bd..5c1c3444e 100644 --- a/Src/DBIO.MetaData.DCSC.pas +++ b/Src/DBIO.MetaData.DCSC.pas @@ -429,10 +429,11 @@ TUpdateDBMetaData = class sealed(TAbstractMainDBMetaData, IDBMetaData) implementation uses - // Project + // Delphi Classes, IOUtils, - // VCL + // Project + DB.DataFormats, UEncodings, UIOUtils, UResourceUtils, @@ -839,7 +840,7 @@ class function TDBMetaFilesFactory.GetInstance(const DBDir: string): initialization TMetaDataFactory.RegisterCreator( - TCollectionFormatKind.DCSC_v2, TMainDBMetaData + TDataFormatKind.DCSC_v2, TMainDBMetaData ); end. From b4ca46c2c870cc4e4109a629bc32f020d12510f2 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 26 Nov 2024 11:48:13 +0000 Subject: [PATCH 128/222] Refactor creation of default collection The code that creates the Default collection now gets the data format from the TDataFormatInfo.DefaultFormat constant instead of hard-wiring TDataFormatKind.Native_v4. This protects against a possible bug if the default data format is changed. --- Src/DB.UCollections.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 0764fe91d..06ea12b5d 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -413,7 +413,7 @@ procedure TCollections.Initialize; TCollectionLocation.Create( TAppInfo.UserDefaultCollectionDir, '', etUTF8 ), - TDataFormatKind.Native_v4 + TDataFormatInfo.DefaultFormat ) ); end; From 9e698e4d60079c2b38611a7b055b7ddbc34c8b73 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 26 Nov 2024 19:43:59 +0000 Subject: [PATCH 129/222] Revise how TCollection handles data storage info TCollection previously and a Location of type TCollectionLocation property that stored the directory in which the collection is stored along with a CollectionFormatKind property to store the collection's data format. TCollectionLocation also had some other properties that have never found a used. A new record, TDataStorageDetails, was added to DB.DataFormats that records both the data format kind and the directory used to store the collection. TCollection replaced its Location and CollectionFormatKind properties with a single Storage property of type TDataStorageDetails. The key/value pairs in the [Collection:X] config file sections were revised to store the new TCollection property values and not to store the removed property values. Calling code was modified as necessary re these changes. The redundant TCollectionLocation record was deleted. --- Src/DB.DataFormats.pas | 39 +++++++- Src/DB.UCollections.pas | 188 +++++++++---------------------------- Src/DB.UDatabaseIO.pas | 12 +-- Src/DB.UMetaData.pas | 16 ++-- Src/DBIO.MetaData.DCSC.pas | 21 ++--- Src/FmAboutDlg.pas | 5 +- Src/FmUserDataPathDlg.pas | 2 +- Src/USaveUnitMgr.pas | 3 +- Src/USnippetDoc.pas | 3 +- Src/USnippetSourceGen.pas | 3 +- Src/UUserDBBackup.pas | 4 +- Src/UUserDBMgr.pas | 4 +- Src/UUserDBMove.pas | 6 +- 13 files changed, 121 insertions(+), 185 deletions(-) diff --git a/Src/DB.DataFormats.pas b/Src/DB.DataFormats.pas index 519c409f4..8207c0940 100644 --- a/Src/DB.DataFormats.pas +++ b/Src/DB.DataFormats.pas @@ -26,14 +26,35 @@ interface Native_v4 ); + /// Record containing details of the data format and location in + /// which a collection is stored. + TDataStorageDetails = record + strict private + var + /// Value of the Directory property. + fDirectory: string; + /// Value of the Format property. + fFormat: TDataFormatKind; + /// Write access method for Directory property. + procedure SetDirectory(const AValue: string); + public + /// Constructs a new record instance with the given property + /// values. + constructor Create(const AFormat: TDataFormatKind; + const ADirectory: string); + /// The format in which the data is stored. + property Format: TDataFormatKind read fFormat; + /// The directory in which the data is stored. + property Directory: string read fDirectory write SetDirectory; + end; TDataFormatInfo = record strict private type TMapRecord = record - /// Collection data format kind. + /// Data format kind. Kind: TDataFormatKind; - /// Collection data format name. + /// Data format name. Name: string; end; const @@ -100,4 +121,18 @@ class function TDataFormatInfo.IndexOf(const AKind: TDataFormatKind): Integer; Exit(Idx); end; +{ TDataStorageDetails } + +constructor TDataStorageDetails.Create(const AFormat: TDataFormatKind; + const ADirectory: string); +begin + fFormat := AFormat; + fDirectory := ADirectory; +end; + +procedure TDataStorageDetails.SetDirectory(const AValue: string); +begin + fDirectory := AValue; +end; + end. diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 06ea12b5d..b1d7e9800 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -63,63 +63,12 @@ TComparer = class(TInterfacedObject, ECollectionID = class(ECodeSnip); - TCollectionLocation = record - strict private - var - fDirectory: string; - fMetaDataFile: string; - fEncodingHint: TEncodingType; - procedure SetDirectory(const ANewDirectory: string); - public - - /// Instantiates a record with given values. - /// string [in] File system directory - /// containing the collection data. Must be non-empty and a valid directory - /// name. - /// string [in] Path to the collection's - /// meta data file, if any. May be empty if collection has no meta data - /// file or if the meta data file name is fixed. If non-empty the path must - /// be relative to ADirectory. Optional: default is empty string. - /// - /// TEncodingType [in] Hints at the - /// encoding used by text files in ADirectory. Only required if the - /// text files are not used in the collection or if the collection format - /// specifies the text format. Optional: default is system default - /// encoding. - constructor Create(const ADirectory: string; - const AMetaDataFile: string = ''; - const AEncodingHint: TEncodingType = TEncodingType.etSysDefault); - - /// File system directory containing the collection data. - /// - /// Must be a valid directory name and must exist. - property Directory: string read fDirectory write SetDirectory; - - /// Name of any meta data file, relative to Directory. - /// - /// May be empty string. If non-empty must be a valid path name - /// and the file must exist. - property MetaDataFile: string read fMetaDataFile; - - /// Hints at the type of encoding used by the text files in - /// Directory. - /// EncodingHint should only be used where the I/O code has - /// no knowledge of the expected text file encoding AND the where the files - /// do not contain preamble bytes that specify the encoding. - property EncodingHint: TEncodingType read fEncodingHint; - - /// Checks if the record instance has valid fields. - function IsValid: Boolean; - - end; - TCollection = record strict private var fUID: TCollectionID; fName: string; - fLocation: TCollectionLocation; - fCollectionFormatKind: TDataFormatKind; + fStorage: TDataStorageDetails; public type TComparer = class(TInterfacedObject, @@ -138,20 +87,16 @@ TComparer = class(TInterfacedObject, /// string [in] Name of collection. Should be /// unique. Must not be empty or only whitespace. constructor Create(const AUID: TCollectionID; const AName: string; - const ALocation: TCollectionLocation; - const ACollectionFormatKind: TDataFormatKind); + const AStorage: TDataStorageDetails); /// Collection identifier. Must be unique. property UID: TCollectionID read fUID; /// Collection name. Must be unique. property Name: string read fName; - /// Collection location information. - property Location: TCollectionLocation - read fLocation; - /// Kind of collection format used for to store data for this - /// collection. - property CollectionFormatKind: TDataFormatKind read fCollectionFormatKind; + /// Collection storage information. + property Storage: TDataStorageDetails + read fStorage; /// Checks if this record's fields are valid. function IsValid: Boolean; /// Checks if this record is the default collection. @@ -193,10 +138,8 @@ TCollectionsPersist = record CountKey = 'Count'; UIDKey = 'UID'; NameKey = 'Name'; - LocationDirectoryKey = 'Location.Directory'; - LocationMetaDataFileKey = 'Location.MetaDataFile'; - LocationEncodingHintKey = 'Location.EncodingHint'; - DataFormatKey = 'DataFormat'; + StorageFormatKey = 'Storage.Format'; + StorageDirectoryKey = 'Storage.Directory'; class procedure SaveCollection(const AOrdinal: Cardinal; const ACollection: TCollection); static; class procedure LoadCollection(const AOrdinal: Cardinal; @@ -221,41 +164,10 @@ implementation resourcestring SBadHexString = 'Invalid Hex String.'; -{ TCollectionLocation } - -constructor TCollectionLocation.Create(const ADirectory, - AMetaDataFile: string; const AEncodingHint: TEncodingType); -begin - fDirectory := StrTrim(ADirectory); - fMetaDataFile := StrTrim(AMetaDataFile); - fEncodingHint := AEncodingHint; - Assert(IsValid, 'TCollectionLocation.Create: invalid parameter(s)'); -end; - -function TCollectionLocation.IsValid: Boolean; -begin - Result := True; - if fDirectory = '' then - Exit(False); - if not TPath.HasValidPathChars(fDirectory, False) then - Exit(False); - if (fMetaDataFile <> '') then - begin - if not TPath.IsRelativePath(fMetaDataFile) then - Exit(False); - end; -end; - -procedure TCollectionLocation.SetDirectory(const ANewDirectory: string); -begin - fDirectory := ANewDirectory; -end; - { TCollection } -constructor TCollection.Create(const AUID: TCollectionID; - const AName: string; const ALocation: TCollectionLocation; - const ACollectionFormatKind: TDataFormatKind); +constructor TCollection.Create(const AUID: TCollectionID; const AName: string; + const AStorage: TDataStorageDetails); var TrimmedName: string; begin @@ -263,13 +175,12 @@ constructor TCollection.Create(const AUID: TCollectionID; Assert(not AUID.IsNull, 'TCollection.Create: AUID is null'); Assert(TrimmedName <> '', 'TCollection.Create: AName is empty or only whitespace'); - Assert(ALocation.IsValid, 'TCollection.Create: ALocation is not valid'); - Assert(ACollectionFormatKind <> TDataFormatKind.Error, - 'TCollection.Create: ACollectionFormatKind = TCollectionFormatKind.Error'); + {TODO -cRefactor: move following into IsValid method of TDataDetails} + Assert(AStorage.Format <> TDataFormatKind.Error, + 'TCollection.Create: ADataDetails.Kind = TCollectionFormatKind.Error'); fUID := AUID.Clone; fName := TrimmedName; - fLocation := ALocation; - fCollectionFormatKind := ACollectionFormatKind; + fStorage := AStorage; end; function TCollection.IsDefault: Boolean; @@ -283,8 +194,7 @@ function TCollection.IsValid: Boolean; may not be needed.} Result := not fUID.IsNull and (fName <> '') - and fLocation.IsValid - and (fCollectionFormatKind <> TDataFormatKind.Error); + and (fStorage.Format <> TDataFormatKind.Error); end; { TCollections } @@ -410,10 +320,10 @@ procedure TCollections.Initialize; TCollection.Create( TCollectionID.Default, 'Default', - TCollectionLocation.Create( - TAppInfo.UserDefaultCollectionDir, '', etUTF8 - ), - TDataFormatInfo.DefaultFormat + TDataStorageDetails.Create( + TDataFormatInfo.DefaultFormat, + TAppInfo.UserDefaultCollectionDir + ) ) ); end; @@ -559,12 +469,12 @@ function TCollectionID.TComparer.GetHashCode( class procedure TCollectionsPersist.Load( const ACollections: TCollections); var - Storage: ISettingsSection; + ConfigSection: ISettingsSection; Count: Integer; Idx: Integer; begin - Storage := Settings.ReadSection(ssCollections); - Count := Storage.GetInteger(CountKey, 0); + ConfigSection := Settings.ReadSection(ssCollections); + Count := ConfigSection.GetInteger(CountKey, 0); for Idx := 0 to Pred(Count) do LoadCollection(Idx, ACollections); end; @@ -572,45 +482,39 @@ class procedure TCollectionsPersist.Load( class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; const ACollections: TCollections); var - Storage: ISettingsSection; - Location: TCollectionLocation; + ConfigSection: ISettingsSection; UID: TCollectionID; Name: string; Collection: TCollection; - DataFormat: TDataFormatKind; + StorageDetails: TDataStorageDetails; begin - Storage := Settings.ReadSection(ssCollection, IntToStr(AOrdinal)); - UID := TCollectionID.Create(Storage.GetBytes(UIDKey)); + ConfigSection := Settings.ReadSection(ssCollection, IntToStr(AOrdinal)); + UID := TCollectionID.Create(ConfigSection.GetBytes(UIDKey)); if ACollections.ContainsID(UID) then // Don't load a duplicate collection Exit; - Name := Storage.GetString(NameKey, ''); - Location := TCollectionLocation.Create( - Storage.GetString(LocationDirectoryKey, ''), - Storage.GetString(LocationMetaDataFileKey, ''), - TEncodingType( - Storage.GetInteger( - LocationEncodingHintKey, Ord(TEncodingType.etSysDefault) - ) - ) - ); - DataFormat := TDataFormatKind( - Storage.GetInteger(DataFormatKey, Ord(TDataFormatKind.Error)) + Name := ConfigSection.GetString(NameKey, ''); + + StorageDetails := TDataStorageDetails.Create( + TDataFormatKind( + ConfigSection.GetInteger(StorageFormatKey, Ord(TDataFormatKind.Error)) + ), + ConfigSection.GetString(StorageDirectoryKey, '') ); - Collection := TCollection.Create(UID, Name, Location, DataFormat); + Collection := TCollection.Create(UID, Name, StorageDetails); ACollections.Add(Collection); end; class procedure TCollectionsPersist.Save(const ACollections: TCollections); var - Storage: ISettingsSection; + ConfigSection: ISettingsSection; Idx: Integer; begin // Save number of collections - Storage := Settings.EmptySection(ssCollections); - Storage.SetInteger(CountKey, ACollections.Count); - Storage.Save; + ConfigSection := Settings.EmptySection(ssCollections); + ConfigSection.SetInteger(CountKey, ACollections.Count); + ConfigSection.Save; // Save each collection's properties in its own section for Idx := 0 to Pred(ACollections.Count) do SaveCollection(Idx, ACollections[Idx]); @@ -619,19 +523,15 @@ class procedure TCollectionsPersist.Save(const class procedure TCollectionsPersist.SaveCollection(const AOrdinal: Cardinal; const ACollection: TCollection); var - Storage: ISettingsSection; + ConfigSection: ISettingsSection; begin // Save info about collection format in its own section - Storage := Settings.EmptySection(ssCollection, IntToStr(AOrdinal)); - Storage.SetBytes(UIDKey, ACollection.UID.ToArray); - Storage.SetString(NameKey, ACollection.Name); - Storage.SetString(LocationDirectoryKey, ACollection.Location.Directory); - Storage.SetString(LocationMetaDataFileKey, ACollection.Location.MetaDataFile); - Storage.SetInteger( - LocationEncodingHintKey, Ord(ACollection.Location.EncodingHint) - ); - Storage.SetInteger(DataFormatKey, Ord(ACollection.CollectionFormatKind)); - Storage.Save; + ConfigSection := Settings.EmptySection(ssCollection, IntToStr(AOrdinal)); + ConfigSection.SetBytes(UIDKey, ACollection.UID.ToArray); + ConfigSection.SetString(NameKey, ACollection.Name); + ConfigSection.SetInteger(StorageFormatKey, Ord(ACollection.Storage.Format)); + ConfigSection.SetString(StorageDirectoryKey, ACollection.Storage.Directory); + ConfigSection.Save; end; { TCollection.TComparer } diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 565b7e8bd..6fa7eab71 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -422,7 +422,7 @@ class function TDatabaseIOFactory.CreateDBLoader(const Collection: TCollection): begin {TODO -cUDatabaseIO: Revise database loaders to get file path and other info from collection instead of hard wiring it.} - case Collection.CollectionFormatKind of + case Collection.Storage.Format of TDataFormatKind.DCSC_v2: Result := TDCSCV2FormatLoader.Create(Collection); TDataFormatKind.Native_v4: @@ -435,7 +435,7 @@ class function TDatabaseIOFactory.CreateDBLoader(const Collection: TCollection): class function TDatabaseIOFactory.CreateDBSaver( const Collection: TCollection): IDataFormatSaver; begin - case Collection.CollectionFormatKind of + case Collection.Storage.Format of TDataFormatKind.DCSC_v2: Result := TDCSCV2FormatSaver.Create(Collection); TDataFormatKind.Native_v4: @@ -641,7 +641,7 @@ function TDCSCV2FormatLoader.CreateReader: IDataReader; @return Reader object instance. } begin - Result := TIniDataReader.Create(Collection.Location.Directory); + Result := TIniDataReader.Create(Collection.Storage.Directory); if not Result.DatabaseExists then Result := TNulDataReader.Create; end; @@ -664,7 +664,7 @@ function TNativeV4FormatLoader.CreateReader: IDataReader; @return Reader object instance. } begin - Result := TXMLDataReader.Create(Collection.Location.Directory); + Result := TXMLDataReader.Create(Collection.Storage.Directory); if not Result.DatabaseExists then Result := TNulDataReader.Create; end; @@ -779,7 +779,7 @@ constructor TDCSCV2FormatSaver.Create(const ACollection: TCollection); function TDCSCV2FormatSaver.CreateWriter: IDataWriter; begin - Result := TIniDataWriter.Create(Collection.Location.Directory); + Result := TIniDataWriter.Create(Collection.Storage.Directory); end; procedure TDCSCV2FormatSaver.Restore; @@ -814,7 +814,7 @@ procedure TDCSCV2FormatSaver.Save(const SnipList: TSnippetList; function TNativeV4FormatSaver.CreateWriter: IDataWriter; begin - Result := TXMLDataWriter.Create(Collection.Location.Directory); + Result := TXMLDataWriter.Create(Collection.Storage.Directory); end; procedure TNativeV4FormatSaver.Save(const SnipList: TSnippetList; diff --git a/Src/DB.UMetaData.pas b/Src/DB.UMetaData.pas index 442630bc0..93171ebb4 100644 --- a/Src/DB.UMetaData.pas +++ b/Src/DB.UMetaData.pas @@ -20,7 +20,6 @@ interface // Delphi Generics.Collections, // Project - DB.UCollections, DB.DataFormats, UIStringList, UVersionInfo; @@ -151,7 +150,8 @@ TRegisterableMetaData = class abstract(TInterfacedObject) /// TCollection [in] Collection associated /// with the meta data being created. /// IDBMetaData. Required meta data object. - class function Instance(ACollection: TCollection): IDBMetaData; + class function Instance(const AStorageDetails: TDataStorageDetails): + IDBMetaData; virtual; abstract; /// Gets the meta data capabilities for the collection data /// format. @@ -198,7 +198,7 @@ TMetaDataFactory = record /// IDBMetaData. Requested object. May be a null object if /// no meta data class was registered for the data format associated with /// ACollection. - class function CreateInstance(const ACollection: TCollection): + class function CreateInstance(const AStorageDetails: TDataStorageDetails): IDBMetaData; static; /// Gets the meta data capabilities for a collection data format. /// @@ -341,13 +341,11 @@ class function TMetaDataFactory.CapabilitiesOf( >.Create; end; -class function TMetaDataFactory.CreateInstance(const ACollection: TCollection): - IDBMetaData; +class function TMetaDataFactory.CreateInstance( + const AStorageDetails: TDataStorageDetails): IDBMetaData; begin - if fCallbackMap.ContainsKey(ACollection.CollectionFormatKind) then - Result := fCallbackMap[ACollection.CollectionFormatKind].Instance( - ACollection - ) + if fCallbackMap.ContainsKey(AStorageDetails.Format) then + Result := fCallbackMap[AStorageDetails.Format].Instance(AStorageDetails) else Result := TNullMetaData.Create; end; diff --git a/Src/DBIO.MetaData.DCSC.pas b/Src/DBIO.MetaData.DCSC.pas index 5c1c3444e..85052f55b 100644 --- a/Src/DBIO.MetaData.DCSC.pas +++ b/Src/DBIO.MetaData.DCSC.pas @@ -98,7 +98,7 @@ interface SysUtils, Types, // VCL - DB.UCollections, + DB.DataFormats, DB.UMetaData, UIStringList, UStructs, @@ -335,7 +335,8 @@ TAbstractMainDBMetaData = class abstract(TRegisterableMetaData) /// Creates an instance of meta data object that can read this /// collection's format. /// Must be called from a concrete descendant class. - class function Instance(ACollection: TCollection): IDBMetaData; override; + class function Instance(const AStorageDetails: TDataStorageDetails): + IDBMetaData; override; /// Gets the meta data capabilities for the collection data /// format. /// TMetaDataCapabilities. Required meta data capabilities. @@ -407,11 +408,11 @@ TAbstractMainDBMetaData = class abstract(TRegisterableMetaData) TMainDBMetaData = class sealed(TAbstractMainDBMetaData, IDBMetaData) strict private var - fCollection: TCollection; + fDirectory: string; strict protected function GetDBDir: string; override; public - constructor Create(const ACollection: TCollection); + constructor Create(const ADirectory: string); end; /// Class that provides meta data for update database directories. @@ -433,7 +434,6 @@ implementation Classes, IOUtils, // Project - DB.DataFormats, UEncodings, UIOUtils, UResourceUtils, @@ -500,9 +500,9 @@ function TAbstractMainDBMetaData.GetVersion: TVersionNumber; end; class function TAbstractMainDBMetaData.Instance( - ACollection: DB.UCollections.TCollection): IDBMetaData; + const AStorageDetails: TDataStorageDetails): IDBMetaData; begin - Result := TMainDBMetaData.Create(ACollection); + Result := TMainDBMetaData.Create(AStorageDetails.Directory); end; function TAbstractMainDBMetaData.IsCorrupt: Boolean; @@ -566,16 +566,15 @@ procedure TAbstractMainDBMetaData.Refresh; { TMainDBMetaData } -constructor TMainDBMetaData.Create( - const ACollection: DB.UCollections.TCollection); +constructor TMainDBMetaData.Create(const ADirectory: string); begin inherited Create; - fCollection := ACollection; + fDirectory := ADirectory; end; function TMainDBMetaData.GetDBDir: string; begin - Result := fCollection.Location.Directory; + Result := fDirectory; end; { TUpdateDBMetaData } diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index 99184be1f..b470aecc3 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -184,6 +184,7 @@ implementation ShellAPI, IOUtils, // Project + DB.DataFormats, FmEasterEgg, FmPreviewDlg, UAppInfo, @@ -316,7 +317,7 @@ procedure TAboutDlg.ConfigForm; fPathInfoBoxes.Add( CreatePathInfoBox( Format(sCollectionPathGpCaption, [Collection.Name]), - Collection.Location.Directory, + Collection.Storage.Directory, TabIdx ) ); @@ -377,7 +378,7 @@ procedure TAboutDlg.DisplayCollectionInfo(ACollection: TCollection); tvCollectionInfo.Items.BeginUpdate; try tvCollectionInfo.Items.Clear; - MetaData := TMetaDataFactory.CreateInstance(ACollection); + MetaData := TMetaDataFactory.CreateInstance(ACollection.Storage); Capabilities := MetaData.GetCapabilities; if Capabilities <> [] then begin diff --git a/Src/FmUserDataPathDlg.pas b/Src/FmUserDataPathDlg.pas index 314057ac8..74215c0b8 100644 --- a/Src/FmUserDataPathDlg.pas +++ b/Src/FmUserDataPathDlg.pas @@ -176,7 +176,7 @@ procedure TUserDataPathDlg.actMoveUpdate(Sender: TObject); actMove.Enabled := (NewDirFromEditCtrl <> '') and not StrSameText( NewDirFromEditCtrl, - fCollList.Collection(cbCollection.ItemIndex).Location.Directory + fCollList.Collection(cbCollection.ItemIndex).Storage.Directory ) and Self.Enabled; end; diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index 6b13e0d50..dd9ba3b7d 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -103,6 +103,7 @@ implementation // Delphi SysUtils, // Project + DB.DataFormats, DB.UMetaData, UAppInfo, UUtils; @@ -153,7 +154,7 @@ function TSaveUnitMgr.CreateHeaderComments: IStringList; var DBMetaData: IDBMetaData; begin - DBMetaData := TMetaDataFactory.CreateInstance(ACollection); + DBMetaData := TMetaDataFactory.CreateInstance(ACollection.Storage); Result := ''; if mdcLicense in DBMetaData.GetCapabilities then begin diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index 765543073..83b6a8640 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -119,6 +119,7 @@ implementation Generics.Collections, // Project Compilers.UCompilers, + DB.DataFormats, DB.UMain, DB.UMetaData, DB.USnippetKind, @@ -138,7 +139,7 @@ function TSnippetDoc.CollectionInfo(const ACollectionID: TCollectionID): string; begin Collection := TCollections.Instance.GetCollection(ACollectionID); Result := Format(sCollectionInfo, [Collection.Name]); - MetaData := TMetaDataFactory.CreateInstance(Collection); + MetaData := TMetaDataFactory.CreateInstance(Collection.Storage); if mdcLicense in MetaData.GetCapabilities then begin Result := Result + ' ' + MetaData.GetLicenseInfo.NameWithURL + '.'; diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index b30a35883..388cac79e 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -94,6 +94,7 @@ implementation // Delphi SysUtils, // Project + DB.DataFormats, DB.USnippet, DB.USnippetKind, DBIO.MetaData.DCSC, @@ -123,7 +124,7 @@ function TSnippetSourceGen.BuildHeaderComments: IStringList; function CreditsLine(const ACollection: TCollection): string; begin - DBMetaData := TMetaDataFactory.CreateInstance(ACollection); + DBMetaData := TMetaDataFactory.CreateInstance(ACollection.Storage); Result := ''; if mdcLicense in DBMetaData.GetCapabilities then begin diff --git a/Src/UUserDBBackup.pas b/Src/UUserDBBackup.pas index dd063eda2..c6a1a8323 100644 --- a/Src/UUserDBBackup.pas +++ b/Src/UUserDBBackup.pas @@ -64,7 +64,7 @@ constructor TUserDBBackup.Create(const BackupFile: string; } begin inherited Create( - ACollection.Location.Directory, + ACollection.Storage.Directory, BackupFile, MakeFileID(ACollection), ACollection.UID.ToArray @@ -76,7 +76,7 @@ class function TUserDBBackup.MakeFileID(const ACollection: TCollection): begin // Backup file ID is $Fxxx where xxx is ordinal value of format kind. // The $F indicates that the file is a backup of a collection data format. - Result := SmallInt($F000 or UInt16(Ord(ACollection.CollectionFormatKind))); + Result := SmallInt($F000 or UInt16(Ord(ACollection.Storage.Format))); end; end. diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index ce6b9222b..56dc38823 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -326,9 +326,9 @@ class function TUserDBMgr.DeleteDatabase: Boolean; begin if not TDeleteUserDBDlg.Execute(nil, CollectionToDelete) then Exit(False); - if not TDirectory.Exists(CollectionToDelete.Location.Directory) then + if not TDirectory.Exists(CollectionToDelete.Storage.Directory) then Exit(False); - TDirectory.Delete(CollectionToDelete.Location.Directory, True); + TDirectory.Delete(CollectionToDelete.Storage.Directory, True); Result := True; end; diff --git a/Src/UUserDBMove.pas b/Src/UUserDBMove.pas index 98f3a6fb0..6e5959adb 100644 --- a/Src/UUserDBMove.pas +++ b/Src/UUserDBMove.pas @@ -120,7 +120,7 @@ procedure TUserDBMove.MoveTo(const ACollection: TCollection; const ADirectory: string); begin fCollection := ACollection; - fSourceDir := ExcludeTrailingPathDelimiter(ACollection.Location.Directory); + fSourceDir := ExcludeTrailingPathDelimiter(ACollection.Storage.Directory); fDestDir := ExcludeTrailingPathDelimiter(ADirectory); ValidateDirectories; fDirCopier.Move(fSourceDir, fDestDir); @@ -146,7 +146,7 @@ procedure TUserDBMove.SetNewDBDirectory(Sender: TObject); begin Collections := TCollections.Instance; // record new location BEFORE deleting old directory - fCollection.Location.Directory := fDestDir; + fCollection.Storage.Directory := fDestDir; Collections.Update(fCollection); // Persist collections immediately to save new directory ASAP to prevent // directory change being lost following a program crash. @@ -177,7 +177,7 @@ procedure TUserDBMove.ValidateDirectories; raise EInOutError.Create(sSameNames); if StrStartsText( - IncludeTrailingPathDelimiter(fCollection.Location.Directory), fDestDir + IncludeTrailingPathDelimiter(fCollection.Storage.Directory), fDestDir ) then raise EInOutError.Create(sCantMoveToSubDir); end; From 02d5a3f391f7a880af4b24c309b06805c7028f30 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 10 Dec 2024 09:56:18 +0000 Subject: [PATCH 130/222] Extend TSnippetTestInfo enumeration Added new stiUnitTests and stiDemoCode values to the TSnippetTestInfo enumeration. Updated calling code in DBIO.UIniData and USnippetHTML units just to allow to compile, but didn't implement any code relating to the new values. --- Src/DB.USnippet.pas | 4 +++- Src/DBIO.UIniData.pas | 11 ++++++++--- Src/USnippetHTML.pas | 10 ++++++++-- 3 files changed, 19 insertions(+), 6 deletions(-) diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 21fe6c33d..e54da8c1b 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -36,7 +36,9 @@ interface TSnippetTestInfo = ( stiNone, // snippet has not been tested stiBasic, // snippet has had some basic testing - stiAdvanced // snippet has had advanced (unit) testing + stiAdvanced, // snippet has had unspecified advanced testing + stiUnitTests, // snippet has unit tests + stiDemoCode // snippet has a demo program ); type diff --git a/Src/DBIO.UIniData.pas b/Src/DBIO.UIniData.pas index e54c5c20a..7039883b7 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DBIO.UIniData.pas @@ -942,9 +942,14 @@ procedure TIniDataWriter.WriteSnippetProps(const SnippetKey: string; 'Q' // crQuery ); TestInfo: array[TSnippetTestInfo] of string = ( - 'none', // stiNone - 'basic', // stiBasic - 'advanced' // stiAdvanced + {TODO -cVault: New empty entries added because new entries have been added + to TSnippetTestInfo. Need to update code to support new Advanced.XXX + entries in DCSC v2.2} + 'none', // stiNone + 'basic', // stiBasic + 'advanced', // stiAdvanced + '', // stiUnitTests + '' // stiDemoCode ); var SourceFileName: string; diff --git a/Src/USnippetHTML.pas b/Src/USnippetHTML.pas index 3d4a6fbc5..e5783b245 100644 --- a/Src/USnippetHTML.pas +++ b/Src/USnippetHTML.pas @@ -250,7 +250,9 @@ function TSnippetHTML.TestingImage: string; resourcestring sTestingNone = 'Untested'#13#10'Use with care'; sTestingBasic = 'Passed simple tests'; - sTestingAdvanced = 'Passed advanced / unit testing'; + sTestingAdvanced = 'Passed unspecified advanced testing'; + sTestingUnitTests = 'Has unit tests'; + sTestingDemo = 'Has demo program'; const ImgWidth = 16; ImgHeight = 16; @@ -260,7 +262,11 @@ function TSnippetHTML.TestingImage: string; end =( (ResName: 'testing-none.png'; Title: sTestingNone), (ResName: 'testing-basic.png'; Title: sTestingBasic), - (ResName: 'testing-advanced.png'; Title: sTestingAdvanced) + (ResName: 'testing-advanced.png'; Title: sTestingAdvanced), + {TODO -cVault: Add new icons below for unit tests and demo code test info + to replace testing-advanced.png} + (ResName: 'testing-advanced.png'; Title: sTestingUnitTests), + (ResName: 'testing-advanced.png'; Title: sTestingDemo) ); var Attrs: IHTMLAttributes; // image's attributes From 2156e10b9126f23eda0708e57f8f83d9fb956719 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 12 Dec 2024 17:53:27 +0000 Subject: [PATCH 131/222] Add new StrReplaceChar function to UStrUtils --- Src/UStrUtils.pas | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/Src/UStrUtils.pas b/Src/UStrUtils.pas index b56d8005c..1c27f35ab 100644 --- a/Src/UStrUtils.pas +++ b/Src/UStrUtils.pas @@ -21,6 +21,7 @@ interface uses // Delphi + SysUtils, Classes, // Project UConsts; @@ -117,6 +118,12 @@ function StrStartsText(const SubStr, Str: UnicodeString): Boolean; function StrReplace(const Str, FindStr, ReplaceStr: UnicodeString): UnicodeString; +/// Replaces all occurences in Str of characters for which +/// predicate Condition returns True with character +/// ReplaceCh and returns the modified string. +function StrReplaceChar(const Str: string; const Condition: TPredicate; + const ReplaceCh: Char): string; + /// Trims leading and trailing white space characters from a string. /// /// White space is considered to be any character from #0..#32. @@ -333,7 +340,8 @@ implementation uses // Delphi - SysUtils, StrUtils, Character; + StrUtils, + Character; { Internal helper routines } @@ -659,6 +667,19 @@ function StrReplace(const Str, FindStr, ReplaceStr: UnicodeString): Result := StrUtils.AnsiReplaceStr(Str, FindStr, ReplaceStr); end; +function StrReplaceChar(const Str: string; const Condition: TPredicate; + const ReplaceCh: Char): string; +var + Idx: Integer; +begin + SetLength(Result, Length(Str)); + for Idx := 1 to Length(Str) do + if Condition(Str[Idx]) then + Result[Idx] := ReplaceCh + else + Result[Idx] := Str[Idx]; +end; + function StrSameStr(const Left, Right: UnicodeString): Boolean; begin Result := SysUtils.AnsiSameStr(Left, Right); From 88f38fa7f262c8cb5e75c8dc39a829e92f9988e8 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 12 Dec 2024 17:55:24 +0000 Subject: [PATCH 132/222] Modify some TIStringList methods re nil string lists The implementation of the TIStringList constructor and .Add methods that accept either IStringList or TStrings parameters were modified to permit nil to be passed as a parameter. In such cases .Add methods become noops and the constructors construct an empty IStringList object. Documentation was modified accordingly. --- Src/UIStringList.pas | 71 ++++++++++++++++++++++++-------------------- 1 file changed, 39 insertions(+), 32 deletions(-) diff --git a/Src/UIStringList.pas b/Src/UIStringList.pas index 90a630931..4a0239917 100644 --- a/Src/UIStringList.pas +++ b/Src/UIStringList.pas @@ -170,15 +170,19 @@ TIStringList = class(TInterfacedObject, constructor Create; overload; {Class constructor. Creates new empty list. } + + /// Create a new list containing all the strings contained in a + /// given string list. + /// TStrings [in] List of strings to add. An + /// empty list is created if Strs is empty or nil. constructor Create(const Strs: TStrings); overload; - {Class constructor. Creates new list containing specified strings. - @param Strs [in] List of strings to be stored in list. - } + + /// Create a new list containing all the strings contained in a + /// given string list. + /// IStringList [in] List of strings to add. An + /// empty list is created if Strs is empty or nil. constructor Create(const Strs: IStringList); overload; - {Class constructor. Creates new list containing strings from another - IStringList instance. - @param Strs [in] List of strings to be stored in list. - } + constructor Create(const Str: string); overload; {Class constructor. Creates new list containing a single string. @param Str [in] String to be included in list. @@ -194,10 +198,13 @@ TIStringList = class(TInterfacedObject, @param Trim [in] Determines whether strings are trimmed of trailing and leading spaces before adding to list. } + + /// Create a new list containing all the strings contained in a + /// given array. + /// array of string [in] List of strings to add. + /// An empty list is created if Strs is empty. constructor Create(const Strs: array of string); overload; - {Class constructor. Creates new list containing strings from array. - @param Strs [in] Array of strings to be included in list. - } + destructor Destroy; override; {Class destructor. Tears down object. } @@ -207,18 +214,25 @@ TIStringList = class(TInterfacedObject, @param Str [in] String to be added to list. @return Index of new string in list. } + + /// Adds all strings from a string list to the end of the list. + /// + /// TStrings [in] List of strings to add. Does + /// nothing if Strs is nil or empty. procedure Add(const Strs: TStrings); overload; - {Adds all items from a string list to end of list. - @param Strs [in] String list to be added. - } + + /// Adds all strings from a string list to the end of the list. + /// + /// IStringList [in] List of strings to add. Does + /// nothing if Strs is nil or empty. procedure Add(const Strs: IStringList); overload; - {Adds all items from another IStringList instance to end of list. - @param Strs [in] String list to be added. - } + + /// Adds all strings from an array of strings to the end of the + /// list. + /// array of string [in] Array of strings to add. + /// Does nothing if Strs is empty. procedure Add(const Strs: array of string); overload; - {Adds all strings from an array to end of list. - @param Strs [in] Dynamic array of strings to be added. - } + procedure Add(const Str: string; const Delim: string; const AllowEmpty: Boolean; const Trim: Boolean = False); overload; {Splits a string at delimiter and adds component parts of string to end of @@ -345,11 +359,9 @@ implementation { TIStringList } procedure TIStringList.Add(const Strs: TStrings); - {Adds all items from a string list to end of list. - @param Strs [in] String list to be added. - } begin - fStrings.AddStrings(Strs); + if Assigned(Strs) then + fStrings.AddStrings(Strs); end; function TIStringList.Add(const Str: string): Integer; @@ -362,14 +374,12 @@ function TIStringList.Add(const Str: string): Integer; end; procedure TIStringList.Add(const Strs: IStringList); - {Adds all items from another IStringList instance to end of list. - @param Strs [in] String list to be added. - } var - Idx: Integer; // loops through strings in added list + S: string; begin - for Idx := 0 to Pred(Strs.Count) do - Add(Strs[Idx]); + if Assigned(Strs) then + for S in Strs do + Add(S); end; procedure TIStringList.Add(const Str: string; const Delim: string; @@ -398,9 +408,6 @@ procedure TIStringList.Add(const Str: string; const Delim: string; end; procedure TIStringList.Add(const Strs: array of string); - {Adds all strings from an array to end of list. - @param Strs [in] Dynamic array of strings to be added. - } var Idx: Integer; // loops thru elements of array begin From b0edfb3b24d09e466a9d48f9635724849e312ba8 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 28 Feb 2025 19:18:09 +0000 Subject: [PATCH 133/222] Update TDBLicenseInfo ctr to sanitise parameters TDBLicenseInfo.Create now replaces any control characters with spaces in the license name, spdx, url and text parameters and compresses multiple spaces into single spaces. --- Src/DB.UMetaData.pas | 39 ++++++++++++++++++++++++++++++++++----- 1 file changed, 34 insertions(+), 5 deletions(-) diff --git a/Src/DB.UMetaData.pas b/Src/DB.UMetaData.pas index 93171ebb4..0d0b6be76 100644 --- a/Src/DB.UMetaData.pas +++ b/Src/DB.UMetaData.pas @@ -32,7 +32,7 @@ interface mdcLicense, mdcCopyright, mdcContributors, - mdcTesters + mdcTesters {TODO -cView: rename as mdcAcknowledgements} ); TMetaDataCapabilities = set of TMetaDataCapability; @@ -49,21 +49,27 @@ TDBLicenseInfo = record /// Record constructor: sets all fields of record. /// Any or all parameters may be the empty string constructor Create(const AName, ASPDX, AURL, AText: string); + /// Creates and returns a null record with all fields set to the /// empty string. class function CreateNull: TDBLicenseInfo; static; + /// Name of license. property Name: string read fName; + /// Open Source Initiative SPDX short idenitifier for licenses. /// /// If the license is not supported by the Open Source Initiative /// then this property will be the empty string. property SPDX: string read fSPDX; + /// URL of license online. /// Optional. property URL: string read fURL; + /// Full text of license. property Text: string read fText; + /// Returns a string containing license name followed by any URL /// in parentheses. /// If no URL is available then only the license name is returned. @@ -212,6 +218,14 @@ TMetaDataFactory = record implementation +uses + // Delphi + SysUtils, + Character, + // Project + UConsts, + UStrUtils; + type /// Implements a null, do nothing, meta data object. /// Instance of this class are used when a collection format does @@ -260,11 +274,26 @@ TNullMetaData = class(TInterfacedObject, IDBMetaData) { TDBLicenseInfo } constructor TDBLicenseInfo.Create(const AName, ASPDX, AURL, AText: string); + + function StandardiseStr(const AStr: string): string; + begin + Result := StrCompressWhiteSpace( + StrReplaceChar( + AStr, + function(Ch: Char): Boolean + begin + Result := TCharacter.IsControl(Ch); + end, + ' ' + ) + ); + end; + begin - fName := AName; - fSPDX := ASPDX; - fURL := AURL; - fText := AText; + fName := StandardiseStr(AName); + fSPDX := StandardiseStr(ASPDX); + fURL := StandardiseStr(AURL); + fText := StandardiseStr(AText); end; class function TDBLicenseInfo.CreateNull: TDBLicenseInfo; From c9dd185b7bc3152ec1a74256fc1d58164a4d5fcf Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 28 Feb 2025 19:21:52 +0000 Subject: [PATCH 134/222] Add support for CodeSnip Vault native data format Added new DB.IO.DataFormat.Native unit to the project that reads and writes a snippet collection in the new CodeSnip Vault native data format. This is an XML based format. Modified DB.DataFormats to provide information about the new data format: added a new value to TDataFormatKind enumeration and added a description to TDataFormatInfo. Added support for loading and saving the new Vault format to DB.UDatabaseIO using new TNativeVaultFormatLoader and TNativeVaultFormatSaver claases and associated factory class changes. --- Src/CodeSnip.dpr | 3 +- Src/CodeSnip.dproj | 1 + Src/DB.DataFormats.pas | 11 +- Src/DB.IO.DataFormat.Native.pas | 1216 +++++++++++++++++++++++++++++++ Src/DB.UDatabaseIO.pas | 76 ++ 5 files changed, 1303 insertions(+), 4 deletions(-) create mode 100644 Src/DB.IO.DataFormat.Native.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index f9d75bbb9..5d592e737 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -380,7 +380,8 @@ uses UCollectionListAdapter in 'UCollectionListAdapter.pas', DBIO.MetaData.DCSC in 'DBIO.MetaData.DCSC.pas', FmCollectionBackup in 'FmCollectionBackup.pas' {CollectionBackupDlg}, - DB.DataFormats in 'DB.DataFormats.pas'; + DB.DataFormats in 'DB.DataFormats.pas', + DB.IO.DataFormat.Native in 'DB.IO.DataFormat.Native.pas'; // Include resources {$Resource ExternalObj.tlb} // Type library file diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index d0995c58d..0f4eb32cf 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -589,6 +589,7 @@
CollectionBackupDlg
+ Base diff --git a/Src/DB.DataFormats.pas b/Src/DB.DataFormats.pas index 8207c0940..37394cf98 100644 --- a/Src/DB.DataFormats.pas +++ b/Src/DB.DataFormats.pas @@ -13,6 +13,8 @@ interface /// Collection v2. /// Native_v4 -- Native format used by CodeSnip v4 to store user /// snippets. + /// Native_Vault -- Native format used by CodeSnip Vault to + /// store user snippets. /// TDataFormatKind = ( // NEVER specify a literal ordinal value in this enumeration. @@ -23,7 +25,8 @@ interface // NEVER associate error with a format loader or saver class. Error, DCSC_v2, - Native_v4 + Native_v4, + Native_Vault ); /// Record containing details of the data format and location in @@ -60,9 +63,11 @@ TMapRecord = record const // There are so few entries in this table it's not worth the overhead // of using a dicitionary for the lookup. - LookupTable: array[0..1] of TMapRecord = ( + LookupTable: array[0..2] of TMapRecord = ( + (Kind: TDataFormatKind.Native_Vault; + Name: 'CodeSnip Vault Native Snippet Collection'), (Kind: TDataFormatKind.Native_v4; - Name: 'CodeSnip Native Snippet Collection v4'), + Name: 'CodeSnip 4 Native Snippet Collection'), (Kind: TDataFormatKind.DCSC_v2; Name: 'DelphiDabbler Code Snippets Collection v2') ); diff --git a/Src/DB.IO.DataFormat.Native.pas b/Src/DB.IO.DataFormat.Native.pas new file mode 100644 index 000000000..9ac56a5ba --- /dev/null +++ b/Src/DB.IO.DataFormat.Native.pas @@ -0,0 +1,1216 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2025, Peter Johnson (gravatar.com/delphidabbler). + * + * Implements classes that can read and write collections stored in the CodeSnip + * Vault native data format. +} + + +unit DB.IO.DataFormat.Native; + +interface + +uses + // Delphi + XMLIntf, + // Project + Compilers.UGlobals, + DB.UCategory, + DB.USnippet, + DB.USnippetKind, + DBIO.UFileIOIntf, + UIStringList, + UVersionInfo, + UXMLDocumentEx; + +type + + /// Base class for classes that read and write collection data in + /// the native data format. + TNativeDataRW = class abstract(TInterfacedObject) + strict private + var + /// Value of DataDirectory property. + fDataDirectory: string; + /// Value of XMLDoc property. + fXMLDoc: IXMLDocumentEx; + strict protected + const + /// Name of collection's XML file. + XMLFileName = 'collection.xml'; + /// Extension used for source code files. + SourceCodeFileExt = '.source'; + /// Name of collection's license file, if any. + LicenseTextFileName = 'license.txt'; + /// Watermark included in all native data format files. + /// + Watermark = '882BAD68-8C3E-44E3-BBF4-17E55143DAF8'; + /// Version number of the earliest supported data file format. + /// + EarliestFileVersion: TVersionNumber = (V1: 1; V2: 0; V3: 0; V4: 0); + /// Version number of the current data file format. + CurrentFileVersion: TVersionNumber = (V1: 1; V2: 0; V3: 0; V4: 0); + + // XML node and attribute names + RootNodeName = 'collection'; + RootNodeWatermarkAttr = 'watermark'; + RootNodeVersionMajorAttr = 'version-major'; + RootNodeVersionMinorAttr = 'version-minor'; + CategoriesNodeName = 'categories'; + CategoryNodeName = 'category'; + CategoryNodeIdAttr = 'id'; + CategoryDescriptionNodeName = 'description'; + CategorySnippetsListNodeName = 'snippet-keys'; + CategorySnippetsListItemNodeName = 'key'; + SnippetsNodeName = 'snippets'; + SnippetNodeName = 'snippet'; + SnippetNodeKeyAttr = 'key'; + SnippetNodeCategoryAttr = 'category'; + SnippetNodeKindAttr = 'kind'; + SnippetDescriptionNodeName = 'description'; + SnippetSourceNodeName = 'source-code'; + SnippetSourceNodeFileAttr = 'file-name'; + SnippetSourceNodeLanguageAttr = 'language'; + SnippetDisplayNameNodeName = 'display-name'; + SnippetNotesNodeName = 'notes'; + SnippetCompileResultsNodeName = 'compile-results'; + SnippetCompilerNodeName = 'compiler'; + SnippetCompilerNodeIdAttr = 'id'; + SnippetCompilerNodeResultAttr = 'result'; + SnippetTestInfoNodeName = 'tests'; + SnippetTestInfoNodeLevelAttr = 'level'; + SnippetTestInfoNodeUrlAttr = 'url'; + SnippetUnitsListNodeName = 'required-units'; + SnippetUnitsListItemNodeName = 'unit'; + SnippetDependsListNodeName = 'required-snippets'; + SnippetDependsListItemNodeName = 'key'; + SnippetXRefsListNodeName = 'xrefs'; + SnippetXRefsListItemNodeName = 'key'; + LicenseNodeName = 'license'; + LicenseNodeSPDXAttr = 'spdx'; + LicenseNodeNameAttr = 'name'; + LicenseNodeURLAttr = 'url'; + LicenseNodeLicenseFileAttr = 'license-file-name'; + CopyrightNodeName = 'copyright'; + CopyrightNodeDateAttr = 'date'; + CopyrightNodeHolderAttr = 'holder'; + CopyrightNodeURLAttr = 'holder-url'; + CopyrightContributorsListNodeName = 'contributors'; + CopyrightContributorsListItemNodeName = 'name'; + AcknowledgementsListNodeName = 'acknowledgements'; + AcknowledgementsListItemNodeName = 'name'; + + /// Map of snippet kinds to the representative value used in the + /// XML file. + SnippetKindValues: array[TSnippetKind] of string = ( + 'freeform', 'routine', 'const', 'type', 'unit', 'class' + ); + + /// Map of compile result values to the representative value + /// used in the XML file. + /// crWarning is not supported and maps to the same value + /// as crSuccess. + CompileResultValues: array[TCompileResult] of Char = ('y', 'y', 'n', 'q'); + + /// Map of compiler IDs to the representative value used in the + /// XML file. + CompilerIDs: array[TCompilerID] of string = ( + 'd2', 'd3', 'd4', 'd5', 'd6', 'd7', + 'd2005', 'd2006', 'd2007', 'd2009', 'd2010', + 'dxe', 'dxe2', 'dxe3', 'dxe4', 'dxe5', 'dxe6', 'dxe7', 'dxe8', + 'd10.0', 'd10.1', 'd10.2', 'd10.3', 'd10.4', 'd11', 'd12', + 'fpc' + ); + + /// Map of test information to the representative value used in + /// the XML file. + TestInfoValues: array[TSnippetTestInfo] of string = ( + 'none', 'basic', 'advanced', 'unit-tests', 'demo-code' + ); + + strict protected + + /// Directory containing the collection. + property DataDirectory: string read fDataDirectory; + + /// XML document object. + property XMLDoc: IXMLDocumentEx read fXMLDOc; + + /// Creates and activates a minimal XML document containing a + /// processing instruction and a root node with the required attributes. + /// + /// IXMLNode. Reference to the root node. + function InitXMLDocAndRootNode: IXMLNode; + + /// Finds a specified category node. + /// string [in] ID of required category. + /// + /// IXMLNode. Found node or nil if the node was not found. + /// + function FindCategoryNode(const ACatID: string): IXMLNode; + + /// Finds a specified snippet node. + /// string [in] Key of required snippet. + /// + /// IXMLNode. Found node or nil if the node was not found. + /// + function FindSnippetNode(const ASnippetKey: string): IXMLNode; + + /// Returns fully specified path of the XML file. + function PathToXMLFile: string; + + /// Returns fully specified path of a file within the collection + /// directory. + function FilePath(const AFileName: string): string; + + public + + /// Object constructor. Creates an XML document to access the + /// collection's XML file. + /// string [in] Full path to the + /// directory that contains the collection's data files. + constructor Create(const ADataDirectory: string); + + end; + + /// Class that performs the low level reading of collection data in + /// CodeSnip Vault native format from an XML file and linked data files. + /// + TNativeDataReader = class sealed(TNativeDataRW, IDataReader) + strict private + var + /// Flag that indicates if unit & depends-upon lists are + /// permitted. + fCanReadRequiredLists: Boolean; + + /// Validates an XML document loaded from storage. Returns + /// normally on success or raises exception on error. + /// EDataIO raised if there is no valid root node with + /// the expected watermark and a valid version number. + procedure ValidateDoc; + + /// Reads a list of text nodes that each have the same tag name, + /// within an enclosing node. + /// IXMLNode [in] Reference to the parent + /// node of the node that encloses the list items. + /// string [in] Name of the node that + /// encloses the list items. + /// string [in] Name of each list item + /// node. + /// IStringList [in] Text value of each list item. + /// + function GetEnclosedListItems(const AParentNode: IXMLNode; + const AListNodeName, AItemNodeName: string): IStringList; + + /// Reads a list of items that are referenced by a given snippet. + /// + /// string [in] Key of snippet making the + /// references. + /// string [in] Name of the XML node + /// that contains the list items. + /// string [in] Name of each list item + /// XML node within the list. + /// IStringList [in] List of referenced items. + function GetSnippetReferences(const ASnippetKey, AListNodeName, + AListItemName: string): IStringList; + + /// Handles exceptions raised by converting expected exceptions + /// into ECodeSnip derived exceptions. + /// TObject [in] Reference to exception object to + /// be handled. + /// Always raises an exception. Expected exceptions are + /// re-raised as EDataIO exceptions. Unexpected exceptions are + /// re-raised unchanged. + procedure HandleException(const EObj: TObject); + public + + /// Object constructor. Loads XML from file if the collection + /// exists, otherwise creates a minimal empty document. + /// string [in] Full path to the + /// directory that contains the collection's data files. + constructor Create(const ADirectory: string); + + /// Checks if the collection exists. + /// Boolean. Returns True if the collection exists + /// or False if not. + /// + /// This method is always called before any other IDataReader + /// methods. If it returns False then no other IDataReader + /// methods are called. Therefore other methods can safely assume that the + /// collection exists. + /// Method of IDataReader. + /// + function DatabaseExists: Boolean; + {TODO -cRefactor: Rename DatabaseExists to CollectionExists.} + + /// Gets the unique IDs of all categories referenced in the + /// collection. + /// IStringList. List of category IDs. + /// Method of IDataReader. + function GetAllCatIDs: IStringList; + + /// Gets the properties of a given category. + /// string [in] ID of the required category. + /// + /// TCategoryData [in/out] An empty, + /// initialised, properties record is passed in and a record with the + /// properties read from the collection data is passed out. + /// Method of IDataReader. + procedure GetCatProps(const CatID: string; var Props: TCategoryData); + + /// Gets the unique keys of all snippets in a category within the + /// collection. + /// string [in] ID of the required category. + /// + /// IStringList. List of snippet keys. + /// Method of IDataReader. + function GetCatSnippets(const CatID: string): IStringList; + + /// Gets the properties of a given snippet. + /// string [in] Key of the required + /// snippet. + /// TSnippetData [in/out] An empty, + /// initialised, properties record is passed in and a record with the + /// properties read from the collection data is passed out. + /// Method of IDataReader. + procedure GetSnippetProps(const SnippetKey: string; + var Props: TSnippetData); + + /// Gets a list of the keys of all snippets within the collection + /// that are cross-referenced by a given snippet. + /// string [in] Key of snippet for which + /// cross references are required. + /// IStringList. List of keys of cross referenced snippets. + /// + /// Method of IDataReader. + function GetSnippetXRefs(const SnippetKey: string): IStringList; + + /// Gets a list of the keys of all snippets on which a given + /// snippet depends in order to compile. + /// string [in] Key of snippet for which + /// dependencies are required. + /// IStringList. List of keys of required snippets. + /// + /// Method of IDataReader. + function GetSnippetDepends(const SnippetKey: string): IStringList; + + /// Gets a list of the keys of all unit which a given snippet + /// requires in order to compile. + /// string [in] Key of snippet for which + /// units are required. + /// IStringList. List of required units. + /// + /// Method of IDataReader. + function GetSnippetUnits(const SnippetKey: string): IStringList; + end; + + /// Class that performs the low level writing of collection data in + /// CodeSnip Vault native format to an XML file and linked data files. + /// + TNativeDataWriter = class sealed(TNativeDataRW, IDataWriter) + strict private + var + /// Reference to root node. + fRootNode: IXMLNode; + /// Reference to top-level snippets XML node. + fSnippetsNode: IXMLNode; + /// Reference to top-level categories XML node. + fCategoriesNode: IXMLNode; + /// Flag that indicates if unit & depends-upon lists can be + /// written. + fCanWriteRequiredLists: Boolean; + + /// Handles exceptions raised by converting expected exceptions + /// into ECodeSnip derived exceptions. + /// TObject [in] Reference to exception object to + /// be handled. + /// Always raises an exception. Expected exceptions are + /// re-raised as EDataIO exceptions. Unexpected exceptions are + /// re-raised unchanged. + procedure HandleException(const EObj: TObject); + + /// Writes a list of text nodes that each have the same tag name, + /// within an enclosing node. + /// IXMLNode [in] Reference to the parent node + /// of the node that encloses the list items. + /// string [in] Name of the node that + /// encloses the list items. + /// string [in] Name of each list item + /// node. + /// IStringList [in] Text value of each list + /// item. + procedure WriteEnclosedList(const AParent: IXMLNode; + const AListNodeName, AItemNodeName: string; const AItems: IStringList); + + /// Writes a reference list associated with a snippet to XML. + /// + /// string [in] Key of snippet. + /// string [in] Name of the XML node + /// that contains the list item. + /// string [in] Name of each list item + /// XML node within the list. + /// IStringList [in] List of referenced items. + /// + procedure WriteReferenceList(const ASnippetKey, AListNodeName, + AItemNodeName: string; const AItems: IStringList); + + public + /// Initialises the collection write. + /// + /// Always called before all other IDataWriter methods. + /// Method of IDataWriter. + /// + procedure Initialise; + + /// Writes the properties of a given category. + /// string [in] ID of category. + /// TCategoryData [in] Properties of the + /// category. + /// + /// Always called before WriteCatSnippets for a given + /// category, so can be used to perform any per-category initialisation. + /// + /// Method of IDataWriter. + /// + procedure WriteCatProps(const CatID: string; const Props: TCategoryData); + + /// Writes a list of keys of snippets belonging to a given + /// category. + /// string [in] ID of category. + /// IStringList [in] List of snippet keys. + /// + /// + /// Always called after WriteCatProps for a given category. + /// + /// Method of IDataWriter. + /// + procedure WriteCatSnippets(const CatID: string; + const SnipList: IStringList); + + /// Writes the property of a given snippet. + /// string [in] Snippet's key. + /// TSnippetData [in] Properties of the snippet. + /// + /// + /// Always called after all categories are written and before + /// WriteSnippetUnits, so can be used to perform any per-snippet + /// intialisation that is required. + /// Method of IDataWriter. + /// + procedure WriteSnippetProps(const SnippetKey: string; + const Props: TSnippetData); + + /// Writes a list of units required to compile a snippet. + /// + /// string [in] Snippet's key. + /// IStringList [in] List of unit names. + /// Method of IDataWriter. + procedure WriteSnippetUnits(const SnippetKey: string; + const Units: IStringList); + + /// Writes a list of keys of snippets that a snippet depends on in + /// order to compile. + /// string [in] Snippet's key. + /// IStringList [in] List of keys of required + /// snippets. + /// Method of IDataWriter. + procedure WriteSnippetDepends(const SnippetKey: string; + const Depends: IStringList); + + /// Writes a list of keys of snippets that are cross referenced + /// by a given snippet. + /// string [in] Snippet's key. + /// IStringList [in] List of keys of cross + /// referenced snippets. + /// Method of IDataWriter. + procedure WriteSnippetXRefs(const SnippetKey: string; + const XRefs: IStringList); + + /// Finalises the collection write. + /// + /// Always called after all other IDataWriter methods. + /// Method of IDataWriter. + /// + procedure Finalise; + end; + +implementation + +uses + // Delphi + SysUtils, + Classes, + IOUtils, + ActiveX, + XMLDom, + // Project + ActiveText.UMain, + UExceptions, + UIOUtils, + USnippetExtraHelper, + UStrUtils, + UUtils, + UXMLDocHelper; + +resourcestring + // TNativeDataRW error message + sMissingNode = 'Document has no %s node.'; + // TNativeDataReader error messages + sParseError = 'Error parsing XML file'; + sBadDataFormat = 'Invalid native collection data format: %s'; + sNoRootNode = 'Invalid document: no root element present'; + sBadRootName = 'Invalid document: root element must be named <%s>'; + sBadWatermark = 'Invalid document: watermark is incorrect'; + sBadVersion = 'Invalid document: unsupported document version %d.%d'; + sNoCategoriesNode = 'No categories node in XML file'; + sCatNotFound = 'Can''t find reference to category "%s" in XML file'; + sMissingSource = 'Source code file name missing for snippet "%s"'; + sBadKind = 'Missing or invalid snippet kind for snippet "%s"'; + sSnippetNotFound = 'Can''t find reference to snippet key "%s" in XML file'; + sBadTestInfo = 'Invalid test information for snippet "%s"'; + +{ TNativeDataRW } + +constructor TNativeDataRW.Create(const ADataDirectory: string); +begin + inherited Create; + fDataDirectory := ADataDirectory; + // For some reason we must call OleInitialize here rather than in + // initialization section + OleInitialize(nil); + fXMLDoc := TXMLDocHelper.CreateXMLDoc; +end; + +function TNativeDataRW.FilePath(const AFileName: string): string; +begin + Result := TPath.Combine(DataDirectory, AFileName); +end; + +function TNativeDataRW.FindCategoryNode(const ACatID: string): IXMLNode; +var + CatListNode: IXMLNode; // node that contains category nodes +begin + Result := nil; + // Find node + CatListNode := XMLDoc.FindNode(RootNodeName + '\' + CategoriesNodeName); + if not Assigned(CatListNode) then + raise EDataIO.CreateFmt(sMissingNode, [CategoriesNodeName]); + // Find required node + Result := fXMLDoc.FindFirstChildNode( + CatListNode, CategoryNodeName, CategoryNodeIdAttr, ACatID + ) +end; + +function TNativeDataRW.FindSnippetNode(const ASnippetKey: string): IXMLNode; +var + SnippetListNode: IXMLNode; // list node that contains snippets nodes +begin + Result := nil; + // Find snippets node + SnippetListNode := XMLDoc.FindNode(RootNodeName + '\' + SnippetsNodeName); + if not Assigned(SnippetListNode) then + raise EDataIO.CreateFmt(sMissingNode, [SnippetsNodeName]); + // Find required snippet node + Result := XMLDoc.FindFirstChildNode( + SnippetListNode, SnippetNodeName, SnippetNodeKeyAttr, ASnippetKey + ); +end; + +function TNativeDataRW.InitXMLDocAndRootNode: IXMLNode; +begin + XMLDoc.Active := True; + TXMLDocHelper.CreateXMLProcInst(XMLDoc); + XMLDoc.Encoding := 'UTF-8'; + // root node + Result := XMLDoc.CreateNode(RootNodeName); + Result.SetAttribute(RootNodeWatermarkAttr, Watermark); + Result.SetAttribute(RootNodeVersionMajorAttr, CurrentFileVersion.V1); + Result.SetAttribute(RootNodeVersionMinorAttr, CurrentFileVersion.V2); + XMLDoc.ChildNodes.Add(Result); +end; + +function TNativeDataRW.PathToXMLFile: string; +begin + Result := FilePath(XMLFileName); +end; + +{ TNativeDataReader } + +constructor TNativeDataReader.Create(const ADirectory: string); +var + RootNode: IXMLNode; // reference to document's root node +begin + inherited Create(ADirectory); + if DatabaseExists then + begin + // Database exists: load it + XMLDoc.LoadFromFile(PathToXMLFile); + XMLDoc.Active := True; + try + ValidateDoc; + except + HandleException(ExceptObject); + end; + end + else + begin + // Database doesn't exist: create sufficient nodes for main code to find + RootNode := InitXMLDocAndRootNode; + XMLDoc.CreateElement(RootNode, CategoriesNodeName); + XMLDoc.CreateElement(RootNode, SnippetsNodeName); + end; +end; + +function TNativeDataReader.DatabaseExists: Boolean; +begin + Result := TFile.Exists(PathToXMLFile); +end; + +function TNativeDataReader.GetAllCatIDs: IStringList; +var + CatListNode: IXMLNode; // node containing list of categories + CatNodes: IXMLSimpleNodeList; // list of all category nodes of categories + CatNode: IXMLNode; // a node in CatNodes +begin + try + Result := TIStringList.Create; + CatListNode := XMLDoc.FindNode(RootNodeName + '\' + CategoriesNodeName); + if not Assigned(CatListNode) then + raise EDataIO.Create(sNoCategoriesNode); + CatNodes := XMLDoc.FindChildNodes(CatListNode, CategoryNodeName); + for CatNode in CatNodes do + Result.Add(CatNode.Attributes[CategoryNodeIdAttr]); + except + HandleException(ExceptObject); + end; +end; + +procedure TNativeDataReader.GetCatProps(const CatID: string; + var Props: TCategoryData); +var + CatNode: IXMLNode; // reference to node for required category +begin + try + CatNode := FindCategoryNode(CatID); + if not Assigned(CatNode) then + // Properties will not be requested for a category that doesn't exist in + // this database, so this should never happen + raise EDataIO.CreateFmt(sCatNotFound, [CatID]); + Props.Desc := TXMLDocHelper.GetSubTagText( + XMLDoc, CatNode, CategoryDescriptionNodeName + ); + except + HandleException(ExceptObject); + end; +end; + +function TNativeDataReader.GetCatSnippets(const CatID: string): IStringList; +var + CatNode: IXMLNode; // reference to required category node +begin + try + CatNode := FindCategoryNode(CatID); + if not Assigned(CatNode) then + {TODO -cVault: Check the following comment and decide if this still + applies. Replace Exit with exception if necessary.} + // This is not an error since it is possible that a category exists in + // another collection and loader will request info from here also + Exit(TIStringList.Create); + Result := GetEnclosedListItems( + CatNode, CategorySnippetsListNodeName, CategorySnippetsListItemNodeName + ); + except + HandleException(ExceptObject); + end; +end; + +function TNativeDataReader.GetEnclosedListItems(const AParentNode: IXMLNode; + const AListNodeName, AItemNodeName: string): IStringList; +var + ListNode: IXMLNode; + ItemNode: IXMLNode; + NodeList: IXMLSimpleNodeList; +begin + Assert(Assigned(AParentNode), + ClassName + '.GetEnclosedListItems: AParentNode is nil'); + Result := TIStringList.Create; + ListNode := XMLDoc.FindFirstChildNode(AParentNode, AListNodeName); + if not Assigned(ListNode) then + Exit; // it is sometimes permitted for snippet lists to be omitted + NodeList := XMLDoc.FindChildNodes(ListNode, AItemNodeName); + for ItemNode in NodeList do + if ItemNode.IsTextElement then + Result.Add(ItemNode.Text); +end; + +function TNativeDataReader.GetSnippetDepends(const SnippetKey: string): + IStringList; +begin + if fCanReadRequiredLists then + Result := GetSnippetReferences( + SnippetKey, SnippetDependsListNodeName, SnippetDependsListItemNodeName + ) + else + Result := TIStringList.Create; +end; + +procedure TNativeDataReader.GetSnippetProps(const SnippetKey: string; + var Props: TSnippetData); +var + SnippetNode: IXMLNode; // node for required snippet + + // Gets text of a sepecified property that is stored in the named subtag of + // the given parent node. + function GetPropertyText(const AParentNode: IXMLNode; + const ASubTagNodeName: string): string; + begin + if not Assigned(AParentNode) then + Exit(''); + Result := TXMLDocHelper.GetSubTagText(XMLDoc, AParentNode, ASubTagNodeName); + end; + + // Returns a reference to the source code node + function SourceCodeNode: IXMLNode; + begin + Result := XMLDoc.FindFirstChildNode(SnippetNode, SnippetSourceNodeName); + end; + + // Returns source code language from source code node attribute + function GetSourceCodeLanguage: string; + begin + Result := SourceCodeNode.Attributes[SnippetSourceNodeLanguageAttr]; + end; + + // Checks if source code language is Pascal + function IsPascalSource: Boolean; + begin + Result := GetSourceCodeLanguage = 'pascal'; + end; + + // Gets source code from file referenced in source code node attribute + function GetSourceCodePropertyText: string; + var + DataFileName: string; // name of file containing source code + begin + DataFileName := SourceCodeNode.Attributes[SnippetSourceNodeFileAttr]; + if DataFileName = '' then + raise EDataIO.CreateFmt(sMissingSource, [SnippetKey]); + Result := TFileIO.ReadAllText( + FilePath(DataFileName), TEncoding.UTF8, False + ); + end; + + // Gets kind property value from snippet node attribute + function GetKindProperty: TSnippetKind; + + // Looks up AKindStr in lookup table and passes out matching TSnippetKind + // value, if found. Returns True if found & false if not + function TryLookupKind(const AKindStr: string; out AKind: TSnippetKind): + Boolean; + var + K: TSnippetKind; + begin + Result := False; + for K := Low(SnippetKindValues) to High(SnippetKindValues) do + begin + if StrSameText(SnippetKindValues[K], AKindStr) then + begin + AKind := K; + Exit(True); + end; + end; + end; + + var + Value: string; // text value of Kind node + begin + if not IsPascalSource then + // being permissive here: strictly speaking snippet kind attribute must + // have value 'freeform'. + Exit(skFreeform); + + Value := SnippetNode.Attributes[SnippetNodeKindAttr]; + if not TryLookupKind(Value, Result) then + raise EDataIO.CreateFmt(sBadKind, [SnippetKey]); + end; + + // Gets REML from the named child node of the snippet node and parses it as + // active text. + function GetActiveText(const ANodeName: string): IActiveText; + var + REML: string; + begin + REML := GetPropertyText(SnippetNode, ANodeName); + if REML <> '' then + Result := TSnippetExtraHelper.BuildActiveText(REML) + else + Result := TActiveTextFactory.CreateActiveText; + end; + + // Get compilation results from compile results node and its child nodes + function GetCompileResults: TCompileResults; + + // Looks up compiler ID string in lookup table and passes the corresponding + // compiler ID in Match if found. Returns True if found, False if not. + function TryLookupCompID(IDStr: string; out Match: TCompilerID): Boolean; + var + CompID: TCompilerID; // loops thru all compiler IDs + begin + Result := False; + for CompID := Low(TCompilerID) to High(TCompilerID) do + begin + if StrSameText(CompilerIDs[CompID], IDStr) then + begin + Match := CompID; + Exit(True); + end; + end; + end; + + var + ListNode: IXMLNode; // node that enclose compiler result nodes + ResultsNodes: IXMLSimpleNodeList; // list of compiler-result nodes + ResultNode: IXMLNode; // a compiler-result node + CompID: TCompilerID; // loops thru compiler IDs + CompResultStr: string; // compiler id string from result node + begin + // Initialise all results to unknown (query) + for CompID := Low(TCompilerID) to High(TCompilerID) do + Result[CompID] := crQuery; + + // Find enclosing node: valid if this is not present + ListNode := XMLDoc.FindFirstChildNode( + SnippetNode, SnippetCompileResultsNodeName + ); + if not Assigned(ListNode) then + Exit; + + // Get list of compiler-result nodes contained in list and process each one + ResultsNodes := XMLDoc.FindChildNodes(ListNode, SnippetCompilerNodeName); + for ResultNode in ResultsNodes do + begin + // get compile result identifier + CompResultStr := StrToLower( + ResultNode.Attributes[SnippetCompilerNodeResultAttr] + ); + if CompResultStr = '' then + CompResultStr := '?'; + // add specified result function result + if TryLookupCompID( + ResultNode.Attributes[SnippetCompilerNodeIdAttr], CompID + ) then + begin + case CompResultStr[1] of + 'y': Result[CompID] := crSuccess; + 'n': Result[CompID] := crError; + else Result[CompID] := crQuery; + end; + end; + end; + end; + + // Get test info from test node attributes + procedure SetTestInfoProperty(var Props: TSnippetData); + + function TryLookupTestLevel(const AIDStr: string; + var ALevel: TSnippetTestInfo): Boolean; + var + TestID: TSnippetTestInfo; + begin + Result := False; + for TestID := Low(TSnippetTestInfo) to High(TSnippetTestInfo) do + begin + if StrSameText(TestInfoValues[TestID], AIDStr) then + begin + ALevel := TestID; + Exit(True); + end; + end; + end; + + var + TestNode: IXMLNode; + Level: TSnippetTestInfo; + URL: string; + begin + URL := ''; + Level := stiNone; + TestNode := XMLDoc.FindFirstChildNode(SnippetNode, SnippetTestInfoNodeName); + if not Assigned(TestNode) then + Exit; + if not TryLookupTestLevel( + TestNode.Attributes[SnippetTestInfoNodeLevelAttr], Level + ) then + Exit; + URL := TestNode.Attributes[SnippetTestInfoNodeUrlAttr]; + Props.TestInfo := Level; + {TODO -cVault: When Snippet test URL is implemented, add following line} + // Props.TestURL := URL; + end; + +begin + try + // Find snippet node + SnippetNode := FindSnippetNode(SnippetKey); + if not Assigned(SnippetNode) then + raise EDataIO.CreateFmt(sSnippetNotFound, [SnippetKey]); + // Snippet found: read properties + Props.Cat := SnippetNode.Attributes[SnippetNodeCategoryAttr]; + Props.DisplayName := GetPropertyText( + SnippetNode, SnippetDisplayNameNodeName + ); + Props.Kind := GetKindProperty; + Props.Desc := GetActiveText(SnippetDescriptionNodeName); + Props.Extra := GetActiveText(SnippetNotesNodeName); + Props.SourceCode := GetSourceCodePropertyText; + {TODO -cVault: Replace Props.HiliteSource with Props.SourceCodeLanguage + field.} + Props.HiliteSource := IsPascalSource; + Props.CompilerResults := GetCompileResults; + SetTestInfoProperty(Props); + + // Record whether required units / snippets list are permitted + {TODO -cVault: Change following line to use Props.SourceLanguage once + implemented to check if language is Pascal: can't write the lists + if not.} + fCanReadRequiredLists := Props.HiliteSource; + except + HandleException(ExceptObject); + end; +end; + +function TNativeDataReader.GetSnippetReferences(const ASnippetKey, + AListNodeName, AListItemName: string): IStringList; +var + SnippetNode: IXMLNode; +begin + // Find snippet node + SnippetNode := FindSnippetNode(ASnippetKey); + if not Assigned(SnippetNode) then + raise EDataIO.CreateFmt(sSnippetNotFound, [ASnippetKey]); + Result := GetEnclosedListItems(SnippetNode, AListNodeName, AListItemName); +end; + +function TNativeDataReader.GetSnippetUnits(const SnippetKey: string): + IStringList; +begin + if fCanReadRequiredLists then + Result := GetSnippetReferences( + SnippetKey, SnippetUnitsListNodeName, SnippetUnitsListItemNodeName + ) + else + Result := TIStringList.Create; +end; + +function TNativeDataReader.GetSnippetXRefs(const SnippetKey: string): + IStringList; +begin + Result := GetSnippetReferences( + SnippetKey, SnippetXRefsListNodeName, SnippetXRefsListItemNodeName + ) +end; + +procedure TNativeDataReader.HandleException(const EObj: TObject); +begin + {TODO -cVault: Query whether database files should be deleted on error. + This is not being done while debugging} +// DeleteFiles(DataDir, '*.*'); + if EObj is EDOMParseError then + // Expected DOM parsing error + raise EDataIO.CreateFmt(sBadDataFormat, [sParseError]); + if (EObj is EDataIO) + or (EObj is EXMLDocError) + or (EObj is ECodeSnipXML) + or (EObj is EFileStreamError) + or (EObj is EFOpenError) + or (EObj is EActiveTextParserError) then + // Expected other error: Raise new exception containing old message + raise EDataIO.CreateFmt(sBadDataFormat, [(EObj as Exception).Message]) + else + // Mot an expected error: just re-raise + raise EObj; +end; + +procedure TNativeDataReader.ValidateDoc; +var + RootNode: IXMLNode; + Version: TVersionNumber; +begin + RootNode := XMLDoc.DocumentElement; + + if not Assigned(RootNode) then + raise EDataIO.Create(sNoRootNode); + + if RootNode.NodeName <> RootNodeName then + raise EDataIO.CreateFmt(sBadRootName, [RootNodeName]); + + if RootNode.Attributes[RootNodeWatermarkAttr] <> Watermark then + raise EDataIO.Create(sBadWatermark); + + Version := TVersionNumber.Nul; + Version.V1 := RootNode.Attributes[RootNodeVersionMajorAttr]; + Version.V2 := RootNode.Attributes[RootNodeVersionMinorAttr]; + if (Version < EarliestFileVersion) or (Version > CurrentFileVersion) then + raise EDataIO.CreateFmt(sBadVersion, [Version.V1, Version.V2]); +end; + +{ TNativeDataWriter } + +procedure TNativeDataWriter.Finalise; +var + FS: TFileStream; // stream onto output file +begin + // We use a TFileStream and TXMLDocument.SaveToStream rather than calling + // TXMLDocument.SaveToFile so that any problem creating file is reported via + // a known Delphi exception that can be handled. + EnsureFolders(DataDirectory); + try + FS := TFileStream.Create(PathToXMLFile, fmCreate); + try + XMLDoc.Encoding := 'UTF-8'; + XMLDoc.SaveToStream(FS); + finally + FreeAndNil(FS); + end; + except + HandleException(ExceptObject); + end; +end; + +procedure TNativeDataWriter.HandleException(const EObj: TObject); +begin + if (EObj is EFileStreamError) or (EObj is ECodeSnip) then + raise EDataIO.Create(EObj as Exception); + raise EObj; +end; + +procedure TNativeDataWriter.Initialise; +//var +// RootNode: IXMLNode; // document root node +begin + try + // Make sure database folder exists, empty of source code files + TDirectory.CreateDirectory(DataDirectory); + DeleteFiles(DataDirectory, '*' + SourceCodeFileExt); + + fRootNode := InitXMLDocAndRootNode; + + // create empty categories and snippets nodes + fCategoriesNode := XMLDoc.CreateElement(fRootNode, CategoriesNodeName); + fSnippetsNode := XMLDoc.CreateElement(fRootNode, SnippetsNodeName); + except + HandleException(ExceptObject); + end; +end; + +procedure TNativeDataWriter.WriteCatProps(const CatID: string; + const Props: TCategoryData); +var + CatNode: IXMLNode; // referenced to required category node +begin + try + // Create node + CatNode := XMLDoc.CreateElement(fCategoriesNode, CategoryNodeName); + CatNode.Attributes[CategoryNodeIdAttr] := CatID; + XMLDoc.CreateElement(CatNode, CategoryDescriptionNodeName, Props.Desc); + except + HandleException(ExceptObject); + end; +end; + +procedure TNativeDataWriter.WriteCatSnippets(const CatID: string; + const SnipList: IStringList); +var + CatNode: IXMLNode; // reference to required category node +begin + try + // Don't write list if no snippets + if SnipList.Count = 0 then + Exit; + // Find required category node + CatNode := FindCategoryNode(CatID); + Assert(Assigned(CatNode), + ClassName + '.WriteCatSnippets: Can''t find category node'); + // Write the list + WriteEnclosedList( + CatNode, + CategorySnippetsListNodeName, + CategorySnippetsListItemNodeName, + SnipList + ); + except + HandleException(ExceptObject); + end; +end; + +procedure TNativeDataWriter.WriteEnclosedList(const AParent: IXMLNode; + const AListNodeName, AItemNodeName: string; const AItems: IStringList); +var + ListNode: IXMLNode; // reference to enclosing list node + Item: string; // a name item in list +begin + ListNode := XMLDoc.CreateElement(AParent, AListNodeName); + for Item in AItems do + XMLDoc.CreateElement(ListNode, AItemNodeName, Item); +end; + +procedure TNativeDataWriter.WriteReferenceList(const ASnippetKey, + AListNodeName, AItemNodeName: string; const AItems: IStringList); +var + SnippetNode: IXMLNode; // reference to snippet's node +begin + try + // Don't write list if no items + if AItems.Count = 0 then + Exit; + // Find snippet node + SnippetNode := FindSnippetNode(ASnippetKey); + Assert(Assigned(SnippetNode), + ClassName + '.WriteReferenceList: Can''t find snippet node'); + // Write the list + WriteEnclosedList(SnippetNode, AListNodeName, AItemNodeName, AItems); + except + HandleException(ExceptObject); + end; +end; + +procedure TNativeDataWriter.WriteSnippetDepends(const SnippetKey: string; + const Depends: IStringList); +begin + if not fCanWriteRequiredLists then + Exit; + WriteReferenceList( + SnippetKey, + SnippetDependsListNodeName, + SnippetDependsListItemNodeName, + Depends + ); +end; + +procedure TNativeDataWriter.WriteSnippetProps(const SnippetKey: string; + const Props: TSnippetData); +var + SnippetNode: IXMLNode; // snippet's node + FileName: string; // name of file where source code stored + SourceCodeNode: IXMLNode; + CompResultsNode: IXMLNode; // node that stores all compiler results + CompResultNode: IXMLNode; // each compiler result node + CompID: TCompilerID; // loops thru all supported compilers + TestInfoNode: IXMLNode; +begin + try + // Record whether required units / snippets list are permitted + {TODO -cVault: Change following line to use Props.SourceLanguage once + implemented to check if language is Pascal: can't write the lists + if not.} + fCanWriteRequiredLists := Props.HiliteSource; + // Create snippet node + SnippetNode := XMLDoc.CreateElement(fSnippetsNode, SnippetNodeName); + SnippetNode.Attributes[SnippetNodeKeyAttr] := SnippetKey; + SnippetNode.Attributes[SnippetNodeCategoryAttr] := Props.Cat; + {TODO -cVault: change following test to test for Language = 'pascal' + instead of HiliteSource once Language prop is created} + if Props.HiliteSource then + SnippetNode.Attributes[SnippetNodeKindAttr] := + SnippetKindValues[Props.Kind] + else + SnippetNode.Attributes[SnippetNodeKindAttr] := + SnippetKindValues[skFreeform]; + + // Add property nodes + // display name + XMLDoc.CreateElement( + SnippetNode, SnippetDisplayNameNodeName, Props.DisplayName + ); + // description node: only written if Desc property has a value + if Props.Desc.HasContent then + XMLDoc.CreateElement( + SnippetNode, + SnippetDescriptionNodeName, + TSnippetExtraHelper.BuildREMLMarkup(Props.Desc) + ); + // notes node: only written if Extra property has a value + if Props.Extra.HasContent then + {TODO -cVault: rename Extra snippets property as Notes} + XMLDoc.CreateElement( + SnippetNode, + SnippetNotesNodeName, + TSnippetExtraHelper.BuildREMLMarkup(Props.Extra) + ); + // source code node + FileName := SnippetKey + SourceCodeFileExt; + SourceCodeNode := XMLDoc.CreateElement(SnippetNode, SnippetSourceNodeName); + SourceCodeNode.Attributes[SnippetSourceNodeFileAttr] := FileName; + {TODO -cVault: change snippet props to have a language field instead of + HiliteSource and use it to set the following attribute} + SourceCodeNode.Attributes[SnippetSourceNodeLanguageAttr] := + StrIf(Props.HiliteSource, 'pascal', 'text'); + // source code file: source code is written to a UTF-8 encoded file with no + // BOM and filename is stored in XML + TFileIO.WriteAllText( + FilePath(FileName), Props.SourceCode, TEncoding.UTF8, False + ); + {TODO -cVault: change following test to test for Language = 'pascal' + instead of HiliteSource once Language prop is created} + if Props.HiliteSource and (Props.Kind <> skFreeform) then + begin + // compile results list: must be omitted if snippet is not Pascal & + // even then, only known compiler results are written + CompResultsNode := XMLDoc.CreateElement( + SnippetNode, SnippetCompileResultsNodeName + ); + for CompID := Low(TCompilerID) to High(TCompilerID) do + begin + if Props.CompilerResults[CompID] <> crQuery then + begin + CompResultNode := XMLDoc.CreateElement( + CompResultsNode, SnippetCompilerNodeName + ); + CompResultNode.Attributes[SnippetCompilerNodeIdAttr] := + CompilerIDs[CompID]; + CompResultNode.Attributes[SnippetCompilerNodeResultAttr] := + CompileResultValues[Props.CompilerResults[CompID]]; + end; + end; + end; + // test info + TestInfoNode := XMLDoc.CreateElement(SnippetNode, SnippetTestInfoNodeName); + TestInfoNode.Attributes[SnippetTestInfoNodeLevelAttr] := + TestInfoValues[Props.TestInfo]; + {TODO -cVault: Change following line that always writes an empty URL once + TestURL property added to snippets.} + TestInfoNode.Attributes[SnippetTestInfoNodeUrlAttr] := ''; + except + HandleException(ExceptObject); + end; +end; + +procedure TNativeDataWriter.WriteSnippetUnits(const SnippetKey: string; + const Units: IStringList); +begin + if not fCanWriteRequiredLists then + Exit; + WriteReferenceList( + SnippetKey, + SnippetUnitsListNodeName, + SnippetUnitsListItemNodeName, + Units + ); +end; + +procedure TNativeDataWriter.WriteSnippetXRefs(const SnippetKey: string; + const XRefs: IStringList); +begin + WriteReferenceList( + SnippetKey, + SnippetXRefsListNodeName, + SnippetXRefsListItemNodeName, + XRefs + ); +end; + +end. diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 6fa7eab71..7293b6c50 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -132,6 +132,7 @@ implementation IOUtils, // Project DB.DataFormats, + DB.IO.DataFormat.Native, DBIO.UCategoryIO, DBIO.UFileIOIntf, DBIO.UIniData, @@ -264,6 +265,19 @@ TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) } end; + TNativeVaultFormatLoader = class(TDatabaseLoader, IDataFormatLoader) + strict protected + function CreateReader: IDataReader; override; + {Creates reader object. If user database doesn't exist a nul reader is + created. + @return Reader object instance. + } + function ErrorMessageHeading: string; override; + {Returns heading to use in error messages. Identifies main database. + @return Required heading. + } + end; + /// Base for classes that save a collection to storage. TFormatSaver = class abstract (TInterfacedObject, IDataFormatSaver @@ -390,6 +404,31 @@ TNativeV4FormatSaver = class(TFormatSaver, const Provider: IDBDataProvider); override; end; + TNativeVaultFormatSaver = class(TFormatSaver, + IDataFormatSaver + ) + strict protected + + /// Creates an object that can write data to storage in + /// CodeSnip's native v4 data format. + /// IDataWriter. Required writer object. + function CreateWriter: IDataWriter; override; + + public + + /// Saves data to storage. + /// TSnippetList [in] List of all snippets + /// in the database. + /// TCategoryList [in] List of all + /// categories in the database. + /// IDBDataProvider [in] Object used to + /// obtain details of the data to be stored. + /// Method of IDataFormatSaver. + procedure Save(const SnipList: TSnippetList; + const Categories: TCategoryList; + const Provider: IDBDataProvider); override; + end; + /// Class used to save global category information, regardless of /// any categories saved with collections. TGlobalCategoryLoader = class(TInterfacedObject, IGlobalCategoryLoader) @@ -427,6 +466,8 @@ class function TDatabaseIOFactory.CreateDBLoader(const Collection: TCollection): Result := TDCSCV2FormatLoader.Create(Collection); TDataFormatKind.Native_v4: Result := TNativeV4FormatLoader.Create(Collection); + TDataFormatKind.Native_Vault: + Result := TNativeVaultFormatLoader.Create(Collection); else Result := nil; end; @@ -440,6 +481,8 @@ class function TDatabaseIOFactory.CreateDBSaver( Result := TDCSCV2FormatSaver.Create(Collection); TDataFormatKind.Native_v4: Result := TNativeV4FormatSaver.Create(Collection); + TDataFormatKind.Native_Vault: + Result := TNativeVaultFormatSaver.Create(Collection); else Result := nil; end; @@ -679,6 +722,25 @@ function TNativeV4FormatLoader.ErrorMessageHeading: string; Result := sError; end; +{ TNativeVaultFormatLoader } + +function TNativeVaultFormatLoader.CreateReader: IDataReader; +begin + Result := TNativeDataReader.Create(Collection.Storage.Directory); + if not Result.DatabaseExists then + Result := TNulDataReader.Create; +end; + +function TNativeVaultFormatLoader.ErrorMessageHeading: string; +resourcestring + sError = 'Error loading the collection %0:s using the %1:s data format:'; +begin + Result := Format( + sError, + [Collection.Name, TDataFormatInfo.GetName(Collection.Storage.Format)] + ); +end; + { TFormatSaver } constructor TFormatSaver.Create(const ACollection: TCollection); @@ -819,6 +881,20 @@ function TNativeV4FormatSaver.CreateWriter: IDataWriter; procedure TNativeV4FormatSaver.Save(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); +begin + {TODO -cVault: Backup and restore this collection per the DCSC v2 loader} + DoSave(SnipList, Categories, Provider); +end; + +{ TNativeVaultFormatSaver } + +function TNativeVaultFormatSaver.CreateWriter: IDataWriter; +begin + Result := TNativeDataWriter.Create(Collection.Storage.Directory); +end; + +procedure TNativeVaultFormatSaver.Save(const SnipList: TSnippetList; + const Categories: TCategoryList; const Provider: IDBDataProvider); begin DoSave(SnipList, Categories, Provider); end; From 198342e0e3d5b837557a94eb6ae2e3c6ba5eeb9d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 28 Feb 2025 19:27:01 +0000 Subject: [PATCH 135/222] Document CodeSnip Vault native data format Added new HTML file format document for the CodeSnip Vault native data format. This file not only documents the features of the format as currently implemented but also documents how it is proposed to implement storage of meta data in future. The proposed features are currently commented out so they don't appear in the rendered HTML document. --- .../FileFormats/collections/native.html | 934 ++++++++++++++++++ 1 file changed, 934 insertions(+) create mode 100644 Docs/Design/FileFormats/collections/native.html diff --git a/Docs/Design/FileFormats/collections/native.html b/Docs/Design/FileFormats/collections/native.html new file mode 100644 index 000000000..30942b3c0 --- /dev/null +++ b/Docs/Design/FileFormats/collections/native.html @@ -0,0 +1,934 @@ + + + + + + + + CodeSnip File Format Documentation - Native Collection Format + + + + + + + + +
+
+ DelphiDabbler CodeSnip +
+
+ File Format Documentation +
+
+ +

+ Native Collection Format +

+ +
+ +

+ Contents +

+ + + +
+ +
+ +

+ Introduction +

+ +

+ This file format is the default collection data format used by CodeSnip Vault. +

+ +

+ The format comprises a single XML file along with a number of data files located in the same directory. Each user can have zero or more snippet collections that use this format. +

+ +

+ The XML file is named collection.xml. It contains all the information about about the collection, except for the source code of each snippet. +

+ +

+ Snippet source code is stored in separate data files – one per snippet. Each source code file is referenced by the XML file. +

+ +

+ The format allows for later revisions. Files are versioned and comply with the principles of Semantic Versioning. Details of all the changes between versions are listed in the Change Log at the end of this document. +

+ +
+ +
+ +

+ Encoding +

+ +

+ All files are text files that use UTF-8 encoding, without any UTF-8 preamble (BOM). The XML processing instruction of collection.xml has its encoding atrribute set to UTF-8. +

+ +
+ +
+ +

+ File Format +

+ +

+ XML File +

+ +

+ The following information applies to file format v1.0. +

+ +
+
+ XML processing instruction +
+
+

+ Attributes: +

+

+
+ version +
+
+ Always set to 1.0. +
+
+ encoding +
+
+ Character encoding used for file. Always set to UTF-8. +
+
+
+ +
+ collection +
+
+

+ Parent node that contains all the collection data. +

+

+ Attributes: +

+
+
+ watermark +
+
+ Identifies the file as the correct type. It is always set to 882BAD68-8C3E-44E3-BBF4-17E55143DAF8, regardless of the file version. +
+
+ version-major +
+
+ Identifies the major version of the file format. Must be 1. +
+
+ version-minor +
+
+ Identifies the minor version of the file format. Must be 0. +
+
+
+ +
+ collection/categories +
+
+

+ Contains a list of all categories used by the collection. +

+
+ +
+ collection/categories/category +
+
+

+ Contains information about a single category. There is one node per category. +

+

+ Attributes: +

+
+
+ id +
+
+ Unique id of the category. +
+
+
+ +
+ collection/categories/category/description +
+
+

+ Description of the category. +

+
+ +
+ collection/categories/category/snippet-keys +
+
+

+ Contains list of the unique keys of all snippets in this category. May be omitted if there are no snippets in the category. +

+
+ +
+ collection/categories/category/snippet-keys/key +
+
+

+ Contains the key of a snippet in the category. There is one node for each snippet in the category. +

+

+ The value must be: +

+
    +
  • unique withing the collection
    • +
  • a valid Unicode Pascal identifier
    • +
+
+ +
+ collection/snippets +
+
+

+ Contains defintiions of all snippets in the collection. +

+
+ +
+ collection/snippets/snippet +
+
+

+ Contains information about a snippet. There is one node per snippet. +

+

+ Attributes: +

+
+
+ key +
+
+

+ The snippet key. +

+

+ The value must be: +

+
    +
  • unique withing the collection
    • +
  • a valid Unicode Pascal identifier
    • +
+
+
+ category +
+
+

+ The unique id of the category to which the snippet belongs. +

+

+ The value must correspond to the id attribute of one of the collection/categories/category nodes. +

+
+
+ kind +
+
+

+ The type of snippet. +

+

+ Valid values are: +

+
    +
  • freeform
    • +
  • routine
    • +
  • type
    • +
  • const
    • +
  • class
    • +
  • unit
    • +
+

+ The values are not case sensitive. +

+

+ If collection/snippets/snippet/source-code/language has any value other than Pascal then this attribute must have value freeform. +

+
+
+
+ +
+ collection/snippets/snippet/display-name +
+
+

+ The snippet's display name. +

+
+ +
+ collection/snippets/snippet/description +
+
+

+ Description of the snippet. +

+

+ Content must be valid REML markup. REML v6 is supported. +

+

+ This node may be omitted if there is no description. +

+
+ +
+ collection/snippets/snippet/notes +
+
+

+ Additional information about the snippet. +

+

+ Content must be valid REML markup. REML v6 is supported. +

+

+ This node may be omitted if there are no notes. +

+
+ +
+ collection/snippets/snippet/source-code +
+
+

+ Contains information about a snippet's source code. +

+

+ Attributes: +

+
+
+ file-name +
+
+

+ Name of the file containing the snippet's source code. +

+

+ The named file must exist in the same directory as this XML file. +

+
+
+ language +
+
+

+ Identifies the programming language, if any, used by the source code. +

+

+ Valid values are: +

+
    +
  • + text – the snippet is plain text, not source code. +
    • +
  • + unknown – the snippet's source code language is unknown to CodeSnip. +
    • +
  • + pascal – the snippet's source code is written in Object Pascal. +
    • +
+
+
+
+ +
+ collection/snippets/snippet/compile-results +
+
+

+ Contains a list of compile results for the snippet. +

+

+ This node has no meaning and must be omitted if either of the following two conditions apply: +

+
    +
  1. + The source code language is not pascal. +
    2. +
  2. + The snippet kind is freeform. +
    3. +
+
+ +
+ collection/snippets/snippet/compile-results/compiler + +
+
+

+ The compile result for a given compiler. There is an entry for each known compiler. +

+

+ Attributes: +

+
+
+ id +
+
+

+ Identifies the compiler. Valid identifiers are are one of: +

+
    +
  • + d2 – Delphi 2 compiler +
    • +
  • + d3 – Delphi 3 compiler +
    • +
  • + d4 – Delphi 4 compiler +
    • +
  • + d5 – Delphi 5 compiler +
    • +
  • + d6 – Delphi 6 compiler +
    • +
  • + d7 – Delphi 7 compiler +
    • +
  • + d2005 – Delphi 2005 compiler +
    • +
  • + d2006 – Delphi 2006 compiler +
    • +
  • + d2007 – Delphi 2007 compiler +
    • +
  • + d2009 – Delphi 2009 compiler +
    • +
  • + d2010 – Delphi 2010 compiler +
    • +
  • + dXE – Delphi XE compiler +
    • +
  • + dxe2 – Delphi XE2 compiler +
    • +
  • + dxe3 – Delphi XE3 compiler +
    • +
  • + dxe4 – Delphi XE4 compiler +
    • +
  • + dxe5 – Delphi XE5 compiler +
    • +
  • + dxe6 – Delphi XE6 compiler +
    • +
  • + dxe7 – Delphi XE7 compiler +
    • +
  • + dxe8 – Delphi XE8 compiler +
    • +
  • + d10.0 – Delphi 10 Seattle compiler +
    • +
  • + d10.1 – Delphi 10.1 Berlin compiler +
    • +
  • + d10.2 – Delphi 10.2 Tokyo compiler +
    • +
  • + d10.3 – Delphi 10.3 Rio compiler +
    • +
  • + d10.4 – Delphi 10.4 Sydney compiler +
    • +
  • + d11 – Delphi 11.x Alexandria compiler +
    • +
  • + d12 – Delphi 12 Athens compiler +
    • +
  • + fpc – Free Pascal compiler +
    • +
+

+ The values are not case sensitive. +

+
+
+ result +
+
+

+ The compile result for the compiler. Valid values are: +

+
    +
  • + y – Compiles with the identified compiler. +
    • +
  • + n – Does not compile with the identified compiler. +
    • +
  • + q – Compile result for this compiler is not known. +
    • +
+

+ The values are not case sensitive. +

+
+
+

+ There is no text content. +

+

+ Omitting a node for any compiler is permitted and is equivalent to specifying q. +

+
+ +
+ collection/snippets/snippet/tests +
+
+

+ Provides information about the level of testing applied to this snippet. +

+

+ Attributes: +

+
+
+ level +
+
+

+ The level of testing achieved. Valid values are: +

+
    +
  • + none – the snippet has not been tested. +
    • +
  • + basic – the snippet has passed some simple, unspecified testing. +
    • +
  • + advanced – the snippet has passed more advanced, but unspecified testing. +
    • +
  • + unit-tests – the snippet has passed unit tests. +
    • +
  • + demo-code – there exists demo code that exercises the snippet. +
    • +
+
+
+ url +
+
+

+ The URL of any unit tests or demo code. +

+

+ This attribute must only be provided when the level attribute has value unit-tests or demo-code. +

+
+
+

+ There is no text content. +

+

+ This node may be omitted if the unit has not been tested. In this case a testing level of none will be assumed. +

+
+ +
+ collection/snippets/snippet/required-units +
+
+

+ List of units required to compile the snippet. +

+

+ The node may be omitted if there are no required units. +

+

+ If collection/snippets/snippet/source-code/language has any value other than Pascal then this node has no meaning and must be omitted. +

+ +
+ +
+ collection/snippets/snippet/required-units/unit +
+
+

+ Name of a unit within the required units list. +

+

+ Must be a valid Pascal identifier. +

+
+ +
+ collection/snippets/snippet/required-snippets +
+
+

+ List of snippets that are required to compile the snippet. +

+

+ The node may be omitted if there are no required snippets. +

+

+ If collection/snippets/snippet/source-code/language has any value other than Pascal then this node has no meaning and must be omitted. +

+
+ +
+ collection/snippets/snippet/required-snippets/key +
+
+

+ Key of a snippet within the required snippets list. +

+
+ +
+ collection/snippets/snippet/xrefs +
+
+

+ List of cross-referenced snippets. +

+

+ The node may be omitted if there are no cross referenced snippets. +

+
+ +
+ collection/snippets/snippet/xrefs/key +
+
+

+ Key of a snippet within the cross-references list. +

+
+ + + +
+ +

+ Source Code Files +

+ +

+ Source code is stored separately from the main XML file. The source code of each snippet has its own file. File names relate to the relevant snippet's key and have extension .source. +

+ +

+ Source code files are referenced by the file-name attribute of a snippet's collection/snippets/snippet/source-code node in the XML file. +

+ + + +
+ +
+ +

+ Change Log +

+ +

+ This section describes the changes between versions of the file format. +

+ +

+ Version 1.0 +

+ +
    +
  • + Introduced with CodeSnip Vault. +
    • +
  • + Supports Delphi compilers from Delphi 2 to Delphi 12.x, plus Free Pascal. +
    • +
  • + Supports REML v6. +
    • +
+ +
From a23192b76d33d863c1c979c99ecc162ba91e366b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 1 Mar 2025 15:32:07 +0000 Subject: [PATCH 136/222] Add new DB.MetaData unit to project This unit encapsulates meta data. It provides an enumerated type, TMetaDataCap that enumerate the various meta data capabilities along with an associated TMetaDataCaps set type. There are 3 records: TLicenseInfo, TCopyrightInfo and TMetaData. TMetaData contains fields of type TLicenseInfo and TCopyrightInfo. TLicenseInfo and TCopyrightInfo are similar to TDBLicenseInfo and TDBCopyrightInfo in DB.UMetaData while TMetaDataCap / TMetaDataCaps are similar to TMetaDataCapability and TMetaDataCapabilities in DB.UMetaData. Ultimately DB.MetaData will replace DB.UMetaData and related units. --- Src/CodeSnip.dpr | 3 +- Src/CodeSnip.dproj | 1 + Src/DB.MetaData.pas | 346 ++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 349 insertions(+), 1 deletion(-) create mode 100644 Src/DB.MetaData.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 5d592e737..8bdcb5f3b 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -381,7 +381,8 @@ uses DBIO.MetaData.DCSC in 'DBIO.MetaData.DCSC.pas', FmCollectionBackup in 'FmCollectionBackup.pas' {CollectionBackupDlg}, DB.DataFormats in 'DB.DataFormats.pas', - DB.IO.DataFormat.Native in 'DB.IO.DataFormat.Native.pas'; + DB.IO.DataFormat.Native in 'DB.IO.DataFormat.Native.pas', + DB.MetaData in 'DB.MetaData.pas'; // Include resources {$Resource ExternalObj.tlb} // Type library file diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 0f4eb32cf..0b89e7d51 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -590,6 +590,7 @@ + Base diff --git a/Src/DB.MetaData.pas b/Src/DB.MetaData.pas new file mode 100644 index 000000000..1860ba1ab --- /dev/null +++ b/Src/DB.MetaData.pas @@ -0,0 +1,346 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2025, Peter Johnson (gravatar.com/delphidabbler). + * + * Encapsulates a collection's data format metadata. +} + + +unit DB.MetaData; + +{$ScopedEnums ON} + +interface + +uses + // Project + UIStringList, + UVersionInfo; + +type + + /// Enumeration of the capabilities of a data format. + /// + /// - Version - supports the collection's data format version + /// number. + /// - License - supports collection license information. + /// - Copyright - supports collection copyright information. + /// + /// - Acknowledgements - supports acknowledgements for the + /// collection. + /// + TMetaDataCap = ( + Version, + License, + Copyright, + Acknowledgements + ); + + /// Set of meta data capabilities applying to a data format. + /// + TMetaDataCaps = set of TMetaDataCap; + + /// Record providing information about a collection's license. + /// + TLicenseInfo = record + strict private + var + fName: string; + fSPDX: string; + fURL: string; + fText: string; + public + /// Record constructor: sets all fields of record. + /// Any or all parameters may be the empty string + constructor Create(const AName, ASPDX, AURL, AText: string); + + /// Creates and returns a null record with all fields set to the + /// empty string. + class function CreateNull: TLicenseInfo; static; + + /// Returns a deep copy of this record. + function Clone: TLicenseInfo; + + /// Name of license. + property Name: string read fName; + + /// Open Source Initiative SPDX short idenitifier for licenses. + /// + /// If the license is not supported by the Open Source Initiative + /// then this property will be the empty string. + property SPDX: string read fSPDX; + + /// URL of license online. + /// Optional. + property URL: string read fURL; + + /// Full text of license. + property Text: string read fText; + + /// Returns a string containing license name followed by any URL + /// in parentheses. + /// If no URL is available then only the license name is returned. + /// + function NameWithURL: string; + end; + + /// Record providing informaton about a collection's copyright. + /// + TCopyrightInfo = record + strict private + var + fDate: string; + fHolder: string; + fHolderURL: string; + fContributors: IStringList; + function GetContributors: IStringList; + public + /// Record constructor: sets all fields of record. + /// Any or all string parameters may be the empty string. + /// AContributors may be nil if there are no contributors. + /// + constructor Create(const ADate, AHolder, AHolderURL: string; + AContributors: IStringList); + + /// Creates and returns a null record. + /// A null record has all string fields set to the empty string + /// and the Contributors property set to an empty list. + class function CreateNull: TCopyrightInfo; static; + + /// Returns a deep copy of this record. + function Clone: TCopyrightInfo; + + /// Copyright date. + /// May be a single year or a range: e.g. 2020 or 2012-2016. + /// + property Date: string read fDate; + + /// Name of copyright holder. + property Holder: string read fHolder; + + /// URL of main copyright holder. + /// Optional. + property HolderURL: string read fHolderURL; + + /// List of names of contributors who share ownership of the + /// copyright. + property Contributors: IStringList read GetContributors; + + /// Creates and returns a string representation of all the + /// non-empty fields of the record. + function ToString: string; + end; + + /// Encapsulates a collection's meta data. + TMetaData = record + strict private + var + fCapabilities: TMetaDataCaps; + fVersion: TVersionNumber; + fLicenseInfo: TLicenseInfo; + fCopyrightInfo: TCopyrightInfo; + fAcknowledgements: IStringList; + function GetVersion: TVersionNumber; + function GetLicenseInfo: TLicenseInfo; + function GetCopyrightInfo: TCopyrightInfo; + function GetAcknowledgements: IStringList; + public + /// Creates a meta data record with specified capabilities. + /// + /// TMetaDataCaps [in] The required + /// capabilities. + constructor Create(const ACapabilities: TMetaDataCaps); + + /// Creates a null meta data record with specified capabilities. + /// + class function CreateNull: TMetaData; static; + + /// Returns a deep copy of this record. + function Clone: TMetaData; + + /// The meta data capabilities. + property Capabilities: TMetaDataCaps + read fCapabilities; + + /// The data format version. + property Version: TVersionNumber + read GetVersion write fVersion; + + /// Information about the collection license. + property LicenseInfo: TLicenseInfo + read GetLicenseInfo write fLicenseInfo; + + /// Information about the collection's copyright. + property CopyrightInfo: TCopyrightInfo + read GetCopyrightInfo write fCopyrightInfo; + + /// List of acknowledgements. + property Acknowledgements: IStringList + read GetAcknowledgements write fAcknowledgements; + end; + +implementation + +uses + // Delphi + Character, + // Project + UStrUtils; + +function StandardiseStr(const AStr: string): string; +begin + Result := StrCompressWhiteSpace( + StrReplaceChar( + AStr, + function(Ch: Char): Boolean + begin + Result := TCharacter.IsControl(Ch); + end, + ' ' + ) + ); +end; + +{ TLicenseInfo } + +function TLicenseInfo.Clone: TLicenseInfo; +begin + Result.fName := Name; + Result.fSPDX := SPDX; + Result.fURL := URL; + Result.fText := Text; +end; + +constructor TLicenseInfo.Create(const AName, ASPDX, AURL, AText: string); +begin + fName := StandardiseStr(AName); + fSPDX := StandardiseStr(ASPDX); + fURL := StandardiseStr(AURL); + fText := StandardiseStr(AText); +end; + +class function TLicenseInfo.CreateNull: TLicenseInfo; +begin + Result := TLicenseInfo.Create('', '', '', ''); +end; + +function TLicenseInfo.NameWithURL: string; +begin + Result := fName; + if fURL <> '' then + Result := Result + ' (' + fURL + ')'; +end; + +{ TCopyrightInfo } + +function TCopyrightInfo.Clone: TCopyrightInfo; +begin + Result.fDate := Date; + Result.fHolder := Holder; + Result.fHolderURL := HolderURL; + Result.fContributors := Contributors; +end; + +constructor TCopyrightInfo.Create(const ADate, AHolder, AHolderURL: string; + AContributors: IStringList); +begin + fDate := StandardiseStr(ADate); + fHolder := StandardiseStr(AHolder); + fHolderURL := StandardiseStr(AHolderURL); + fContributors := TIStringList.Create(AContributors); +end; + +class function TCopyrightInfo.CreateNull: TCopyrightInfo; +begin + Result := TCopyrightInfo.Create('', '', '', nil); +end; + +function TCopyrightInfo.GetContributors: IStringList; +begin + Result := TIStringList.Create(fContributors); +end; + +function TCopyrightInfo.ToString: string; +resourcestring + sCopyright = 'Copyright'; +begin + Result := ''; + if Date <> '' then + Result := Result + '(C) ' + Date; + if Holder <> '' then + begin + if Result <> '' then + Result := Result + ', '; + Result := Result + Holder; + end; + if HolderURL <> '' then + begin + if Result <> '' then + Result := Result + ', '; + Result := Result + HolderURL; + end; + if Result <> '' then + Result := sCopyright + ' ' + Result; +end; + +{ TMetaData } + +function TMetaData.Clone: TMetaData; +begin + Result.fCapabilities := Capabilities; + Result.fVersion := GetVersion; + Result.fLicenseInfo := GetLicenseInfo; + Result.fCopyrightInfo := GetCopyrightInfo; + Result.fAcknowledgements := GetAcknowledgements; +end; + +constructor TMetaData.Create(const ACapabilities: TMetaDataCaps); +begin + fCapabilities := ACapabilities; + fVersion := TVersionNumber.Nul; + fLicenseInfo := TLicenseInfo.CreateNull; + fCopyrightInfo := TCopyrightInfo.CreateNull; + fAcknowledgements := TIStringList.Create; +end; + +class function TMetaData.CreateNull: TMetaData; +begin + Result := TMetaData.Create([]); +end; + +function TMetaData.GetAcknowledgements: IStringList; +begin + if TMetaDataCap.Acknowledgements in fCapabilities then + Result := TIStringList.Create(fAcknowledgements) + else + Result := TIStringList.Create; +end; + +function TMetaData.GetCopyrightInfo: TCopyrightInfo; +begin + if TMetaDataCap.Copyright in fCapabilities then + Result := fCopyrightInfo.Clone + else + Result := TCopyrightInfo.CreateNull; +end; + +function TMetaData.GetLicenseInfo: TLicenseInfo; +begin + if TMetaDataCap.License in fCapabilities then + Result := fLicenseInfo.Clone + else + Result := TLicenseInfo.CreateNull; +end; + +function TMetaData.GetVersion: TVersionNumber; +begin + if TMetaDataCap.Version in fCapabilities then + Result := fVersion + else + Result := TVersionNumber.Nul; +end; + +end. From 8413b324137c47d3edbcddd98f4e169d34039a38 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 2 Mar 2025 10:39:14 +0000 Subject: [PATCH 137/222] Add new TCollection.MetaData property This property added to enable meta data associated with a collection to be stored with it. --- Src/DB.UCollections.pas | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index b1d7e9800..ea1777a8a 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -21,6 +21,7 @@ interface Generics.Defaults, DB.DataFormats, + DB.MetaData, UEncodings, UExceptions, USettings, @@ -69,6 +70,8 @@ TCollection = record fUID: TCollectionID; fName: string; fStorage: TDataStorageDetails; + fMetaData: TMetaData; + procedure SetMetaData(const AValue: TMetaData); public type TComparer = class(TInterfacedObject, @@ -97,6 +100,11 @@ TComparer = class(TInterfacedObject, /// Collection storage information. property Storage: TDataStorageDetails read fStorage; + /// Meta data associated with the collection. + /// Meta data is read from and written to the associated storage. + /// + property MetaData: TMetaData + read fMetaData write SetMetaData; /// Checks if this record's fields are valid. function IsValid: Boolean; /// Checks if this record is the default collection. @@ -197,6 +205,11 @@ function TCollection.IsValid: Boolean; and (fStorage.Format <> TDataFormatKind.Error); end; +procedure TCollection.SetMetaData(const AValue: TMetaData); +begin + fMetaData := AValue.Clone; +end; + { TCollections } procedure TCollections.Add(const ACollection: TCollection); From 5a5b2ebf28dfaedf907ba8c1a53c849fe7198dec Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sat, 1 Mar 2025 17:54:25 +0000 Subject: [PATCH 138/222] Add facility to save metadata to data format writers Added WriteMetaData method to TFormatSaver class in DB.UDatabaseIO. Added IDataWriter.WriteMetaData method and implemented it in TIniDataWriter (writes all kinds of meta data for the DCSC v2 data format), TXMLDataWriter (writes no meta data for the CodeSnip v4 native format) and TNativeDataWriter (writes all but version meta data for CodeSnip Vault native data format). --- Src/DB.IO.DataFormat.Native.pas | 56 ++++++++++++++++++++++++ Src/DB.UDatabaseIO.pas | 22 ++++++++++ Src/DBIO.UFileIOIntf.pas | 13 +++++- Src/DBIO.UIniData.pas | 75 ++++++++++++++++++++++++++++++++- Src/DBIO.UXMLDataIO.pas | 23 +++++++++- 5 files changed, 186 insertions(+), 3 deletions(-) diff --git a/Src/DB.IO.DataFormat.Native.pas b/Src/DB.IO.DataFormat.Native.pas index 9ac56a5ba..50e72a423 100644 --- a/Src/DB.IO.DataFormat.Native.pas +++ b/Src/DB.IO.DataFormat.Native.pas @@ -19,6 +19,7 @@ interface XMLIntf, // Project Compilers.UGlobals, + DB.MetaData, DB.UCategory, DB.USnippet, DB.USnippetKind, @@ -430,6 +431,12 @@ TNativeDataWriter = class sealed(TNativeDataRW, IDataWriter) procedure WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); + /// Writes the collection's meta data. + /// TMetaData [in] Meta data to be written. + /// + /// Method of IDataWriter. + procedure WriteMetaData(const AMetaData: TMetaData); + /// Finalises the collection write. /// /// Always called after all other IDataWriter methods. @@ -1058,6 +1065,55 @@ procedure TNativeDataWriter.WriteEnclosedList(const AParent: IXMLNode; XMLDoc.CreateElement(ListNode, AItemNodeName, Item); end; +procedure TNativeDataWriter.WriteMetaData(const AMetaData: TMetaData); +var + LicenseNode: IXMLNode; + CopyrightNode: IXMLNode; +begin + // Write license info + LicenseNode := XMLDoc.CreateElement(fRootNode, LicenseNodeName); + LicenseNode.Attributes[LicenseNodeSPDXAttr] := AMetaData.LicenseInfo.SPDX; + LicenseNode.Attributes[LicenseNodeNameAttr] := AMetaData.LicenseInfo.Name; + LicenseNode.Attributes[LicenseNodeURLAttr] := AMetaData.LicenseInfo.URL; + if StrIsEmpty(AMetaData.LicenseInfo.Text) then + LicenseNode.Attributes[LicenseNodeLicenseFileAttr] := '' + else + begin + // license text file: license text is written to a UTF-8 encoded file with + // no BOM and filename is stored in XML + LicenseNode.Attributes[LicenseNodeLicenseFileAttr] := LicenseTextFileName; + TFileIO.WriteAllText( + FilePath(LicenseTextFileName), + AMetaData.LicenseInfo.Text, + TEncoding.UTF8, + False + ); + end; + + CopyrightNode := XMLDoc.CreateElement(fRootNode, CopyrightNodeName); + CopyrightNode.Attributes[CopyrightNodeDateAttr] := + AMetaData.CopyrightInfo.Date; + CopyrightNode.Attributes[CopyrightNodeHolderAttr] := + AMetaData.CopyrightInfo.Holder; + CopyrightNode.Attributes[CopyrightNodeURLAttr] + := AMetaData.CopyrightInfo.HolderURL; + if AMetaData.CopyrightInfo.Contributors.Count > 0 then + WriteEnclosedList( + CopyrightNode, + CopyrightContributorsListNodeName, + CopyrightContributorsListItemNodeName, + AMetaData.CopyrightInfo.Contributors + ); + + WriteEnclosedList( + fRootNode, + AcknowledgementsListNodeName, + AcknowledgementsListItemNodeName, + AMetaData.Acknowledgements + ); + +end; + procedure TNativeDataWriter.WriteReferenceList(const ASnippetKey, AListNodeName, AItemNodeName: string; const AItems: IStringList); var diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 7293b6c50..005ff186c 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -153,6 +153,12 @@ implementation } TDatabaseLoaderClass = class of TDatabaseLoader; + {TODO -cRefactoring: Would a better method be to have a single TDatabaseLoader + class that is passed a reader object in its constructor, + rather than have sub-classes that simply create the + required reader object?} + {TODO -cRefactoring: Rename TDatabaseLoader to TFormatLoader or similar} + { TDatabaseLoader: Abstract base class for objects that can load data into the Database object @@ -278,6 +284,13 @@ TNativeVaultFormatLoader = class(TDatabaseLoader, IDataFormatLoader) } end; + {TODO -cRefactoring: Would a better method be to have a single TFormatSaver + class that is passed a writer object in its constructor, + rather than have sub-classes that simply create the + required writer object? + Would need to make sure all .Save methods in sub-classes + are identical first. } + /// Base for classes that save a collection to storage. TFormatSaver = class abstract (TInterfacedObject, IDataFormatSaver @@ -298,6 +311,9 @@ TFormatSaver = class abstract (TInterfacedObject, /// collection. procedure WriteCategories; + /// Writes the collection's meta data, if supported. + procedure WriteMetaData; + strict protected /// Saves collection to storage. @@ -759,6 +775,7 @@ procedure TFormatSaver.DoSave(const SnipList: TSnippetList; fWriter.Initialise; WriteCategories; WriteSnippets; + WriteMetaData; fWriter.Finalise; end; @@ -781,6 +798,11 @@ procedure TFormatSaver.WriteCategories; end; end; +procedure TFormatSaver.WriteMetaData; +begin + fWriter.WriteMetaData(fCollection.MetaData); +end; + procedure TFormatSaver.WriteSnippets; // Adds snippet keys from IDList to a string list diff --git a/Src/DBIO.UFileIOIntf.pas b/Src/DBIO.UFileIOIntf.pas index d032816b5..6cb46bd33 100644 --- a/Src/DBIO.UFileIOIntf.pas +++ b/Src/DBIO.UFileIOIntf.pas @@ -19,7 +19,11 @@ interface uses // Project - DB.UCategory, DB.USnippet, UExceptions, UIStringList; + DB.MetaData, + DB.UCategory, + DB.USnippet, + UExceptions, + UIStringList; type @@ -128,6 +132,13 @@ interface @param SnippetKey [in] Snippet's key. @param XRefs [in] List of snippet keys. } + + /// Write the collection's meta data. + /// TMetaData [in] Meta data to be written. + /// + /// Data formats may support all, some or no metadata. + procedure WriteMetaData(const AMetaData: TMetaData); + procedure Finalise; {Finalises the database. Always called after all other methods. } diff --git a/Src/DBIO.UIniData.pas b/Src/DBIO.UIniData.pas index 7039883b7..9310b9f0f 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DBIO.UIniData.pas @@ -26,6 +26,7 @@ interface IniFiles, // Project ActiveText.UMain, + DB.MetaData, DB.UCategory, DB.USnippet, DBIO.UFileIOIntf, @@ -304,6 +305,11 @@ TUTF8IniFileCache = class(TObject) /// unformatted, single line, REML string. function ActiveTextToREML(AActiveText: IActiveText): string; + procedure WriteTextFile(const AFileName, AText: string); overload; + + procedure WriteTextFile(const AFileName: string; const ALines: IStringList); + overload; + public /// Object constructor. @@ -377,6 +383,12 @@ TUTF8IniFileCache = class(TObject) procedure WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); + /// Writes the collection's meta data. + /// TMetaData [in] Meta data to be written. + /// + /// Method of IDataWriter. + procedure WriteMetaData(const AMetaData: TMetaData); + /// Finalises the output. Always called after all other methods. /// /// Method of IDataWriter. @@ -409,6 +421,12 @@ implementation const // Name of master file that defines database cMasterFileName = 'categories.ini'; + // Names of meta data files + VersionFileName = 'VERSION'; + LicenseFileName = 'LICENSE'; + LicenseInfoFileName = 'LICENSE-INFO'; + ContributorsFileName = 'CONTRIBUTORS'; + AcknowledgementsFileName = 'TESTERS'; // Names of values in categories ini file cMasterIniName = 'Ini'; // name of category ini file cMasterDescName = 'Desc'; // category description @@ -916,6 +934,43 @@ procedure TIniDataWriter.WriteCatSnippets(const CatID: string; // Do nothing end; +procedure TIniDataWriter.WriteMetaData(const AMetaData: TMetaData); +begin + WriteTextFile( + VersionFileName, + Format( + '%0:d.%1:d.%2:d', + [AMetaData.Version.V1, AMetaData.Version.V2, AMetaData.Version.V3] + ) + ); + + WriteTextFile(LicenseFileName, AMetaData.LicenseInfo.Text); + + WriteTextFile( + LicenseInfoFileName, + Format( + 'LicenseName=%0:s' + EOL + + 'LicenseSPDX=%1:s' + EOL + + 'LicenseURL=%2:s' + EOL + + 'CopyrightDate=%3:s' + EOL + + 'CopyrightHolder=%4:s' + EOL + + 'CopyrightHolderURL=%5:s' + EOL, + [ + AMetaData.LicenseInfo.Name, + AMetaData.LicenseInfo.SPDX, + AMetaData.LicenseInfo.URL, + AMetaData.CopyrightInfo.Date, + AMetaData.CopyrightInfo.Holder, + AMetaData.CopyrightInfo.HolderURL + ] + ) + ); + + WriteTextFile(ContributorsFileName, AMetaData.CopyrightInfo.Contributors); + + WriteTextFile(AcknowledgementsFileName, AMetaData.Acknowledgements); +end; + procedure TIniDataWriter.WriteSnippetDepends(const SnippetKey: string; const Depends: IStringList); begin @@ -1006,7 +1061,9 @@ procedure TIniDataWriter.WriteSnippetProps(const SnippetKey: string; // test info: only write if not basic {TODO -cVault: Add support for AdvancedTest .Level & .URL} if Props.TestInfo <> stiBasic then - fCurrentCatIni.WriteString(SnippetKey, cTestInfoName, TestInfo[Props.TestInfo]); + fCurrentCatIni.WriteString( + SnippetKey, cTestInfoName, TestInfo[Props.TestInfo] + ); except @@ -1040,6 +1097,22 @@ procedure TIniDataWriter.WriteSnippetXRefs(const SnippetKey: string; ); end; +procedure TIniDataWriter.WriteTextFile(const AFileName, AText: string); +begin + TFileIO.WriteAllText(MakePath(AFileName), AText, TEncoding.UTF8, True); +end; + +procedure TIniDataWriter.WriteTextFile(const AFileName: string; + const ALines: IStringList); +var + Content: string; +begin + Content := ALines.GetText(EOL, False); + if not StrIsEmpty(Content) then + Content := Content + EOL; + WriteTextFile(AFileName, Content); +end; + { TIniDataWriter.TUTF8IniFile } procedure TIniDataWriter.TUTF8IniFile.Save; diff --git a/Src/DBIO.UXMLDataIO.pas b/Src/DBIO.UXMLDataIO.pas index eb0ec1db5..c1ff21f4b 100644 --- a/Src/DBIO.UXMLDataIO.pas +++ b/Src/DBIO.UXMLDataIO.pas @@ -20,7 +20,12 @@ interface // Delphi XMLIntf, // Project - DB.UCategory, DB.USnippet, DBIO.UFileIOIntf, UIStringList, UREMLDataIO, + DB.MetaData, + DB.UCategory, + DB.USnippet, + DBIO.UFileIOIntf, + UIStringList, + UREMLDataIO, UXMLDocumentEx; @@ -231,6 +236,17 @@ TXMLDataWriter = class(TXMLDataIO, @param SnippetKey [in] Snippet's key. @param XRefs [in] List of snippet keys. } + + /// Writes the collection's meta data. + /// TMetaData [in] Meta data to be written. + /// + /// + /// This data format does not support metadata, so this method does + /// nothing. + /// Method of IDataWriter. + /// + procedure WriteMetaData(const AMetaData: TMetaData); + procedure Finalise; {Finalises the database. Always called after all other methods. } @@ -858,6 +874,11 @@ procedure TXMLDataWriter.WriteCatSnippets(const CatID: string; end; end; +procedure TXMLDataWriter.WriteMetaData(const AMetaData: TMetaData); +begin + // Do nothing: meta data not supported. +end; + procedure TXMLDataWriter.WriteNameList(const Parent: IXMLNode; const ListName, ItemName: string; const Items: IStringList); {Writes a list of names to XML. From e3551aa77fbe5744f9378fc692728a2d4da625d9 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 2 Mar 2025 10:34:29 +0000 Subject: [PATCH 139/222] Add facility to read metadata from data format readers Added IDataReader.GetMetaData method and implemented it in TIniDataWriter (reads all kinds of meta data for the DCSC v2 data format), TXMLDataReader (returns null record for the CodeSnip v4 native format), TNativeDataReader (read all but version meta data for CodeSnip Vault native data format) and TNulDataReader (retruns null record). Updated TDatabaseLoader.Load method in DB.UDatabaseIO to get meta data and store it in the collection's MetaData property. --- Src/DB.IO.DataFormat.Native.pas | 64 +++++++++++++++++ Src/DB.UDatabaseIO.pas | 2 + Src/DBIO.UFileIOIntf.pas | 5 ++ Src/DBIO.UIniData.pas | 121 +++++++++++++++++++++++++++++++- Src/DBIO.UNulDataReader.pas | 16 ++++- Src/DBIO.UXMLDataIO.pas | 14 ++++ 6 files changed, 219 insertions(+), 3 deletions(-) diff --git a/Src/DB.IO.DataFormat.Native.pas b/Src/DB.IO.DataFormat.Native.pas index 50e72a423..064717021 100644 --- a/Src/DB.IO.DataFormat.Native.pas +++ b/Src/DB.IO.DataFormat.Native.pas @@ -307,6 +307,12 @@ TNativeDataReader = class sealed(TNativeDataRW, IDataReader) /// /// Method of IDataReader. function GetSnippetUnits(const SnippetKey: string): IStringList; + + /// Gets the collection's meta data. + /// TMetaData. The required meta data. Will be null if + /// is no meta data. + /// Method of IDataReader. + function GetMetaData: TMetaData; end; /// Class that performs the low level writing of collection data in @@ -479,6 +485,7 @@ implementation sBadKind = 'Missing or invalid snippet kind for snippet "%s"'; sSnippetNotFound = 'Can''t find reference to snippet key "%s" in XML file'; sBadTestInfo = 'Invalid test information for snippet "%s"'; + sMissingLicenseText = 'License text file "%s" is missing'; { TNativeDataRW } @@ -654,6 +661,63 @@ function TNativeDataReader.GetEnclosedListItems(const AParentNode: IXMLNode; Result.Add(ItemNode.Text); end; +function TNativeDataReader.GetMetaData: TMetaData; +var + RootNode: IXMLNode; + LicenseNode: IXMLNode; + CopyrightNode: IXMLNode; + LicenseTextFileName: string; + LicenseText: string; +begin + Result := TMetaData.Create([ + TMetaDataCap.License, TMetaDataCap.Copyright, TMetaDataCap.Acknowledgements + ]); + + LicenseNode := XMLDoc.FindNode(RootNodeName + '\' + LicenseNodeName); + if Assigned(LicenseNode) then + begin + LicenseTextFileName := LicenseNode.Attributes[LicenseNodeLicenseFileAttr]; + if (LicenseTextFileName <> '') then + begin + if not TFile.Exists(FilePath(LicenseTextFileName)) then + raise EDataIO.CreateFmt(sMissingLicenseText, [LicenseTextFileName]); + LicenseText := TFileIO.ReadAllText( + FilePath(LicenseTextFileName), TEncoding.UTF8, False + ); + end + else + LicenseText := ''; + Result.LicenseInfo := TLicenseInfo.Create( + LicenseNode.Attributes[LicenseNodeNameAttr], + LicenseNode.Attributes[LicenseNodeSPDXAttr], + LicenseNode.Attributes[LicenseNodeURLAttr], + LicenseText + ); + end; + + CopyrightNode := XMLDoc.FindNode(RootNodeName + '\' + CopyrightNodeName); + if Assigned(CopyrightNode) then + begin + Result.CopyrightInfo := TCopyrightInfo.Create( + CopyrightNode.Attributes[CopyrightNodeDateAttr], + CopyrightNode.Attributes[CopyrightNodeHolderAttr], + CopyrightNode.Attributes[CopyrightNodeURLAttr], + GetEnclosedListItems( + CopyrightNode, + CopyrightContributorsListNodeName, + CopyrightContributorsListItemNodeName + ) + ); + end; + + RootNode := XMLDoc.FindNode(RootNodeName); + if not Assigned(RootNode) then + raise EDataIO.Create(sNoRootNode); + Result.Acknowledgements := GetEnclosedListItems( + RootNode, AcknowledgementsListNodeName, AcknowledgementsListItemNodeName + ); +end; + function TNativeDataReader.GetSnippetDepends(const SnippetKey: string): IStringList; begin diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 005ff186c..3baacb4f0 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -593,6 +593,8 @@ procedure TDatabaseLoader.Load(const SnipList: TSnippetList; if IsNativeSnippet(Snippet) then LoadReferences(Snippet); end; + // Get collection's meta data + fCollection.MetaData := fReader.GetMetaData; except on E: Exception do HandleException(E); diff --git a/Src/DBIO.UFileIOIntf.pas b/Src/DBIO.UFileIOIntf.pas index 6cb46bd33..0adc83a3e 100644 --- a/Src/DBIO.UFileIOIntf.pas +++ b/Src/DBIO.UFileIOIntf.pas @@ -78,6 +78,11 @@ interface @param SnippetKey [in] Snippet's key. @return List of unit names. } + + /// Gets the collection's meta data. + /// TMetaData. The required meta data. May be null if meta + /// data is not supported or not present. + function GetMetaData: TMetaData; end; { diff --git a/Src/DBIO.UIniData.pas b/Src/DBIO.UIniData.pas index 9310b9f0f..60d36c195 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DBIO.UIniData.pas @@ -20,7 +20,9 @@ interface uses // Delphi + SysUtils, Classes, + Types, Generics.Collections, Generics.Defaults, IniFiles, @@ -31,7 +33,8 @@ interface DB.USnippet, DBIO.UFileIOIntf, UIStringList, - UMainDBFileReader; + UMainDBFileReader, + UVersionInfo; type @@ -118,6 +121,8 @@ TIniFileCache = class(TObject) /// /// Exception object to be handled. procedure HandleCorruptDatabase(const EObj: TObject); + /// Returns encoding used by given meta file. + function GetFileEncoding(const FileName: string): TEncoding; /// /// Returns name of directory where the database is stored. /// @@ -126,6 +131,16 @@ TIniFileCache = class(TObject) /// Returns fully specified path to given file name. /// function DataFile(const FileName: string): string; + /// Checks if a given file exists in collection directory. + /// + function DataFileExists(const FileName: string): Boolean; + /// Reads all lines from given file and returns them as an array. + /// + /// FileName must contain no path information. + function ReadFileLines(const FileName: string): TStringDynArray; + /// Reads all text from given file and returns it. + /// FileName must contain no path information. + function ReadFileText(const FileName: string): string; /// /// Gets a list from ini file of all of items of a specified kind that are /// referenced by a snippet. @@ -206,6 +221,11 @@ TIniFileCache = class(TObject) /// string [in] Snippet's key. /// IStringList containing unit names. function GetSnippetUnits(const SnippetKey: string): IStringList; + /// Gets the collection's meta data. + /// TMetaData. The required meta data. Will be null if + /// is no meta data present. + /// Method of IDataReader. + function GetMetaData: TMetaData; end; /// Write a collection to disk in the DelphiDabbler Code Snippets @@ -401,13 +421,13 @@ implementation uses // Delphi - SysUtils, IOUtils, // Project Compilers.UGlobals, DB.USnippetKind, UComparers, UConsts, + UEncodings, UExceptions, UIniDataLoader, UIOUtils, @@ -421,12 +441,22 @@ implementation const // Name of master file that defines database cMasterFileName = 'categories.ini'; + // Names of meta data files VersionFileName = 'VERSION'; LicenseFileName = 'LICENSE'; LicenseInfoFileName = 'LICENSE-INFO'; ContributorsFileName = 'CONTRIBUTORS'; AcknowledgementsFileName = 'TESTERS'; + + // Names of keys in license info file + LicenseInfoLicenseNameKey = 'LicenseName'; + LicenseInfoLicenseSPDXKey = 'LicenseSPDX'; + LicenseInfoLicenseURLKey = 'LicenseURL'; + LicenseInfoCopyrightDateKey = 'CopyrightDate'; + LicenseInfoCopyrightHolderKey = 'CopyrightHolder'; + LicenseInfoCopyrightHolderURLKey = 'CopyrightHolderURL'; + // Names of values in categories ini file cMasterIniName = 'Ini'; // name of category ini file cMasterDescName = 'Desc'; // category description @@ -505,6 +535,11 @@ function TIniDataReader.DataFile(const FileName: string): string; Result := IncludeTrailingPathDelimiter(DataDir) + FileName; end; +function TIniDataReader.DataFileExists(const FileName: string): Boolean; +begin + Result := TFile.Exists(DataFile(FileName), False); +end; + destructor TIniDataReader.Destroy; begin fFileReader.Free; @@ -558,6 +593,60 @@ function TIniDataReader.GetCatSnippets(const CatID: string): IStringList; end; end; +function TIniDataReader.GetFileEncoding(const FileName: string): TEncoding; +begin + // Old v1 database meta files may be in the system default encodings, v1 and + // all v2 and later use UTF-8 with BOM. + if TFileIO.CheckBOM(DataFile(FileName), TEncoding.UTF8) then + Result := TEncoding.UTF8 + else + Result := TEncoding.Default; +end; + +function TIniDataReader.GetMetaData: TMetaData; +var + SL: TStringList; + LicenseText: string; + LicenseFileInfo: TStringDynArray; + Contributors: IStringList; + VerStr: string; + Version: TVersionNumber; +begin + VerStr := StrTrim(ReadFileText(VersionFileName)); + if not TVersionNumber.TryStrToVersionNumber(VerStr, Version) then + Version := TVersionNumber.Nul; + LicenseText := StrTrimRight(ReadFileText(LicenseFileName)); + LicenseFileInfo := ReadFileLines(LicenseInfoFileName); + Contributors := TIStringList.Create(ReadFileLines(ContributorsFileName)); + + Result := TMetaData.Create([ + TMetaDataCap.Version, TMetaDataCap.License, TMetaDataCap.Copyright, + TMetaDataCap.Acknowledgements + ]); + Result.Version := Version; + SL := TStringList.Create; + try + StrArrayToStrList(LicenseFileInfo, SL); + Result.LicenseInfo := TLicenseInfo.Create( + SL.Values[LicenseInfoLicenseNameKey], + SL.Values[LicenseInfoLicenseSPDXKey], + SL.Values[LicenseInfoLicenseURLKey], + LicenseText + ); + Result.CopyrightInfo := TCopyrightInfo.Create( + SL.Values[LicenseInfoCopyrightDateKey], + SL.Values[LicenseInfoCopyrightHolderKey], + SL.Values[LicenseInfoCopyrightHolderURLKey], + Contributors + ); + finally + SL.Free; + end; + Result.Acknowledgements := TIStringList.Create( + ReadFileLines(AcknowledgementsFileName) + ); +end; + function TIniDataReader.GetSnippetDepends(const SnippetKey: string): IStringList; begin @@ -799,6 +888,32 @@ function TIniDataReader.MasterFileName: string; Result := DataFile(cMasterFileName); end; +function TIniDataReader.ReadFileLines(const FileName: string): TStringDynArray; +var + Encoding: TEncoding; +begin + if not DataFileExists(FileName) then + begin + SetLength(Result, 0); + Exit; + end; + Encoding := GetFileEncoding(FileName); + try + Result := TFileIO.ReadAllLines(DataFile(FileName), Encoding, True); + finally + TEncodingHelper.FreeEncoding(Encoding); + end; +end; + +function TIniDataReader.ReadFileText(const FileName: string): string; +begin + if not DataFileExists(FileName) then + Exit(''); + Result := TFileIO.ReadAllText( + DataFile(FileName), GetFileEncoding(FileName), True + ); +end; + function TIniDataReader.SnippetToCat(const SnippetKey: string): string; var CatIdx: Integer; // index of category in category list for this snippet @@ -888,6 +1003,8 @@ procedure TIniDataWriter.Initialise; // Delete current ini and data files // (don't delete special files: CONTRIBUTORS, LICENSE, LICENSE-INFO, // TESTERS, VERSION). + {TODO -cVault: Is it now safe to delete the special files, since we now + write these files.} DeleteFiles(fOutDir, '*.dat'); DeleteFiles(fOutDir, '*.ini'); diff --git a/Src/DBIO.UNulDataReader.pas b/Src/DBIO.UNulDataReader.pas index fff3aedf5..9f3de1043 100644 --- a/Src/DBIO.UNulDataReader.pas +++ b/Src/DBIO.UNulDataReader.pas @@ -17,7 +17,11 @@ interface uses // Project - DB.UCategory, DB.USnippet, DBIO.UFileIOIntf, UIStringList; + DB.MetaData, + DB.UCategory, + DB.USnippet, + DBIO.UFileIOIntf, + UIStringList; type @@ -72,6 +76,11 @@ TNulDataReader = class(TInterfacedObject, @param SnippetKey [in] Key of required snippet. @return Empty unit name list. } + + /// Gets the collection's meta data. + /// TMetaData. Null value. + /// Method of IDataReader. + function GetMetaData: TMetaData; end; @@ -116,6 +125,11 @@ function TNulDataReader.GetCatSnippets(const CatID: string): IStringList; Result := TIStringList.Create; end; +function TNulDataReader.GetMetaData: TMetaData; +begin + Result := TMetaData.CreateNull; +end; + function TNulDataReader.GetSnippetDepends(const SnippetKey: string): IStringList; {Gets list of all snippets on which a given snippet depends. diff --git a/Src/DBIO.UXMLDataIO.pas b/Src/DBIO.UXMLDataIO.pas index c1ff21f4b..88ff92dea 100644 --- a/Src/DBIO.UXMLDataIO.pas +++ b/Src/DBIO.UXMLDataIO.pas @@ -155,6 +155,14 @@ TXMLDataReader = class(TXMLDataIO, @param SnippetKey [in] Key of required snippet. @return List of unit names. } + + /// Gets the collection's meta data. + /// TMetaData. Null value. + /// + /// Meta data is not supported by the data format. + /// Method of IDataReader. + /// + function GetMetaData: TMetaData; end; { @@ -512,6 +520,12 @@ function TXMLDataReader.GetCatSnippets(const CatID: string): IStringList; end; end; +function TXMLDataReader.GetMetaData: TMetaData; +begin + // Meta data not supported by this data format + Result := TMetaData.CreateNull; +end; + function TXMLDataReader.GetSnippetDepends(const SnippetKey: string): IStringList; {Get list of all snippets on which a given snippet depends. From 3ba15b79fae6d362f36321ce01be9e018c9ac0d6 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 2 Mar 2025 10:58:25 +0000 Subject: [PATCH 140/222] Refactor TIniDataWriter.WriteMetaData Replaced literal key names used in license info file with the key name constants that are used when reading the meta data. Minor mods to other code in the method. --- Src/DBIO.UIniData.pas | 51 +++++++++++++++++++------------------------ 1 file changed, 23 insertions(+), 28 deletions(-) diff --git a/Src/DBIO.UIniData.pas b/Src/DBIO.UIniData.pas index 60d36c195..44c30de84 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DBIO.UIniData.pas @@ -1052,39 +1052,34 @@ procedure TIniDataWriter.WriteCatSnippets(const CatID: string; end; procedure TIniDataWriter.WriteMetaData(const AMetaData: TMetaData); +var + VersionStr: string; + KVPairs: TStringList; + LicenseInfo: IStringList; begin - WriteTextFile( - VersionFileName, - Format( - '%0:d.%1:d.%2:d', - [AMetaData.Version.V1, AMetaData.Version.V2, AMetaData.Version.V3] - ) + VersionStr := Format( + '%0:d.%1:d.%2:d', + [AMetaData.Version.V1, AMetaData.Version.V2, AMetaData.Version.V3] ); + KVPairs := TStringList.Create; + try + KVPairs.Values[LicenseInfoLicenseNameKey] := AMetaData.LicenseInfo.Name; + KVPairs.Values[LicenseInfoLicenseSPDXKey] := AMetaData.LicenseInfo.SPDX; + KVPairs.Values[LicenseInfoLicenseURLKey] := AMetaData.LicenseInfo.URL; + KVPairs.Values[LicenseInfoCopyrightDateKey] := AMetaData.CopyrightInfo.Date; + KVPairs.Values[LicenseInfoCopyrightHolderKey] := + AMetaData.CopyrightInfo.Holder; + KVPairs.Values[LicenseInfoCopyrightHolderURLKey] := + AMetaData.CopyrightInfo.HolderURL; + LicenseInfo := TIStringList.Create(KVPairs); + finally + KVPairs.Free; + end; + WriteTextFile(VersionFileName, VersionStr); WriteTextFile(LicenseFileName, AMetaData.LicenseInfo.Text); - - WriteTextFile( - LicenseInfoFileName, - Format( - 'LicenseName=%0:s' + EOL + - 'LicenseSPDX=%1:s' + EOL + - 'LicenseURL=%2:s' + EOL + - 'CopyrightDate=%3:s' + EOL + - 'CopyrightHolder=%4:s' + EOL + - 'CopyrightHolderURL=%5:s' + EOL, - [ - AMetaData.LicenseInfo.Name, - AMetaData.LicenseInfo.SPDX, - AMetaData.LicenseInfo.URL, - AMetaData.CopyrightInfo.Date, - AMetaData.CopyrightInfo.Holder, - AMetaData.CopyrightInfo.HolderURL - ] - ) - ); - + WriteTextFile(LicenseInfoFileName, LicenseInfo); WriteTextFile(ContributorsFileName, AMetaData.CopyrightInfo.Contributors); - WriteTextFile(AcknowledgementsFileName, AMetaData.Acknowledgements); end; From 5b4c177dad2a77fda08781f2cb0f597bd66594ed Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 2 Mar 2025 17:40:52 +0000 Subject: [PATCH 141/222] Convert TCollection from record to class This was done to make it easier to store meta data in the collection contained in TCollections object when reading meta data from storage. Updated TCollections to free contained TCollection object when they are updated in place, deleted and when TCollections itself is finalised. --- Src/DB.UCollections.pas | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index ea1777a8a..00f2f9ab1 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -64,7 +64,7 @@ TComparer = class(TInterfacedObject, ECollectionID = class(ECodeSnip); - TCollection = record + TCollection = class strict private var fUID: TCollectionID; @@ -116,6 +116,7 @@ TCollections = class sealed(TSingleton) var fItems: TList; function GetItem(const Idx: Integer): TCollection; + procedure DoUpdate(const Idx: Integer; const ACollection: TCollection); class function GetInstance: TCollections; static; strict protected procedure Initialize; override; @@ -226,11 +227,15 @@ procedure TCollections.AddOrUpdate(const ACollection: TCollection); if Idx < 0 then fItems.Add(ACollection) else - fItems[Idx] := ACollection; + DoUpdate(Idx, ACollection); end; procedure TCollections.Clear; +var + Idx: Integer; begin + for Idx := Pred(fItems.Count) downto 0 do + DoUpdate(Idx, nil); // frees and nils item with given index fItems.Clear; end; @@ -270,12 +275,26 @@ procedure TCollections.Delete(const AUID: TCollectionID); raise EArgumentException.Create(sCantDelete); Idx := IndexOfID(AUID); if Idx >= 0 then + begin + DoUpdate(Idx, nil); // frees and nils item with given index fItems.Delete(Idx); + end; +end; + +procedure TCollections.DoUpdate(const Idx: Integer; + const ACollection: TCollection); +var + OldEntry: TCollection; +begin + OldEntry := fItems[Idx]; + fItems[Idx] := ACollection; + OldEntry.Free; end; procedure TCollections.Finalize; begin Save; + Clear; fItems.Free; end; @@ -357,7 +376,7 @@ procedure TCollections.Update(const ACollection: TCollection); begin Idx := IndexOfID(ACollection.UID); if Idx >= 0 then - fItems[Idx] := ACollection; + DoUpdate(Idx, ACollection); end; { TCollectionID } From 13129f2cc1f1498edc6eba9f175139859bd849ed Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 2 Mar 2025 17:47:50 +0000 Subject: [PATCH 142/222] Add IsNull methods to TLicenseInfo & TCopyrightInfo --- Src/DB.MetaData.pas | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/Src/DB.MetaData.pas b/Src/DB.MetaData.pas index 1860ba1ab..36679cd7d 100644 --- a/Src/DB.MetaData.pas +++ b/Src/DB.MetaData.pas @@ -64,6 +64,11 @@ TLicenseInfo = record /// Returns a deep copy of this record. function Clone: TLicenseInfo; + /// Checks if the record is null. + /// A null record is one where Name, SPDX, + /// URL and Text properties are all empty strings. + function IsNull: Boolean; + /// Name of license. property Name: string read fName; @@ -113,6 +118,12 @@ TCopyrightInfo = record /// Returns a deep copy of this record. function Clone: TCopyrightInfo; + /// Checks if the record is null. + /// A null record is one where Date, Holder and + /// HolderURL properties are empty strings and Contributors + /// list is empty. + function IsNull: Boolean; + /// Copyright date. /// May be a single year or a range: e.g. 2020 or 2012-2016. /// @@ -227,6 +238,12 @@ class function TLicenseInfo.CreateNull: TLicenseInfo; Result := TLicenseInfo.Create('', '', '', ''); end; +function TLicenseInfo.IsNull: Boolean; +begin + Result := StrIsEmpty(fName) and StrIsEmpty(fSPDX) and StrIsEmpty(fURL) + and StrIsEmpty(fText); +end; + function TLicenseInfo.NameWithURL: string; begin Result := fName; @@ -263,6 +280,12 @@ function TCopyrightInfo.GetContributors: IStringList; Result := TIStringList.Create(fContributors); end; +function TCopyrightInfo.IsNull: Boolean; +begin + Result := StrIsEmpty(fDate) and StrIsEmpty(fHolder) and StrIsEmpty(fHolderURL) + and (fContributors.Count = 0); +end; + function TCopyrightInfo.ToString: string; resourcestring sCopyright = 'Copyright'; From d4c40d560ffc6fd212371776dbca43bb4dc26466 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 2 Mar 2025 17:50:02 +0000 Subject: [PATCH 143/222] Add new ctor to TVersionNumber This new constructor takes four parameters that are the four parts of the version number. --- Src/UVersionInfo.pas | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/Src/UVersionInfo.pas b/Src/UVersionInfo.pas index c74fbdc01..9e6e33b98 100644 --- a/Src/UVersionInfo.pas +++ b/Src/UVersionInfo.pas @@ -49,6 +49,10 @@ TVersionNumber = record V2: Word; // Minor version number V3: Word; // Revision version number V4: Word; // Build number + + /// Creates an instance of the record with the given version + /// numbers. + constructor Create(const AV1, AV2, AV3, AV4: Word); /// Checks if this version number is Null. /// Boolean. True if null, False otherwise. function IsNull: Boolean; @@ -277,6 +281,14 @@ class function TVersionInfo.SpecialBuildStr: string; { TVersionNumber } +constructor TVersionNumber.Create(const AV1, AV2, AV3, AV4: Word); +begin + V1 := AV1; + V2 := AV2; + V3 := AV3; + V4 := AV4; +end; + class operator TVersionNumber.Equal(Ver1, Ver2: TVersionNumber): Boolean; {Operator overload that compares two version numbers to check for equality. @param Ver1 [in] First version number. From 55dd0e4475a70dea19007baee2f143f5770f3753 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 2 Mar 2025 18:00:19 +0000 Subject: [PATCH 144/222] Update TIniDataReader to validate version Changed to read and validate version number in constructor. Can detect v1 and later formats but only supports v2.x.x --- Src/DBIO.UIniData.pas | 56 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 49 insertions(+), 7 deletions(-) diff --git a/Src/DBIO.UIniData.pas b/Src/DBIO.UIniData.pas index 44c30de84..f95a2cdcd 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DBIO.UIniData.pas @@ -92,10 +92,20 @@ TIniFileCache = class(TObject) fIniCache: TIniFileCache; /// Reads DB files using correct encoding. fFileReader: TMainDBFileReader; + /// Data format version number. + fVersion: TVersionNumber; + const + SupportedMajorVersion = 2; + strict private /// /// Returns fully specified name of database master file. /// function MasterFileName: string; + /// Reads data format version from file. + /// Stores result in fVersion. Detects DCSC versions 1 and + /// later. fVersion is set to null if the version can't be + /// determined. + procedure ReadVersionNumber; /// /// Returns ID of category associated with a snippet. /// @@ -442,13 +452,18 @@ implementation // Name of master file that defines database cMasterFileName = 'categories.ini'; - // Names of meta data files + // Names of v2 meta data files VersionFileName = 'VERSION'; LicenseFileName = 'LICENSE'; LicenseInfoFileName = 'LICENSE-INFO'; ContributorsFileName = 'CONTRIBUTORS'; AcknowledgementsFileName = 'TESTERS'; + // Names of v1 meta data files + ContributorsFileNameV1 = 'contrib.txt'; + AcknowledgementsFileNameV1 = 'testers.txt'; + + // Names of keys in license info file LicenseInfoLicenseNameKey = 'LicenseName'; LicenseInfoLicenseSPDXKey = 'LicenseSPDX'; @@ -500,6 +515,10 @@ class function TIniDataReader.CommaStrToStrings( end; constructor TIniDataReader.Create(const DBDir: string); +resourcestring + // Error messages + sVersionNotSpecified = 'Format version number not specified'; + sVersionNotSupported = 'Format version %s is not supported'; begin inherited Create; fDBDir := DBDir; @@ -509,6 +528,11 @@ constructor TIniDataReader.Create(const DBDir: string); fFileReader := TMainDBFileReader.Create(MasterFileName); fIniCache := TIniFileCache.Create(fFileReader); try + ReadVersionNumber; + if fVersion.IsNull then + raise EDataIO.Create(sVersionNotSpecified); + if fVersion.V1 <> SupportedMajorVersion then + raise EDataIO.CreateFmt(sVersionNotSupported, [string(fVersion)]); fMasterIni := TDatabaseIniFile.Create(fFileReader, MasterFileName); fCatIDs := TStringList.Create; fSnippetCatMap := TSnippetCatMap.Create(TTextEqualityComparer.Create); @@ -609,12 +633,8 @@ function TIniDataReader.GetMetaData: TMetaData; LicenseText: string; LicenseFileInfo: TStringDynArray; Contributors: IStringList; - VerStr: string; - Version: TVersionNumber; begin - VerStr := StrTrim(ReadFileText(VersionFileName)); - if not TVersionNumber.TryStrToVersionNumber(VerStr, Version) then - Version := TVersionNumber.Nul; + LicenseText := StrTrimRight(ReadFileText(LicenseFileName)); LicenseFileInfo := ReadFileLines(LicenseInfoFileName); Contributors := TIStringList.Create(ReadFileLines(ContributorsFileName)); @@ -623,7 +643,7 @@ function TIniDataReader.GetMetaData: TMetaData; TMetaDataCap.Version, TMetaDataCap.License, TMetaDataCap.Copyright, TMetaDataCap.Acknowledgements ]); - Result.Version := Version; + Result.Version := fVersion; // this was read in constructor SL := TStringList.Create; try StrArrayToStrList(LicenseFileInfo, SL); @@ -914,6 +934,28 @@ function TIniDataReader.ReadFileText(const FileName: string): string; ); end; +procedure TIniDataReader.ReadVersionNumber; +var + VersionStr: string; +begin + if DataFileExists(VersionFileName) then + begin + // Version file exists. Read and parse it. Set to null if invalid + VersionStr := StrTrim(ReadFileText(VersionFileName)); + if not TVersionNumber.TryStrToVersionNumber(VersionStr, fVersion) then + fVersion := TVersionNumber.Nul; + end + else + begin + // No version file. Check if v1 present. Set to null if v1 not detected + if DataFileExists(ContributorsFileNameV1) + and DataFileExists(AcknowledgementsFileNameV1) then + fVersion := TVersionNumber.Create(1, 0, 0, 0) + else + fVersion := TVersionNumber.Nul; + end; +end; + function TIniDataReader.SnippetToCat(const SnippetKey: string): string; var CatIdx: Integer; // index of category in category list for this snippet From b647792caf6398dd49106e60e9110c063fad229a Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 2 Mar 2025 19:15:26 +0000 Subject: [PATCH 145/222] Change how About box displays collection metadata The about box now gets meta data from a collection's MetaData property rather than from IDBMetaData read on demand. This removes dependency on DB.UMetaData and DBIO.MetaData.DCSC units and uses DB.MetaData instead. Also changed how metadata is formatted for display. The display now treats missing metadata items more inteligently. --- Src/FmAboutDlg.pas | 131 ++++++++++++++++++++++++++++----------------- 1 file changed, 81 insertions(+), 50 deletions(-) diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index b470aecc3..e3c2fcee7 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -27,8 +27,8 @@ interface Generics.Collections, // Project Browser.UHTMLEvents, + DB.MetaData, DB.UCollections, - DB.UMetaData, FmGenericViewDlg, FrBrowserBase, FrHTMLDlg, @@ -334,89 +334,120 @@ procedure TAboutDlg.ConfigForm; end; procedure TAboutDlg.DisplayCollectionInfo(ACollection: TCollection); +var + HasEntries: Boolean; - function AddHeading(const AHeading: string): TTreeNode; - begin - Result := tvCollectionInfo.Items.AddChild(nil, AHeading); - end; - - procedure AddChild(const AParentNode: TTreeNode; const AData: string); - begin - tvCollectionInfo.Items.AddChild(AParentNode, AData); - end; - - procedure AddItem(const AHeading, AData: string); - var - HeadingNode: TTreeNode; + function AddChild(const AParentNode: TTreeNode; const AData: string): + TTreeNode; begin - HeadingNode := AddHeading(AHeading); - AddChild(HeadingNode, AData); + Result := tvCollectionInfo.Items.AddChild(AParentNode, AData); + HasEntries := True; end; - procedure AddItems(const AHeading: string; const AData: IStringList); + procedure AddChildren(const AParentNode: TTreeNode; const AData: IStringList); var - HeadingNode: TTreeNode; DataItem: string; begin - HeadingNode := AddHeading(AHeading); for DataItem in AData do - AddChild(HeadingNode, DataItem); + AddChild(AParentNode, DataItem); end; var - MetaData: IDBMetaData; - Capabilities: TMetaDataCapabilities; + MetaData: TMetaData; + Capabilities: TMetaDataCaps; HeadingNode: TTreeNode; + SubheadingNode: TTreeNode; resourcestring sVersionHeading = 'Version'; sLicenseHeading = 'License'; sCopyrightHeading = 'Copyright'; sContributorsHeading = 'Contributors'; - sTestersHeading = 'Testers'; + sAcknowledgementsHeading = 'Acknowledgements'; sNoMetaData = 'No information available for this collection.'; + sNotAvailable = 'Not specified'; + sNone = 'None'; begin tvCollectionInfo.Items.BeginUpdate; try tvCollectionInfo.Items.Clear; - MetaData := TMetaDataFactory.CreateInstance(ACollection.Storage); - Capabilities := MetaData.GetCapabilities; + HasEntries := False; + MetaData := ACollection.MetaData; + Capabilities := MetaData.Capabilities; + if Capabilities <> [] then begin - if mdcVersion in Capabilities then - AddItem(sVersionHeading, MetaData.GetVersion); - if mdcLicense in Capabilities then + + if TMetaDataCap.Version in Capabilities then begin - HeadingNode := AddHeading(sLicenseHeading); - AddChild( - HeadingNode, - StrIf( - MetaData.GetLicenseInfo.Name <> '', - MetaData.GetLicenseInfo.Name, - MetaData.GetLicenseInfo.SPDX - ) - ); - AddChild(HeadingNode, MetaData.GetLicenseInfo.URL); + HeadingNode := AddChild(nil, sVersionHeading); + if not MetaData.Version.IsNull then + AddChild(HeadingNode, MetaData.Version) + else + AddChild(HeadingNode, sNotAvailable); end; - if mdcCopyright in Capabilities then + + if (TMetaDataCap.License in Capabilities) then begin - HeadingNode := AddHeading(sCopyrightHeading); - AddChild(HeadingNode, MetaData.GetCopyrightInfo.Date); - AddChild(HeadingNode, MetaData.GetCopyrightInfo.Holder); - AddChild(HeadingNode, MetaData.GetCopyrightInfo.HolderURL); + HeadingNode := AddChild(nil, sLicenseHeading); + if not MetaData.LicenseInfo.IsNull then + begin + if not StrIsEmpty(MetaData.LicenseInfo.Name) + and not StrIsEmpty(MetaData.LicenseInfo.SPDX) then + AddChild( + HeadingNode, + StrIf( + MetaData.LicenseInfo.Name <> '', + MetaData.LicenseInfo.Name, + MetaData.LicenseInfo.SPDX + ) + ); + if not StrIsEmpty(MetaData.LicenseInfo.URL) then + AddChild(HeadingNode, MetaData.LicenseInfo.URL); + end + else + AddChild(HeadingNode, sNone); end; - if mdcContributors in Capabilities then + + if TMetaDataCap.Copyright in Capabilities then begin - AddItems(sContributorsHeading, MetaData.GetContributors); + HeadingNode := AddChild(nil, sCopyrightHeading); + if not MetaData.CopyrightInfo.IsNull then + begin + if not StrIsEmpty(MetaData.CopyrightInfo.Date) then + AddChild(HeadingNode, MetaData.CopyrightInfo.Date); + if not StrIsEmpty(MetaData.CopyrightInfo.Holder) then + AddChild(HeadingNode, MetaData.CopyrightInfo.Holder); + if not StrIsEmpty(MetaData.CopyrightInfo.HolderURL) then + AddChild(HeadingNode, MetaData.CopyrightInfo.HolderURL); + if MetaData.CopyrightInfo.Contributors.Count > 0 then + begin + SubheadingNode := AddChild(HeadingNode, sContributorsHeading); + AddChildren(SubheadingNode, MetaData.CopyrightInfo.Contributors); + end; + end + else + AddChild(HeadingNode, sNone); + end; + + if TMetaDataCap.Acknowledgements in Capabilities then + begin + HeadingNode := AddChild(nil, sAcknowledgementsHeading); + if MetaData.Acknowledgements.Count > 0 then + AddChildren(HeadingNode, MetaData.Acknowledgements) + else + AddChild(HeadingNode, sNone); end; - if mdcTesters in Capabilities then - AddItems(sTestersHeading, MetaData.GetTesters); end + else + AddChild(nil, sNoMetaData); + + if HasEntries then begin - AddHeading(sNoMetaData); + tvCollectionInfo.FullExpand; + tvCollectionInfo.Items[0].MakeVisible; end; - tvCollectionInfo.FullExpand; - tvCollectionInfo.Items[0].MakeVisible; + finally tvCollectionInfo.Items.EndUpdate; end; From 452881df9b17af641c58a9fe28cade3dfe4c9fe9 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 2 Mar 2025 19:41:09 +0000 Subject: [PATCH 146/222] Change how TDBUpdateMgr validates updated DCSC files Rather than use IDBMetaData the TDBUpdateMgr.ValidateUpdate now reads the DCSC collection's VERSION file and uses its contents to validate. The code now only accepts DCSC v2 files. This change removes dependency on DB.UMetaData and DBIO.MetaData.DCSC units. --- Src/UDBUpdateMgr.pas | 40 ++++++++++++++++++++++++---------------- 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/Src/UDBUpdateMgr.pas b/Src/UDBUpdateMgr.pas index 4119d9484..ea323882e 100644 --- a/Src/UDBUpdateMgr.pas +++ b/Src/UDBUpdateMgr.pas @@ -99,12 +99,12 @@ implementation // Delphi IOUtils, // Project - DB.UMetaData, - DBIO.MetaData.DCSC, UAppInfo, UFileUpdater, + UIOUtils, UStrUtils, - UUtils; + UUtils, + UVersionInfo; { TDBUpdateMgr } @@ -159,9 +159,14 @@ class procedure TDBUpdateMgr.ValidateUpdate(const UpdateDir: string); sUnsupportedDatabaseError = 'Database in "%0:s" is version %1:s. This ' + 'version is not currently supported by CodeSnip.'; sCurruptDatabaseError = 'The update database in "%s" is corrupt'; +const + VersionFileName = 'VERSION'; var Dir: string; - MetaData: IDBMetaData; + VersionFilePath: string; + VersionStr: string; + Version: TVersionNumber; + begin Assert(UpdateDir <> '', ClassName + '.ValidateUpdate: UpdateDir cannot be empty string'); @@ -192,23 +197,26 @@ class procedure TDBUpdateMgr.ValidateUpdate(const UpdateDir: string); if TDirectory.IsEmpty(Dir) then raise EDBUpdateValidationError.CreateFmt(sEmptyDirError, [Dir]); - // Check contents - MetaData := TUpdateDBMetaData.Create(Dir); + // Version file must exist + VersionFilePath := TPath.Combine(Dir, VersionFileName); + if not TFile.Exists(TPath.Combine(Dir, VersionFilePath)) then + raise EDBUpdateValidationError.Create(sInvalidDatabaseError); - // check if data files are recognised as valid database - if not MetaData.IsRecognised then - raise EDBUpdateValidationError.CreateFmt(sUnrecognisedDatabaseError, [Dir]); + // Version file must contain a valid version string + VersionStr := TFileIO.ReadAllText(VersionFilePath, TEncoding.UTF8, True); + if not TVersionNumber.TryStrToVersionNumber(VersionStr, Version) then + raise EDBUpdateValidationError.CreateFmt( + sUnrecognisedDatabaseError, [Dir] + ); - // seems to be valid database: check if it's a supported version - if not MetaData.IsSupportedVersion then + // Version must be supported + if Version.V1 <> 2 then raise EDBUpdateValidationError.CreateFmt( - sUnsupportedDatabaseError, [Dir, string(MetaData.GetVersion)] + sUnsupportedDatabaseError, [Dir, string(Version)] ); - // database version supported: check if required meta data files and master db - // file are present - if MetaData.IsCorrupt - or not TFile.Exists(Dir + PathDelim + 'categories.ini', False) then + // Master db file must exist + if not TFile.Exists(Dir + PathDelim + 'categories.ini', False) then raise EDBUpdateValidationError.CreateFmt(sCurruptDatabaseError, [Dir]); end; From 1e5456eede6506ef775fbbe7b7a097e0548b20e7 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 2 Mar 2025 20:02:37 +0000 Subject: [PATCH 147/222] Change use of metadata in source code generation Changed how source code comments are generated in USaveUnitMgr, USnippetDoc and USnippetSourceGen units. Rather than use IDBMetaData now gets the relevant metadata from the appropriate collections' MetaData property. This change removes dependency on the DB.UMetaData and DBIO.MetaData.DCSC units in favour of DB.MetaData. Some minor cosmetic changes were made to the presentation of metadata. --- Src/USaveUnitMgr.pas | 24 +++++++++++++++--------- Src/USnippetDoc.pas | 19 ++++++++++--------- Src/USnippetSourceGen.pas | 18 ++++++++++-------- 3 files changed, 35 insertions(+), 26 deletions(-) diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index dd9ba3b7d..92debb94c 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -104,8 +104,9 @@ implementation SysUtils, // Project DB.DataFormats, - DB.UMetaData, + DB.MetaData, UAppInfo, + UStrUtils, UUtils; @@ -125,7 +126,7 @@ implementation sMainGenerator = 'This unit snippet was generated by %0:s %1:s on %2:s.'; sCollection = 'The code was sourced from the %s collection.'; sCollectionList = 'The code was sourced from the following collections:'; - sCollectionCredit = 'Collection "%0:s" is licensed under the %1:s.'; + sCollectionCredit = 'Collection "%0:s" is licensed under the %1:s'; // Output document title sDocTitle = 'Pascal unit generated by %s'; @@ -148,19 +149,24 @@ procedure TSaveUnitMgr.CheckFileName(const FileName: string; function TSaveUnitMgr.CreateHeaderComments: IStringList; {TODO -cRefactoring: This code has a lot in common with header comment - generator code in USnippetSourceGen - extract common code.} + generator code in USnippetSourceGen and in TSnippetDoc.CollectionInfo + - extract common code.} function CreditsLine(const ACollection: TCollection): string; var - DBMetaData: IDBMetaData; + MetaData: TMetaData; begin - DBMetaData := TMetaDataFactory.CreateInstance(ACollection.Storage); + MetaData := ACollection.MetaData; Result := ''; - if mdcLicense in DBMetaData.GetCapabilities then + if TMetaDataCap.License in MetaData.Capabilities then begin - Result := Result + DBMetaData.GetLicenseInfo.NameWithURL + '.'; - if (mdcCopyright in DBMetaData.GetCapabilities) then - Result := Result + ' ' + DBMetaData.GetCopyrightInfo.ToString + '.'; + Result := Result + StrMakeSentence(MetaData.LicenseInfo.NameWithURL); + end; + if TMetaDataCap.Copyright in MetaData.Capabilities then + begin + if not StrIsEmpty(Result) then + Result := Result + ' '; + Result := Result + StrMakeSentence(MetaData.CopyrightInfo.ToString); end; end; diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index 83b6a8640..0f19169e0 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -120,10 +120,9 @@ implementation // Project Compilers.UCompilers, DB.DataFormats, + DB.MetaData, DB.UMain, - DB.UMetaData, DB.USnippetKind, - DBIO.MetaData.DCSC, UStrUtils, UUrl; @@ -134,17 +133,19 @@ function TSnippetDoc.CollectionInfo(const ACollectionID: TCollectionID): string; resourcestring sCollectionInfo = 'A snippet from the "%s" collection.'; var - MetaData: IDBMetaData; + MetaData: TMetaData; Collection: TCollection; begin Collection := TCollections.Instance.GetCollection(ACollectionID); - Result := Format(sCollectionInfo, [Collection.Name]); - MetaData := TMetaDataFactory.CreateInstance(Collection.Storage); - if mdcLicense in MetaData.GetCapabilities then + MetaData := Collection.MetaData; + Result := ''; + if TMetaDataCap.License in MetaData.Capabilities then + Result := Result + StrMakeSentence(MetaData.LicenseInfo.NameWithURL); + if TMetaDataCap.Copyright in MetaData.Capabilities then begin - Result := Result + ' ' + MetaData.GetLicenseInfo.NameWithURL + '.'; - if (mdcCopyright in MetaData.GetCapabilities) then - Result := Result + ' ' + MetaData.GetCopyrightInfo.ToString + '.'; + if not StrIsEmpty(Result) then + Result := Result + ' '; + Result := Result + StrMakeSentence(MetaData.CopyrightInfo.ToString); end; end; diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index 388cac79e..e4b32be2f 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -20,8 +20,8 @@ interface // Delphi Generics.Collections, // Project + DB.MetaData, DB.UCollections, - DB.UMetaData, UBaseObjects, UIStringList, USourceGen, @@ -97,10 +97,10 @@ implementation DB.DataFormats, DB.USnippet, DB.USnippetKind, - DBIO.MetaData.DCSC, UConsts, UAppInfo, UQuery, + UStrUtils, UUtils; @@ -111,7 +111,7 @@ function TSnippetSourceGen.BuildHeaderComments: IStringList; @return String list containing comments. } var - DBMetaData: IDBMetaData; + MetaData: TMetaData; Collection: TCollection; Credits: string; resourcestring @@ -124,13 +124,15 @@ function TSnippetSourceGen.BuildHeaderComments: IStringList; function CreditsLine(const ACollection: TCollection): string; begin - DBMetaData := TMetaDataFactory.CreateInstance(ACollection.Storage); + MetaData := ACollection.MetaData; Result := ''; - if mdcLicense in DBMetaData.GetCapabilities then + if TMetaDataCap.License in MetaData.Capabilities then + Result := Result + StrMakeSentence(MetaData.LicenseInfo.NameWithURL); + if TMetaDataCap.Copyright in MetaData.Capabilities then begin - Result := Result + DBMetaData.GetLicenseInfo.NameWithURL + '.'; - if (mdcCopyright in DBMetaData.GetCapabilities) then - Result := Result + ' ' + DBMetaData.GetCopyrightInfo.ToString + '.'; + if not StrIsEmpty(Result) then + Result := Result + ' '; + Result := Result + StrMakeSentence(MetaData.CopyrightInfo.ToString); end; end; From 9f8a0e6c865151a2998b9a63b7c269408824cec2 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Sun, 2 Mar 2025 20:07:29 +0000 Subject: [PATCH 148/222] Remove unused metadata units from project The DB.UMetaData and DBIO.MetaData.DCSC units have been rendered redundant. In most cases they have been replaced by use of the DB.MetaData unit and the TCollection.MetaData property. In one case the units were replaced by custom code. --- Src/CodeSnip.dpr | 2 - Src/CodeSnip.dproj | 2 - Src/DB.UMetaData.pas | 447 -------------------- Src/DBIO.MetaData.DCSC.pas | 845 ------------------------------------- 4 files changed, 1296 deletions(-) delete mode 100644 Src/DB.UMetaData.pas delete mode 100644 Src/DBIO.MetaData.DCSC.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 8bdcb5f3b..d179cdb10 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -66,7 +66,6 @@ uses DB.UCategory in 'DB.UCategory.pas', DB.UDatabaseIO in 'DB.UDatabaseIO.pas', DB.UMain in 'DB.UMain.pas', - DB.UMetaData in 'DB.UMetaData.pas', DB.USnippet in 'DB.USnippet.pas', DB.USnippetKind in 'DB.USnippetKind.pas', DBIO.UFileIOIntf in 'DBIO.UFileIOIntf.pas', @@ -378,7 +377,6 @@ uses UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas', DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas', UCollectionListAdapter in 'UCollectionListAdapter.pas', - DBIO.MetaData.DCSC in 'DBIO.MetaData.DCSC.pas', FmCollectionBackup in 'FmCollectionBackup.pas' {CollectionBackupDlg}, DB.DataFormats in 'DB.DataFormats.pas', DB.IO.DataFormat.Native in 'DB.IO.DataFormat.Native.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 0b89e7d51..a08de9434 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -69,7 +69,6 @@ - @@ -584,7 +583,6 @@ -
CollectionBackupDlg
 diff --git a/Src/DB.UMetaData.pas b/Src/DB.UMetaData.pas deleted file mode 100644 index 0d0b6be76..000000000 --- a/Src/DB.UMetaData.pas +++ /dev/null @@ -1,447 +0,0 @@ -{ - * This Source Code Form is subject to the terms of the Mozilla Public License, - * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at https://mozilla.org/MPL/2.0/ - * - * Copyright (C) 2020-2021, Peter Johnson (gravatar.com/delphidabbler). - * - * Declares interface and defines records required to support collection - * metadata. -} - - -unit DB.UMetaData; - - -interface - - -uses - // Delphi - Generics.Collections, - // Project - DB.DataFormats, - UIStringList, - UVersionInfo; - - -type - - TMetaDataCapability = ( - mdcVersion, - mdcLicense, - mdcCopyright, - mdcContributors, - mdcTesters {TODO -cView: rename as mdcAcknowledgements} - ); - - TMetaDataCapabilities = set of TMetaDataCapability; - - /// Record providing information about a collection's license. - /// - TDBLicenseInfo = record - strict private - fName: string; - fSPDX: string; - fURL: string; - fText: string; - public - /// Record constructor: sets all fields of record. - /// Any or all parameters may be the empty string - constructor Create(const AName, ASPDX, AURL, AText: string); - - /// Creates and returns a null record with all fields set to the - /// empty string. - class function CreateNull: TDBLicenseInfo; static; - - /// Name of license. - property Name: string read fName; - - /// Open Source Initiative SPDX short idenitifier for licenses. - /// - /// If the license is not supported by the Open Source Initiative - /// then this property will be the empty string. - property SPDX: string read fSPDX; - - /// URL of license online. - /// Optional. - property URL: string read fURL; - - /// Full text of license. - property Text: string read fText; - - /// Returns a string containing license name followed by any URL - /// in parentheses. - /// If no URL is available then only the license name is returned. - /// - function NameWithURL: string; - end; - - /// Record providing informaton about a collection's copyright. - /// - TDBCopyrightInfo = record - strict private - fDate: string; - fHolder: string; - fHolderURL: string; - public - /// Record constructor: sets all fields of record. - /// Any or all parameters may be the empty string - constructor Create(const ADate, AHolder, AHolderURL: string); - /// Creates and returns a null record with all fields set to the - /// empty string. - class function CreateNull: TDBCopyrightInfo; static; - /// Copyright date. - /// May be a single year or a range: e.g. 2020 or 2012-2016. - /// - property Date: string read fDate; - /// Name of copyright holder. - property Holder: string read fHolder; - /// URL of main copyright holder. - /// Optional. - property HolderURL: string read fHolderURL; - /// Creates and returns a string representation of all the - /// non-empty fields of the record. - function ToString: string; - end; - - /// Interface that provides information about any meta data - /// supported by a collection. - IDBMetaData = interface(IInterface) - /// Returns information about what, if any, meta data is supported - /// by a collection. - function GetCapabilities: TMetaDataCapabilities; - /// Returns the collection's version number. - /// A null version number is returned if the collection does not - /// include Version in its capabilities. - function GetVersion: TVersionNumber; - /// Returns the collection's license information. - /// Return value is meaningless if the collection does not include - /// License in its capabilities. - function GetLicenseInfo: TDBLicenseInfo; - /// Returns the collection's copyright informatiom. - /// Return value is meaningless if the collection does not include - /// Copyright in its capabilities. - function GetCopyrightInfo: TDBCopyrightInfo; - /// Returns a list of contributors to the collection. - /// Return value is meaningless if the collection does not include - /// Contributors in its capabilities. - function GetContributors: IStringList; - /// Returns a list of testers of the collection. - /// Return value is meaningless if the collection does not include - /// Testers in its capabilities. - function GetTesters: IStringList; - /// Checks if meta data is recognised as belonging to a valid - /// collection, whether supported or not. - function IsRecognised: Boolean; - /// Checks if meta data is recognised as belonging to a supported - /// collection version. - function IsSupportedVersion: Boolean; - /// Checks if meta data is corrupt. - /// Should only be called if meta data belongs to a supported - /// collection. An exception should be raised if called on unsupported - /// versions. - function IsCorrupt: Boolean; - /// Refreshes the meta information by re-reading from collection - /// meta files. - procedure Refresh; - end; - - /// Base class for all classes that implement IDBMetaData - /// and can also be registered with TMetaDataFactory. - TRegisterableMetaData = class abstract(TInterfacedObject) - public - /// Creates an instance of a concrete descendant of this class. - /// - /// TCollection [in] Collection associated - /// with the meta data being created. - /// IDBMetaData. Required meta data object. - class function Instance(const AStorageDetails: TDataStorageDetails): - IDBMetaData; - virtual; abstract; - /// Gets the meta data capabilities for the collection data - /// format. - /// TMetaDataCapabilities. Required meta data capabilities. - /// - /// This method enables meta data capabilities to be obtained - /// without creating an instance of the object. - class function Capabilities: TMetaDataCapabilities; virtual; abstract; - /// Returns information about what, if any, meta data is supported - /// by a collection. - /// This method provides a means of accessing the data returned by - /// the Capabilities class method from IDBMetaData instances. - /// - function GetCapabilities: TMetaDataCapabilities; virtual; - end; - - TRegisterableMetaDataClass = class of TRegisterableMetaData; - - /// Advanced record manages the registration and creation of meta - /// data objects for different collection data formats. - TMetaDataFactory = record - strict private - class var - {TODO -Refactor: rename fCallbackMap since it does not contain callback, - but does contain class types.} - /// Map of collection format kinds to classes that implement the - /// format's meta data. - fCallbackMap: TDictionary; - public - class constructor Create; - class destructor Destroy; - /// Registers a class type that can create a meta data object for - /// a given collection data format kind. - /// TCollectionFormatKind [in] Collection data - /// format for which the meta data class is being registered. - /// TRegisterableMetaDataClass [in] Type of - /// class to create. - class procedure RegisterCreator(AFormat: TDataFormatKind; - AClass: TRegisterableMetaDataClass); static; - /// Creates a meta data object instance that can read a given - /// collection data format. - /// TCollection [in] Collection for which - /// meta data reader object is required. - /// IDBMetaData. Requested object. May be a null object if - /// no meta data class was registered for the data format associated with - /// ACollection. - class function CreateInstance(const AStorageDetails: TDataStorageDetails): - IDBMetaData; static; - /// Gets the meta data capabilities for a collection data format. - /// - /// TCollectionFormatKind [in] Collection data - /// format for which meta data capabilities are required. - /// TMetaDataCapabilities. Required meta data capabilities. - /// - class function CapabilitiesOf(const AFormat: TDataFormatKind): - TMetaDataCapabilities; static; - end; - -implementation - -uses - // Delphi - SysUtils, - Character, - // Project - UConsts, - UStrUtils; - -type - /// Implements a null, do nothing, meta data object. - /// Instance of this class are used when a collection format does - /// not support meta data. - TNullMetaData = class(TInterfacedObject, IDBMetaData) - public - /// Returns information about what, if any, meta data is supported - /// by a collection. - function GetCapabilities: TMetaDataCapabilities; - /// Returns the collection's version number. - /// A null version number is returned if the collection does not - /// include Version in its capabilities. - function GetVersion: TVersionNumber; - /// Returns the collection's license information. - /// Return value is meaningless if the collection does not include - /// License in its capabilities. - function GetLicenseInfo: TDBLicenseInfo; - /// Returns the collection's copyright informatiom. - /// Return value is meaningless if the collection does not include - /// Copyright in its capabilities. - function GetCopyrightInfo: TDBCopyrightInfo; - /// Returns a list of contributors to the collection. - /// Return value is meaningless if the collection does not include - /// Contributors in its capabilities. - function GetContributors: IStringList; - /// Returns a list of testers of the collection. - /// Return value is meaningless if the collection does not include - /// Testers in its capabilities. - function GetTesters: IStringList; - /// Checks if meta data is recognised as belonging to a valid - /// collection, whether supported or not. - function IsRecognised: Boolean; - /// Checks if meta data is recognised as belonging to a supported - /// collection version. - function IsSupportedVersion: Boolean; - /// Checks if meta data is corrupt. - /// Should only be called if meta data belongs to a supported - /// collection. An exception should be raised if called on unsupported - /// versions. - function IsCorrupt: Boolean; - /// Refreshes the meta information by re-reading from collection - /// meta files. - procedure Refresh; - end; - -{ TDBLicenseInfo } - -constructor TDBLicenseInfo.Create(const AName, ASPDX, AURL, AText: string); - - function StandardiseStr(const AStr: string): string; - begin - Result := StrCompressWhiteSpace( - StrReplaceChar( - AStr, - function(Ch: Char): Boolean - begin - Result := TCharacter.IsControl(Ch); - end, - ' ' - ) - ); - end; - -begin - fName := StandardiseStr(AName); - fSPDX := StandardiseStr(ASPDX); - fURL := StandardiseStr(AURL); - fText := StandardiseStr(AText); -end; - -class function TDBLicenseInfo.CreateNull: TDBLicenseInfo; -begin - Result := TDBLicenseInfo.Create('', '', '', ''); -end; - -function TDBLicenseInfo.NameWithURL: string; -begin - Result := fName; - if fURL <> '' then - Result := Result + ' (' + fURL + ')'; -end; - -{ TDBCopyrightInfo } - -constructor TDBCopyrightInfo.Create(const ADate, AHolder, AHolderURL: string); -begin - fDate := ADate; - fHolder := AHolder; - fHolderURL := AHolderURL; -end; - -class function TDBCopyrightInfo.CreateNull: TDBCopyrightInfo; -begin - Result := TDBCopyrightInfo.Create('', '', ''); -end; - -function TDBCopyrightInfo.ToString: string; -resourcestring - sCopyright = 'Copyright'; -begin - Result := ''; - if Date <> '' then - Result := Result + '(C) ' + Date; - if Holder <> '' then - begin - if Result <> '' then - Result := Result + ', '; - Result := Result + Holder; - end; - if HolderURL <> '' then - begin - if Result <> '' then - Result := Result + ', '; - Result := Result + HolderURL; - end; - if Result <> '' then - Result := sCopyright + ' ' + Result; -end; - -{ TRegisterableMetaData } - -function TRegisterableMetaData.GetCapabilities: TMetaDataCapabilities; -begin - Result := Capabilities; -end; - -{ TMetaDataFactory } - -class function TMetaDataFactory.CapabilitiesOf( - const AFormat: TDataFormatKind): TMetaDataCapabilities; -begin - if fCallbackMap.ContainsKey(AFormat) then - Result := fCallbackMap[AFormat].Capabilities - else - Result := []; -end; - -class constructor TMetaDataFactory.Create; -begin - fCallbackMap := TDictionary< - TDataFormatKind, TRegisterableMetaDataClass - >.Create; -end; - -class function TMetaDataFactory.CreateInstance( - const AStorageDetails: TDataStorageDetails): IDBMetaData; -begin - if fCallbackMap.ContainsKey(AStorageDetails.Format) then - Result := fCallbackMap[AStorageDetails.Format].Instance(AStorageDetails) - else - Result := TNullMetaData.Create; -end; - -class destructor TMetaDataFactory.Destroy; -begin - fCallBackMap.Free; -end; - -class procedure TMetaDataFactory.RegisterCreator( - AFormat: TDataFormatKind; AClass: TRegisterableMetaDataClass); -begin - fCallbackMap.AddOrSetValue(AFormat, AClass); -end; - -{ TNullMetaData } - -function TNullMetaData.GetCapabilities: TMetaDataCapabilities; -begin - Result := []; -end; - -function TNullMetaData.GetContributors: IStringList; -begin - Result := TIStringList.Create; -end; - -function TNullMetaData.GetCopyrightInfo: TDBCopyrightInfo; -begin - Result := TDBCopyrightInfo.CreateNull; -end; - -function TNullMetaData.GetLicenseInfo: TDBLicenseInfo; -begin - Result := TDBLicenseInfo.CreateNull; -end; - -function TNullMetaData.GetTesters: IStringList; -begin - Result := TIStringList.Create; -end; - -function TNullMetaData.GetVersion: TVersionNumber; -begin - Result := TVersionNumber.Nul; -end; - -function TNullMetaData.IsCorrupt: Boolean; -resourcestring - sNotSupportedError = 'Can''t call IDBMetaData.IsCorrupt for null meta data'; -begin - raise ENotSupportedException.Create(sNotSupportedError); -end; - -function TNullMetaData.IsRecognised: Boolean; -begin - Result := False; -end; - -function TNullMetaData.IsSupportedVersion: Boolean; -begin - Result := False; -end; - -procedure TNullMetaData.Refresh; -begin - // Do nothing -end; - -end. diff --git a/Src/DBIO.MetaData.DCSC.pas b/Src/DBIO.MetaData.DCSC.pas deleted file mode 100644 index 85052f55b..000000000 --- a/Src/DBIO.MetaData.DCSC.pas +++ /dev/null @@ -1,845 +0,0 @@ -{ - * This Source Code Form is subject to the terms of the Mozilla Public License, - * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at https://mozilla.org/MPL/2.0/ - * - * Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). - * - * Loads and vaildates meta data supported by the DelphiDabbler Code Snippets - * Collection. -} - - -unit DBIO.MetaData.DCSC; - -interface - -{TODO -cVault: Remove support for main database v1 (and perhaps v>2)} - -{ - Notes About Database Versions And Meta Files. - ============================================= - - Versions - -------- - - v1 of the Code Snippets Database was not considered to have a version number - until the arrival of v2. Therefore v1 did not have any means of identifying - its version number. Although the database format changed slightly over time - there is not enough historical information to identify different minor - releases, so all are considered to be v1.0.0.0 - - Database v2 has a VERSION file that specifies the version number as a dotted - quad, of the form v2.0.0.0. - - Note that semantic versioning is now being used so any database with major - version 2 will be backwards compatible with earlier v2 minor release. - - If a breaking change is introduced the major version will be bumped to v3 and - so on. - - Meta Files - ---------- - - Database v1 had only two meta files: - + contrib.txt - lists of contributors to the database, one per line - + testers.txt - lists of database testers, one per line - If those two files are present the database is assumed to be v1 - - Database v2 has the following meta files: - + VERSION - version number (v2.x.x.x) - + CONTRIBUTORS - lists of contributors to the database, one per line - + TESTERS - lists of database testers, one per line - + LICENSE - full text of the license that applies to the snippets - + LICENSE-INFO - furter information about the license - - For database v1 the license text, license information are hard-wired in the - absence of meta files. As noted above the version number is deduced. - - File encoding - ------------- - - All meta files are plain text. - - Early v1 database meta files were encoded in the system default encoding. - Later v1 databases encoded meta files in UTF-8. To distinguish between UTF-8 - and default encoded files the UTF-8 files use the UTF-8 preamble (BOM). - - v2 database meta files are all encoded in UTF-8 with preamble (BOM). - - Future major versions - --------------------- - - Future major database releases MUST include backwards compatibility with - earlier versions of CodeSnip in as much as those versions must be able to - easily detect and reject the format. - - To achieve this new major releases MUST include a VERSION file encoded in - UTF-8 with BOM. Existing code can detect and will reject any unsupported - version. - - CodeSnip support - ---------------- - - CodeSnip versions earlier than v4.16 are only ever delivered v1 database files - via their built in web update code. There is no way for these versions to - access v2 databases. - - CodeSnip from v4.16 get their main snippets database from files downloaded - manually. All such databases are v2. CodeSnip v4.16 also supports v1 format - because such a database may be resident on the user's computer at install - time. -} - - - -uses - // Project - SysUtils, - Types, - // VCL - DB.DataFormats, - DB.UMetaData, - UIStringList, - UStructs, - UVersionInfo; - - -const - DBValidVersions: TRange = (Min: 1; Max: 2); - -type - - /// Provides names of meta data files supported by various database - /// versions. - TDBMetaFileNames = record - public - const - ContributorsV1 = 'contrib.txt'; - TestersV1 = 'testers.txt'; - VersionV2AndLater = 'VERSION'; - LicenseV2 = 'LICENSE'; - LicenseInfoV2 = 'LICENSE-INFO'; - ContributorsV2 = 'CONTRIBUTORS'; - TestersV2 = 'TESTERS'; - end; - - /// Abstract base class for classes that access or emulate database - /// meta data files. - TDBMetaFiles = class abstract(TObject) - strict private - var - /// Directory of database for which meta data files are being - /// accessed. - fDBDir: string; - /// Returns encoding used by given meta file. - function GetFileEncoding(const FileName: TFileName): TEncoding; - strict protected - /// Makes a fully specified path to a given database file. - /// - /// FileName must contain no path information. - function MakePath(const FileName: string): string; - /// Checks if a given file exists in database directory. - function DBFileExists(const FileName: string): Boolean; - /// Reads all lines from given file and returns them as an array. - /// - /// FileName must contain no path information. - function ReadFileLines(const FileName: TFileName): TStringDynArray; - /// Reads all text from given file and returns it. - /// FileName must contain no path information. - function ReadFileText(const FileName: TFileName): string; - public - /// Constructs object that accesses meta data database files in - /// given directory. - constructor Create(const DBDir: string); - /// Returns text of the version file, or surrogate value. - /// - function Version: string; virtual; abstract; - /// Returns content license text file or surrogate value. - /// - function LicenseText: string; virtual; abstract; - /// Returns lines of license information file or surrogate value. - /// - function LicenseInfo: TStringDynArray; virtual; abstract; - /// Returns lines of contributors file or surrogate value. - /// - function Contributors: TStringDynArray; virtual; abstract; - /// Returns lines of testers file or surrogate value. - function Testers: TStringDynArray; virtual; abstract; - /// Checks if all the expected meta files are present. Returns - /// True if so or False if not. - /// ENotSupportedException must be raised if called on an - /// unsupported database version. - function AreAllFilesPresent: Boolean; virtual; abstract; - end; - - /// Class that accesses content of version 1 main database meta data - /// files. - /// Not all meta files are present in version main databases so - /// invariant placeholder content is provided to substitute for missing - /// files. - TV1DBMetaFiles = class sealed(TDBMetaFiles) - strict private - const - cContributorsFile = TDBMetaFileNames.ContributorsV1; - cTestersFile = TDBMetaFileNames.TestersV1; - public - /// Returns an surrogate, invariant value of 1 for the version - /// number. - /// No version file exists for this database version. The value - /// returned is deduced using documentation from the current code snippets - /// database project. - function Version: string; override; - /// Returns an surrogate, invariant value for the license text. - /// - /// No license text file exists for this database version. The - /// value returned is based on documentation of the database. - function LicenseText: string; override; - /// Returns an surrogate, invariant value for the lines of license - /// information. - function LicenseInfo: TStringDynArray; override; - /// Returns the lines of the contributors file. - function Contributors: TStringDynArray; override; - /// Returns the lines of the testers file. - function Testers: TStringDynArray; override; - /// Checks if all the expected meta files are present. Returns - /// True if so or False if not. - function AreAllFilesPresent: Boolean; override; - end; - - /// Class that accesses content of supported version 2 main database - /// meta files. - TV2DBMetaFiles = class sealed(TDBMetaFiles) - strict private - const - cVersionFile = TDBMetaFileNames.VersionV2AndLater; - cLicenseFile = TDBMetaFileNames.LicenseV2; - cLicenseInfoFile = TDBMetaFileNames.LicenseInfoV2; - cContributorsFile = TDBMetaFileNames.ContributorsV2; - cTestersFile = TDBMetaFileNames.TestersV2; - public - /// Returns the contents of the version file. - function Version: string; override; - /// Returns the contents of the license text file. - function LicenseText: string; override; - /// Returns the lines of the license info file. - function LicenseInfo: TStringDynArray; override; - /// Returns the lines of the contributors file. - function Contributors: TStringDynArray; override; - /// Returns the lines of the testers file. - function Testers: TStringDynArray; override; - /// Checks if all the expected meta files are present. Returns - /// True if so or False if not. - function AreAllFilesPresent: Boolean; override; - end; - - /// Class that represents later versions of database meta file - /// formats. - /// These formats have a valid version file but the version is not - /// supported and nothing is known about any other meta data files. - TLaterDBMetaFiles = class sealed(TDBMetaFiles) - strict private - const - cVersionFile = TDBMetaFileNames.VersionV2AndLater; - public - /// Returns the contents of the version file. - function Version: string; override; - /// Returns the empty string. - /// The file format is unknown, so the license text file cannot be - /// read and there is no information to deduce the value. - function LicenseText: string; override; - /// Returns an empty string array. - /// The file format is unknown, so the license information file - /// cannot be read and there is no information to deduce the value. - /// - function LicenseInfo: TStringDynArray; override; - /// Returns an empty string array. - /// The file format is unknown, so the contributors file cannot be - /// read and there is no information to deduce the value. - function Contributors: TStringDynArray; override; - /// Returns an empty string array. - /// The file format is unknown, so the testers file cannot be read - /// and there is no information to deduce the value. - function Testers: TStringDynArray; override; - /// Checks if all the expected meta files are present only if - /// the meta files come from a supported database format. - /// ENotSupportedException always raised since there is no way - /// of knowing what files should be present in an unsupported database - /// format. - function AreAllFilesPresent: Boolean; override; - end; - - /// Class that is present to represent unknown database meta file - /// formats. Also used when database is not present. - /// Accesses no files and returns null results for all methods - /// except IsVersionSupported. - TUnknownOrMissingMetaFiles = class sealed(TDBMetaFiles) - public - /// Returns the empty string. - /// The file format is unknown, so the version file cannot be read - /// and there is no information to deduce the value. - function Version: string; override; - /// Returns the empty string. - /// The file format is unknown, so the license text file cannot be - /// read and there is no information to deduce the value. - function LicenseText: string; override; - /// Returns an empty string array. - /// The file format is unknown, so the license information file - /// cannot be read and there is no information to deduce the value. - /// - function LicenseInfo: TStringDynArray; override; - /// Returns an empty string array. - /// The file format is unknown, so the contributors file cannot be - /// read and there is no information to deduce the value. - function Contributors: TStringDynArray; override; - /// Returns an empty string array. - /// The file format is unknown, so the testers file cannot be read - /// and there is no information to deduce the value. - function Testers: TStringDynArray; override; - /// Checks if all the expected meta files are present only if - /// the meta files come from a supported database format. - /// ENotSupportedException always raised since there is no way - /// of knowing what files should be present in an unrecognised database - /// format. - function AreAllFilesPresent: Boolean; override; - end; - - /// Factory to create the correct instance of database meta file - /// classes that can read the version of a database in a given folder. - /// - TDBMetaFilesFactory = record - public - class function GetInstance(const DBDir: string): TDBMetaFiles; - static; - end; - - /// Abstract base class for classes that provide main database meta - /// data. - TAbstractMainDBMetaData = class abstract(TRegisterableMetaData) - strict private - var - fMetaFiles: TDBMetaFiles; - fIsVersionLoaded: Boolean; - fVersion: TVersionNumber; - fIsLicenseAndCopyrightInfoLoaded: Boolean; - fLicenseInfo: TDBLicenseInfo; - fCopyrightInfo: TDBCopyrightInfo; - fContributors: IStringList; - fTesters: IStringList; - - procedure LoadLicenseAndCopyrightInfo; - - strict protected - function GetDBDir: string; virtual; abstract; - public - /// Creates an instance of meta data object that can read this - /// collection's format. - /// Must be called from a concrete descendant class. - class function Instance(const AStorageDetails: TDataStorageDetails): - IDBMetaData; override; - /// Gets the meta data capabilities for the collection data - /// format. - /// TMetaDataCapabilities. Required meta data capabilities. - /// - /// This method enables meta data capabilities to be obtained - /// without creating an instance of the object. - class function Capabilities: TMetaDataCapabilities; override; - procedure AfterConstruction; override; - destructor Destroy; override; - /// Returns database version number. - /// - /// A null version number is returned if the meta data does not come - /// from a recognised database. - /// Method of IDBMetaData. - /// - function GetVersion: TVersionNumber; - /// Returns database license information. - /// - /// Return value is meaningless if the meta data does not come - /// from a supported database. - /// Method of IDBMetaData. - /// - function GetLicenseInfo: TDBLicenseInfo; - /// Returns database copyright informatiom. - /// - /// Return value is meaningless if the meta data does not come - /// from a supported database. - /// Method of IDBMetaData. - /// - function GetCopyrightInfo: TDBCopyrightInfo; - /// Returns list of contributors to database. - /// - /// Return value is meaningless if the meta data does not come - /// from a supported database. - /// Method of IDBMetaData. - /// - function GetContributors: IStringList; - /// Returns list of testers of database. - /// - /// Return value is meaningless if the meta data does not come - /// from a supported database. - /// Method of IDBMetaData. - /// - function GetTesters: IStringList; - /// Checks if meta data is recognised as belonging to a valid - /// database, whether supported or not. - /// Method of IDBMetaData. - function IsRecognised: Boolean; - /// Checks if meta data is recognised as belonging to a supported - /// database version. - /// Method of IDBMetaData. - function IsSupportedVersion: Boolean; - /// Checks if meta data is corrupt. - /// - /// Should only be called if meta data belongs to a supported - /// database. - /// Method of IDBMetaData. - /// - /// ENotSupportedException raised if called on an unsupported - /// database. - function IsCorrupt: Boolean; - /// Refreshes the meta information by re-reading from database - /// meta files. - /// Method of IDBMetaData. - procedure Refresh; - end; - - /// Class that provides meta data for the main database. - TMainDBMetaData = class sealed(TAbstractMainDBMetaData, IDBMetaData) - strict private - var - fDirectory: string; - strict protected - function GetDBDir: string; override; - public - constructor Create(const ADirectory: string); - end; - - /// Class that provides meta data for update database directories. - /// - TUpdateDBMetaData = class sealed(TAbstractMainDBMetaData, IDBMetaData) - strict private - var - fUpdateDir: string; - strict protected - function GetDBDir: string; override; - public - constructor Create(const UpdateDir: string); - end; - -implementation - -uses - // Delphi - Classes, - IOUtils, - // Project - UEncodings, - UIOUtils, - UResourceUtils, - UStrUtils; - -{ TAbstractMainDBMetaData } - -procedure TAbstractMainDBMetaData.AfterConstruction; -begin - inherited; - Refresh; -end; - -class function TAbstractMainDBMetaData.Capabilities: TMetaDataCapabilities; -begin - Result := [mdcVersion, mdcLicense, mdcCopyright, mdcContributors, mdcTesters]; -end; - -destructor TAbstractMainDBMetaData.Destroy; -begin - fMetaFiles.Free; - inherited; -end; - -function TAbstractMainDBMetaData.GetContributors: IStringList; -begin - if not Assigned(fContributors) then - fContributors := TIStringList.Create(fMetaFiles.Contributors); - Result := fContributors; -end; - -function TAbstractMainDBMetaData.GetCopyrightInfo: TDBCopyrightInfo; -begin - if not fIsLicenseAndCopyrightInfoLoaded then - LoadLicenseAndCopyrightInfo; - Result := fCopyrightInfo; -end; - -function TAbstractMainDBMetaData.GetLicenseInfo: TDBLicenseInfo; -begin - if not fIsLicenseAndCopyrightInfoLoaded then - LoadLicenseAndCopyrightInfo; - Result := fLicenseInfo; -end; - -function TAbstractMainDBMetaData.GetTesters: IStringList; -begin - if not Assigned(fTesters) then - fTesters := TIStringList.Create(fMetaFiles.Testers); - Result := fTesters; -end; - -function TAbstractMainDBMetaData.GetVersion: TVersionNumber; -begin - if not fIsVersionLoaded then - begin - if not TVersionNumber.TryStrToVersionNumber( - StrTrim(fMetaFiles.Version), fVersion - ) then - fVersion := TVersionNumber.Nul; - end; - fIsVersionLoaded := True; - Result := fVersion; -end; - -class function TAbstractMainDBMetaData.Instance( - const AStorageDetails: TDataStorageDetails): IDBMetaData; -begin - Result := TMainDBMetaData.Create(AStorageDetails.Directory); -end; - -function TAbstractMainDBMetaData.IsCorrupt: Boolean; -resourcestring - sNotSupportedError = 'Can''t call IDBMetaData.IsCorrupt for an unsupported ' - + 'database version'; -begin - if not IsSupportedVersion then - raise ENotSupportedException.Create(sNotSupportedError); - Result := not fMetaFiles.AreAllFilesPresent; -end; - -function TAbstractMainDBMetaData.IsRecognised: Boolean; -begin - Result := not GetVersion.IsNull; -end; - -function TAbstractMainDBMetaData.IsSupportedVersion: Boolean; -var - ThisVersion: TVersionNumber; -begin - ThisVersion := GetVersion; - Result := DBValidVersions.Contains(ThisVersion.V1); -end; - -procedure TAbstractMainDBMetaData.LoadLicenseAndCopyrightInfo; -var - SL: TStringList; -begin - if fIsLicenseAndCopyrightInfoLoaded then - Exit; - SL := TStringList.Create; - try - StrArrayToStrList(fMetaFiles.LicenseInfo, SL); - fLicenseInfo := TDBLicenseInfo.Create( - SL.Values['LicenseName'], - SL.Values['LicenseSPDX'], - SL.Values['LicenseURL'], - fMetaFiles.LicenseText - ); - fCopyrightInfo := TDBCopyrightInfo.Create( - SL.Values['CopyrightDate'], - SL.Values['CopyrightHolder'], - SL.Values['CopyrightHolderURL'] - ); - finally - SL.Free; - end; - fIsLicenseAndCopyrightInfoLoaded := True; -end; - -procedure TAbstractMainDBMetaData.Refresh; -begin - FreeAndNil(fMetaFiles); - fMetaFiles := TDBMetaFilesFactory.GetInstance(GetDBDir); - fIsVersionLoaded := False; - fIsLicenseAndCopyrightInfoLoaded := False; - fContributors := nil; - fTesters := nil; -end; - -{ TMainDBMetaData } - -constructor TMainDBMetaData.Create(const ADirectory: string); -begin - inherited Create; - fDirectory := ADirectory; -end; - -function TMainDBMetaData.GetDBDir: string; -begin - Result := fDirectory; -end; - -{ TUpdateDBMetaData } - -constructor TUpdateDBMetaData.Create(const UpdateDir: string); -begin - inherited Create; - fUpdateDir := ExcludeTrailingPathDelimiter(UpdateDir); -end; - -function TUpdateDBMetaData.GetDBDir: string; -begin - Result := fUpdateDir; -end; - -{ TDBMetaFiles } - -constructor TDBMetaFiles.Create(const DBDir: string); -begin - inherited Create; - fDBDir := DBDir; -end; - -function TDBMetaFiles.DBFileExists(const FileName: string): Boolean; -begin - Result := TFile.Exists(MakePath(FileName), False); -end; - -function TDBMetaFiles.GetFileEncoding(const FileName: TFileName): TEncoding; -begin - // Old v1 database meta files may be in the system default encodings, v1 and - // all v2 and later use UTF-8 with BOM. - if TFileIO.CheckBOM(MakePath(FileName), TEncoding.UTF8) then - Result := TEncoding.UTF8 - else - Result := TEncoding.Default; -end; - -function TDBMetaFiles.MakePath(const FileName: string): string; -begin - Assert(not StrContainsStr(PathDelim, FileName), - ClassName + '.MakePath: FileName must be a base file name.'); - Result := IncludeTrailingPathDelimiter(fDBDir) + FileName; -end; - -function TDBMetaFiles.ReadFileLines(const FileName: TFileName): TStringDynArray; -var - Encoding: TEncoding; -begin - if not DBFileExists(FileName) then - begin - SetLength(Result, 0); - Exit; - end; - Encoding := GetFileEncoding(FileName); - try - Result := TFileIO.ReadAllLines(MakePath(FileName), Encoding, True); - finally - TEncodingHelper.FreeEncoding(Encoding); - end; -end; - -function TDBMetaFiles.ReadFileText(const FileName: TFileName): string; -begin - if not DBFileExists(FileName) then - Exit(''); - Result := TFileIO.ReadAllText( - MakePath(FileName), GetFileEncoding(FileName), True - ); -end; - -{ TV1DBMetaFiles } - -function TV1DBMetaFiles.AreAllFilesPresent: Boolean; -begin - Result := DBFileExists(cContributorsFile) and DBFileExists(cTestersFile); -end; - -function TV1DBMetaFiles.Contributors: TStringDynArray; -begin - Result := ReadFileLines(cContributorsFile) -end; - -function TV1DBMetaFiles.LicenseInfo: TStringDynArray; -begin - Result := TStringDynArray.Create( - 'LicenseName=MIT License', - 'LicenseSPDX=MIT', - 'LicenseURL=https://opensource.org/licenses/MIT', - 'CopyrightDate=2005-2016', - 'CopyrightHolder=Peter Johnson & Contributors', - 'CopyrightHolderURL=https://gravatar.com/delphidabbler' - ); -end; - -function TV1DBMetaFiles.LicenseText: string; -begin - Result := LoadResourceAsString(HInstance, 'CSDBLICENSE', RT_RCDATA, etUTF8); -end; - -function TV1DBMetaFiles.Testers: TStringDynArray; -begin - Result := ReadFileLines(cTestersFile); -end; - -function TV1DBMetaFiles.Version: string; -begin - Result := '1'; -end; - -{ TV2DBMetaFiles } - -function TV2DBMetaFiles.AreAllFilesPresent: Boolean; -begin - Result := DBFileExists(cVersionFile) - and DBFileExists(cLicenseFile) - and DBFileExists(cLicenseInfoFile) - and DBFileExists(cContributorsFile) - and DBFileExists(cTestersFile); -end; - -function TV2DBMetaFiles.Contributors: TStringDynArray; -begin - Result := ReadFileLines(cContributorsFile); -end; - -function TV2DBMetaFiles.LicenseInfo: TStringDynArray; -begin - Result := ReadFileLines(cLicenseInfoFile); -end; - -function TV2DBMetaFiles.LicenseText: string; -begin - Result := StrTrimRight(ReadFileText(cLicenseFile)); -end; - -function TV2DBMetaFiles.Testers: TStringDynArray; -begin - Result := ReadFileLines(cTestersFile); -end; - -function TV2DBMetaFiles.Version: string; -begin - Result := StrTrim(ReadFileText(cVersionFile)); -end; - -{ TLaterDBMetaFiles } - -function TLaterDBMetaFiles.AreAllFilesPresent: Boolean; -resourcestring - sNotSupportedError = 'Calling %s.AreAllFilesPresent is not supported for an ' - + 'unsupported database format'; -begin - raise ENotSupportedException.CreateFmt(sNotSupportedError, [ClassName]); -end; - -function TLaterDBMetaFiles.Contributors: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TLaterDBMetaFiles.LicenseInfo: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TLaterDBMetaFiles.LicenseText: string; -begin - Result := ''; -end; - -function TLaterDBMetaFiles.Testers: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TLaterDBMetaFiles.Version: string; -begin - Result := StrTrim(ReadFileText(cVersionFile)); -end; - -{ TUnknownOrMissingMetaFiles } - -function TUnknownOrMissingMetaFiles.AreAllFilesPresent: Boolean; -resourcestring - sNotSupportedError = 'Calling %s.AreAllFilesPresent is not supported for an ' - + 'unrecognised database format or missing database'; -begin - raise ENotSupportedException.CreateFmt(sNotSupportedError, [ClassName]); -end; - -function TUnknownOrMissingMetaFiles.Contributors: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TUnknownOrMissingMetaFiles.LicenseInfo: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TUnknownOrMissingMetaFiles.LicenseText: string; -begin - Result := ''; -end; - -function TUnknownOrMissingMetaFiles.Testers: TStringDynArray; -begin - SetLength(Result, 0); -end; - -function TUnknownOrMissingMetaFiles.Version: string; -begin - Result := ''; -end; - -{ TDBMetaFilesFactory } - -class function TDBMetaFilesFactory.GetInstance(const DBDir: string): - TDBMetaFiles; -var - VersionFile: string; - VersionStr: string; - Version: TVersionNumber; - DBPath: string; -begin - if not TDirectory.Exists(ExcludeTrailingPathDelimiter(DBDir)) then - // Database is not installed - Exit(TUnknownOrMissingMetaFiles.Create(DBDir)); - - DBPath := IncludeTrailingPathDelimiter(DBDir); - - // Check if VERSION file exists: - // Yes: - // either: version is invalid - database format unknown - // or: version is 2.x.x.x - database format v2 recognised - // or: version is >2 - database format recognised but not supported - // No: - // either: expected v1 meta files exist - database format v1 recognised - // or: no v1 meta files - database format unknown - VersionFile := DBPath + TDBMetaFileNames.VersionV2AndLater; - if TFile.Exists(VersionFile, False) then - begin - VersionStr := TFileIO.ReadAllText(VersionFile, TEncoding.UTF8, True); - if not TVersionNumber.TryStrToVersionNumber(VersionStr, Version) then - Result := TUnknownOrMissingMetaFiles.Create(DBDir) - else if Version.V1 = 2 then - Result := TV2DBMetaFiles.Create(DBDir) - else - Result := TLaterDBMetaFiles.Create(DBDir); - end - else - begin - if TFile.Exists(DBPath + TDBMetaFileNames.ContributorsV1, False) - and TFile.Exists(DBPath + TDBMetaFileNames.TestersV1, False) then - Result := TV1DBMetaFiles.Create(DBDir) - else - Result := TUnknownOrMissingMetaFiles.Create(DBDir); - end; -end; - -initialization - -TMetaDataFactory.RegisterCreator( - TDataFormatKind.DCSC_v2, TMainDBMetaData -); - -end. From cbc4c578e227695556cfedbfb6b00e0e341a5853 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 08:28:42 +0000 Subject: [PATCH 149/222] Rename TCollectionID as TVaultID Made minimal changes affected code in order to allow compilation to succeed. Updated many comments re those minimal changes. --- Src/DB.UCollections.pas | 126 ++++++++++++++++---------------- Src/DB.UMain.pas | 101 ++++++++++++------------- Src/DB.USnippet.pas | 45 ++++++------ Src/Favourites.UPersist.pas | 4 +- Src/FmAboutDlg.dfm | 12 +++ Src/FmAboutDlg.pas | 2 +- Src/FmCodeImportDlg.dfm | 16 ++++ Src/FmCodeImportDlg.pas | 12 +-- Src/FmCollectionBackup.pas | 2 +- Src/FmDeleteUserDBDlg.dfm | 1 + Src/FmDeleteUserDBDlg.pas | 2 +- Src/FmDependenciesDlg.dfm | 4 - Src/FmDependenciesDlg.pas | 21 +++--- Src/FmDuplicateSnippetDlg.pas | 9 +-- Src/FmFavouritesDlg.pas | 2 +- Src/FmSWAGImportDlg.dfm | 12 +++ Src/FmSWAGImportDlg.pas | 14 ++-- Src/FmSelectionSearchDlg.pas | 8 +- Src/FmSnippetsEditorDlg.pas | 18 ++--- Src/FmUserDataPathDlg.pas | 2 +- Src/FrDisplayPrefs.pas | 12 +-- Src/FrOverview.dfm | 4 +- Src/FrOverview.pas | 11 ++- Src/FrSelectSnippetsBase.pas | 11 ++- Src/IntfNotifier.pas | 14 ++-- Src/SWAG.UImporter.pas | 10 ++- Src/UCodeImportExport.pas | 4 +- Src/UCodeImportMgr.pas | 17 ++--- Src/UCollectionListAdapter.pas | 7 +- Src/UNotifier.pas | 16 ++-- Src/UPreferences.pas | 39 +++++----- Src/URTFSnippetDoc.pas | 8 +- Src/USnippetAction.pas | 4 +- Src/USnippetDoc.pas | 14 ++-- Src/USnippetIDListIOHandler.pas | 4 +- Src/USnippetIDs.pas | 16 ++-- Src/USnippetValidator.pas | 17 +---- Src/USnippetsTVDraw.pas | 9 +-- Src/UTextSnippetDoc.pas | 6 +- Src/UWBExternal.pas | 4 +- 40 files changed, 327 insertions(+), 313 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 00f2f9ab1..2312f3f26 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -29,37 +29,37 @@ interface type - TCollectionID = record + TVaultID = record strict private var fID: TBytes; public type TComparer = class(TInterfacedObject, - IComparer, IEqualityComparer + IComparer, IEqualityComparer ) public - function Compare(const Left, Right: TCollectionID): Integer; - function Equals(const Left, Right: TCollectionID): Boolean; + function Compare(const Left, Right: TVaultID): Integer; + function Equals(const Left, Right: TVaultID): Boolean; reintroduce; - function GetHashCode(const Value: TCollectionID): Integer; + function GetHashCode(const Value: TVaultID): Integer; reintroduce; end; constructor Create(const ABytes: TBytes); overload; constructor Create(const AStr: string); overload; constructor Create(const AGUID: TGUID); overload; - class function CreateFromHexString(const AHexStr: string): TCollectionID; + class function CreateFromHexString(const AHexStr: string): TVaultID; static; - class function CreateNull: TCollectionID; static; - class function Default: TCollectionID; static; - function Clone: TCollectionID; + class function CreateNull: TVaultID; static; + class function Default: TVaultID; static; + function Clone: TVaultID; function ToArray: TBytes; function ToHexString: string; function IsNull: Boolean; function Hash: Integer; - class function Compare(Left, Right: TCollectionID): Integer; static; - class operator Equal(Left, Right: TCollectionID): Boolean; - class operator NotEqual(Left, Right: TCollectionID): Boolean; + class function Compare(Left, Right: TVaultID): Integer; static; + class operator Equal(Left, Right: TVaultID): Boolean; + class operator NotEqual(Left, Right: TVaultID): Boolean; end; ECollectionID = class(ECodeSnip); @@ -67,7 +67,7 @@ ECollectionID = class(ECodeSnip); TCollection = class strict private var - fUID: TCollectionID; + fUID: TVaultID; fName: string; fStorage: TDataStorageDetails; fMetaData: TMetaData; @@ -85,14 +85,14 @@ TComparer = class(TInterfacedObject, reintroduce; end; /// Creates a collection record. - /// TCollectionID [in] Unique ID of the + /// TVaultID [in] Unique ID of the /// collection. Must not be null. /// string [in] Name of collection. Should be /// unique. Must not be empty or only whitespace. - constructor Create(const AUID: TCollectionID; const AName: string; + constructor Create(const AUID: TVaultID; const AName: string; const AStorage: TDataStorageDetails); /// Collection identifier. Must be unique. - property UID: TCollectionID + property UID: TVaultID read fUID; /// Collection name. Must be unique. property Name: string read @@ -124,19 +124,19 @@ TCollections = class sealed(TSingleton) public class property Instance: TCollections read GetInstance; function GetEnumerator: TEnumerator; - function IndexOfID(const AUID: TCollectionID): Integer; - function ContainsID(const AUID: TCollectionID): Boolean; + function IndexOfID(const AUID: TVaultID): Integer; + function ContainsID(const AUID: TVaultID): Boolean; function ContainsName(const AName: string): Boolean; - function GetCollection(const AUID: TCollectionID): TCollection; + function GetCollection(const AUID: TVaultID): TCollection; function Default: TCollection; procedure Add(const ACollection: TCollection); procedure Update(const ACollection: TCollection); procedure AddOrUpdate(const ACollection: TCollection); - procedure Delete(const AUID: TCollectionID); + procedure Delete(const AUID: TVaultID); procedure Clear; procedure Save; function ToArray: TArray; - function GetAllIDs: TArray; + function GetAllIDs: TArray; function Count: Integer; property Items[const Idx: Integer]: TCollection read GetItem; default; end; @@ -175,7 +175,7 @@ implementation { TCollection } -constructor TCollection.Create(const AUID: TCollectionID; const AName: string; +constructor TCollection.Create(const AUID: TVaultID; const AName: string; const AStorage: TDataStorageDetails); var TrimmedName: string; @@ -194,7 +194,7 @@ constructor TCollection.Create(const AUID: TCollectionID; const AName: string; function TCollection.IsDefault: Boolean; begin - Result := UID = TCollectionID.Default; + Result := UID = TVaultID.Default; end; function TCollection.IsValid: Boolean; @@ -239,7 +239,7 @@ procedure TCollections.Clear; fItems.Clear; end; -function TCollections.ContainsID(const AUID: TCollectionID): +function TCollections.ContainsID(const AUID: TVaultID): Boolean; begin Result := IndexOfID(AUID) >= 0; @@ -262,16 +262,16 @@ function TCollections.Count: Integer; function TCollections.Default: TCollection; begin - Result := GetCollection(TCollectionID.Default); + Result := GetCollection(TVaultID.Default); end; -procedure TCollections.Delete(const AUID: TCollectionID); +procedure TCollections.Delete(const AUID: TVaultID); resourcestring sCantDelete = 'Cannot delete the default collection'; var Idx: Integer; begin - if TCollectionID.Default = AUID then + if TVaultID.Default = AUID then raise EArgumentException.Create(sCantDelete); Idx := IndexOfID(AUID); if Idx >= 0 then @@ -298,7 +298,7 @@ procedure TCollections.Finalize; fItems.Free; end; -function TCollections.GetAllIDs: TArray; +function TCollections.GetAllIDs: TArray; var Idx: Integer; begin @@ -307,7 +307,7 @@ function TCollections.GetAllIDs: TArray; Result[Idx] := fItems[Idx].UID; end; -function TCollections.GetCollection(const AUID: TCollectionID): TCollection; +function TCollections.GetCollection(const AUID: TVaultID): TCollection; var Idx: Integer; begin @@ -332,7 +332,7 @@ function TCollections.GetItem(const Idx: Integer): TCollection; Result := fItems[Idx]; end; -function TCollections.IndexOfID(const AUID: TCollectionID): Integer; +function TCollections.IndexOfID(const AUID: TVaultID): Integer; var Idx: Integer; begin @@ -347,10 +347,10 @@ procedure TCollections.Initialize; fItems := TList.Create; TCollectionsPersist.Load(Self); // Ensure there is always at least the default collection present - if not ContainsID(TCollectionID.Default) then + if not ContainsID(TVaultID.Default) then Add( TCollection.Create( - TCollectionID.Default, + TVaultID.Default, 'Default', TDataStorageDetails.Create( TDataFormatInfo.DefaultFormat, @@ -379,24 +379,24 @@ procedure TCollections.Update(const ACollection: TCollection); DoUpdate(Idx, ACollection); end; -{ TCollectionID } +{ TVaultID } -constructor TCollectionID.Create(const ABytes: TBytes); +constructor TVaultID.Create(const ABytes: TBytes); begin fID := System.Copy(ABytes); end; -constructor TCollectionID.Create(const AStr: string); +constructor TVaultID.Create(const AStr: string); begin fID := TEncoding.UTF8.GetBytes(AStr); end; -function TCollectionID.Clone: TCollectionID; +function TVaultID.Clone: TVaultID; begin - Result := TCollectionID.Create(fID); + Result := TVaultID.Create(fID); end; -class function TCollectionID.Compare(Left, Right: TCollectionID): Integer; +class function TVaultID.Compare(Left, Right: TVaultID): Integer; var CompareLength: Integer; Idx: Integer; @@ -415,83 +415,83 @@ class function TCollectionID.Compare(Left, Right: TCollectionID): Integer; Exit(1); end; -constructor TCollectionID.Create(const AGUID: TGUID); +constructor TVaultID.Create(const AGUID: TGUID); begin fID := System.Copy(GUIDToBytes(AGUID)); end; -class function TCollectionID.CreateFromHexString( - const AHexStr: string): TCollectionID; +class function TVaultID.CreateFromHexString( + const AHexStr: string): TVaultID; var ConvertedBytes: TBytes; begin if not TryHexStringToBytes(AHexStr, ConvertedBytes) then raise ECollectionID.Create(SBadHexString); - Result := TCollectionID.Create(ConvertedBytes); + Result := TVaultID.Create(ConvertedBytes); end; -class function TCollectionID.CreateNull: TCollectionID; +class function TVaultID.CreateNull: TVaultID; var NullID: TBytes; begin SetLength(NullID, 0); - Result := TCollectionID.Create(NullID); + Result := TVaultID.Create(NullID); end; -class function TCollectionID.Default: TCollectionID; +class function TVaultID.Default: TVaultID; begin // Default collection is an empty GUID = 16 zero bytes - Result := TCollectionID.Create(TGUID.Empty); + Result := TVaultID.Create(TGUID.Empty); end; -class operator TCollectionID.Equal(Left, Right: TCollectionID): +class operator TVaultID.Equal(Left, Right: TVaultID): Boolean; begin Result := IsEqualBytes(Left.fID, Right.fID); end; -function TCollectionID.Hash: Integer; +function TVaultID.Hash: Integer; begin Result := BobJenkinsHash(fID[0], Length(fID), 0); end; -function TCollectionID.IsNull: Boolean; +function TVaultID.IsNull: Boolean; begin Result := Length(fID) = 0; end; -class operator TCollectionID.NotEqual(Left, Right: TCollectionID): +class operator TVaultID.NotEqual(Left, Right: TVaultID): Boolean; begin Result := not IsEqualBytes(Left.fID, Right.fID); end; -function TCollectionID.ToArray: TBytes; +function TVaultID.ToArray: TBytes; begin Result := System.Copy(fID); end; -function TCollectionID.ToHexString: string; +function TVaultID.ToHexString: string; begin Result := BytesToHexString(fID); end; -{ TCollectionID.TComparer } +{ TVaultID.TComparer } -function TCollectionID.TComparer.Compare(const Left, - Right: TCollectionID): Integer; +function TVaultID.TComparer.Compare(const Left, + Right: TVaultID): Integer; begin - Result := TCollectionID.Compare(Left, Right); + Result := TVaultID.Compare(Left, Right); end; -function TCollectionID.TComparer.Equals(const Left, - Right: TCollectionID): Boolean; +function TVaultID.TComparer.Equals(const Left, + Right: TVaultID): Boolean; begin Result := Left = Right; end; -function TCollectionID.TComparer.GetHashCode( - const Value: TCollectionID): Integer; +function TVaultID.TComparer.GetHashCode( + const Value: TVaultID): Integer; begin Result := Value.Hash; end; @@ -515,13 +515,13 @@ class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; const ACollections: TCollections); var ConfigSection: ISettingsSection; - UID: TCollectionID; + UID: TVaultID; Name: string; Collection: TCollection; StorageDetails: TDataStorageDetails; begin ConfigSection := Settings.ReadSection(ssCollection, IntToStr(AOrdinal)); - UID := TCollectionID.Create(ConfigSection.GetBytes(UIDKey)); + UID := TVaultID.Create(ConfigSection.GetBytes(UIDKey)); if ACollections.ContainsID(UID) then // Don't load a duplicate collection Exit; @@ -570,7 +570,7 @@ class procedure TCollectionsPersist.SaveCollection(const AOrdinal: Cardinal; function TCollection.TComparer.Compare(const Left, Right: TCollection): Integer; begin - Result := TCollectionID.Compare(Left.UID, Right.UID); + Result := TVaultID.Compare(Left.UID, Right.UID); end; function TCollection.TComparer.Equals(const Left, Right: TCollection): Boolean; diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index b8e73511f..50a0e60b1 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -129,13 +129,13 @@ interface /// Creates a new snippet object. /// string [in] New snippet's key. Must not /// exist in database - /// TCollectionID [in] Collection - /// containing the snippet. + /// TVaultID [in] Vault containing the + /// snippet. /// TSnippetData [in] Record describing /// snippet's properties. /// Instance of new snippet with no references. - function CreateSnippet(const Key: string; - const ACollectionID: TCollectionID; const Props: TSnippetData): TSnippet; + function CreateSnippet(const Key: string; const ACollectionID: TVaultID; + const Props: TSnippetData): TSnippet; end; @@ -183,10 +183,10 @@ interface /// Creates a new snippet key that is unique within the given /// collection. - /// TCollectionID ID of collection that - /// the new key must be unique within. + /// TVaultID ID of vault that the new + /// key must be unique within. /// string containing the key. - function GetUniqueSnippetKey(const ACollectionID: TCollectionID): string; + function GetUniqueSnippetKey(const ACollectionID: TVaultID): string; function GetEditableSnippetInfo(const Snippet: TSnippet = nil): TSnippetEditData; @@ -222,12 +222,12 @@ interface /// Adds a new snippet to the database. /// string [in] New snippet's key. - /// TCollectionID [in] ID of collection - /// that the new snippet will belong to. + /// TVaultID [in] ID of vault that the + /// new snippet will belong to. /// TSnippetEditData [in] Record storing the new /// snippet's properties and references. /// TSnippet. Reference to the new snippet. - function AddSnippet(const AKey: string; const ACollectionID: TCollectionID; + function AddSnippet(const AKey: string; const ACollectionID: TVaultID; const AData: TSnippetEditData): TSnippet; /// Duplicates a snippet in the database. @@ -235,8 +235,8 @@ interface /// /// string [in] Key to be used for duplicated /// snippet. - /// TCollectionID [in] ID of - /// collection the duplicated snippet belongs to. + /// TVaultID [in] ID of vault the + /// duplicated snippet belongs to. /// string [in] Display name of the /// duplicated snippet. /// string [in] ID of the category to which the @@ -244,21 +244,21 @@ interface /// TSnippet. Reference to the duplicated snippet. /// function DuplicateSnippet(const ASnippet: TSnippet; const ANewKey: string; - const ANewCollectionID: TCollectionID; const ANewDisplayName: string; + const ANewCollectionID: TVaultID; const ANewDisplayName: string; const ACatID: string): TSnippet; /// Creates a new temporary snippet without adding it to the /// database. /// string [in] The new nippet's key. - /// TCollectionID [in] ID of the - /// collection to which the new snippet belongs. + /// TVaultID [in] ID of the vault to + /// which the new snippet belongs. /// TSnippetEditData [in] Record storing the new /// snippet's properties and references. /// TSnippet Reference to new snippet. /// The returned snippet must not be added to the database. /// function CreateTempSnippet(const AKey: string; - const ACollectionID: TCollectionID; const AData: TSnippetEditData): + const ACollectionID: TVaultID; const AData: TSnippetEditData): TSnippet; overload; function CreateTempSnippet(const Snippet: TSnippet): TSnippet; overload; @@ -354,13 +354,13 @@ TDBDataItemFactory = class(TInterfacedObject, IDBDataItemFactory) /// Creates a new snippet object. /// string [in] New snippet's key. Must not /// exist in database - /// TCollectionID [in] Collection - /// containing the snippet. + /// TVaultID [in] Vault containing the + /// snippet. /// TSnippetData [in] Record describing /// snippet's properties. /// Instance of new snippet with no references. function CreateSnippet(const Key: string; - const ACollectionID: TCollectionID; const Props: TSnippetData): TSnippet; + const ACollectionID: TVaultID; const Props: TSnippetData): TSnippet; end; @@ -417,23 +417,17 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// Adds a new snippet to the database. Assumes the snippet is /// not already in the database. /// string [in] New snippet's key. - /// TCollectionID [in] ID of collection - /// that the new snippet will belong to. + /// TVaultID [in] ID of vault that the + /// new snippet will belong to. /// TSnippetEditData [in] Record storing the new /// snippet's properties and references. /// TSnippet. Reference to the new snippet. /// ECodeSnip raised if the snippet's category does not /// exist. function InternalAddSnippet(const AKey: string; - const ACollectionID: TCollectionID; const AData: TSnippetEditData): + const ACollectionID: TVaultID; const AData: TSnippetEditData): TSnippet; - {Adds a new snippet to the user database. Assumes snippet not already in - user database. - @param SnippetKey [in] New snippet's key. - @param Data [in] Properties and references of new snippet. - @return Reference to new snippet object. - @except Exception raised if - } + procedure InternalDeleteSnippet(const Snippet: TSnippet); {Deletes a snippet from the user database. @param Snippet [in] Snippet to delete from database. @@ -498,11 +492,11 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// Creates a new snippet key that is unique within the given /// collection. - /// TCollectionID ID of collection that - /// the new key must be unique within. + /// TVaultID ID of vault that the new + /// key must be unique within. /// string containing the key. /// Method of IDatabaseEdit. - function GetUniqueSnippetKey(const ACollectionID: TCollectionID): string; + function GetUniqueSnippetKey(const ACollectionID: TVaultID): string; function GetEditableSnippetInfo(const Snippet: TSnippet = nil): TSnippetEditData; @@ -541,13 +535,13 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// Adds a new snippet to the database. /// string [in] New snippet's key. - /// TCollectionID [in] ID of collection - /// that the new snippet will belong to. + /// TVaultID [in] ID of vault that the + /// new snippet will belong to. /// TSnippetEditData [in] Record storing the new /// snippet's properties and references. /// TSnippet. Reference to the new snippet. /// Method of IDatabaseEdit. - function AddSnippet(const AKey: string; const ACollectionID: TCollectionID; + function AddSnippet(const AKey: string; const ACollectionID: TVaultID; const AData: TSnippetEditData): TSnippet; /// Duplicates a snippet in the database. @@ -555,8 +549,8 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// /// string [in] Key to be used for duplicated /// snippet. - /// TCollectionID [in] ID of - /// collection the duplicated snippet belongs to. + /// TVaultID [in] ID of the vault the + /// duplicated snippet belongs to. /// string [in] Display name of the /// duplicated snippet. /// string [in] ID of the category to which the @@ -565,14 +559,14 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// /// Method of IDatabaseEdit. function DuplicateSnippet(const ASnippet: TSnippet; const ANewKey: string; - const ANewCollectionID: TCollectionID; const ANewDisplayName: string; + const ANewCollectionID: TVaultID; const ANewDisplayName: string; const ACatID: string): TSnippet; /// Creates a new temporary snippet without adding it to the /// database. /// string [in] The new nippet's key. - /// TCollectionID [in] ID of the - /// collection to which the new snippet belongs. + /// TVaultID [in] ID of the vault to + /// which the new snippet belongs. /// TSnippetEditData [in] Record storing the new /// snippet's properties and references. /// TSnippet Reference to new snippet. @@ -581,7 +575,7 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// Method of IDatabaseEdit. /// function CreateTempSnippet(const AKey: string; - const ACollectionID: TCollectionID; const AData: TSnippetEditData): + const ACollectionID: TVaultID; const AData: TSnippetEditData): TSnippet; overload; function CreateTempSnippet(const Snippet: TSnippet): TSnippet; overload; @@ -636,18 +630,18 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) TCollectionDataProvider = class(TInterfacedObject, IDBDataProvider) strict private var - fCollectionID: TCollectionID; // Collection on which to operate + fCollectionID: TVaultID; // Vault on which to operate fSnippets: TSnippetList; // All snippets in the whole database fCategories: TCategoryList; // All categories in the whole database public /// Object constructor. Sets up data provider. - /// TCollectionID [in] Collection for - /// which to provide data. + /// TVaultID [in] Vault for which to + /// provide data. /// TSnippetList [in] List of all snippets /// in the database. /// TCategoryList [in] List of all /// categories in the database. - constructor Create(const ACollectionID: TCollectionID; + constructor Create(const ACollectionID: TVaultID; const SnipList: TSnippetList; const Categories: TCategoryList); @@ -733,8 +727,8 @@ procedure TDatabase.AddChangeEventHandler(const Handler: TNotifyEventInfo); fChangeEvents.AddHandler(Handler); end; -function TDatabase.AddSnippet(const AKey: string; - const ACollectionID: TCollectionID; const AData: TSnippetEditData): TSnippet; +function TDatabase.AddSnippet(const AKey: string; const ACollectionID: TVaultID; + const AData: TSnippetEditData): TSnippet; resourcestring // Error message sKeyExists = 'Snippet with key "%s" already exists in collection'; @@ -794,7 +788,7 @@ function TDatabase.CreateTempSnippet(const Snippet: TSnippet): TSnippet; end; function TDatabase.CreateTempSnippet(const AKey: string; - const ACollectionID: TCollectionID; const AData: TSnippetEditData): TSnippet; + const ACollectionID: TVaultID; const AData: TSnippetEditData): TSnippet; begin Result := TTempSnippet.Create(AKey, ACollectionID, AData.Props); (Result as TTempSnippet).UpdateRefs(AData.Refs, fSnippets); @@ -871,7 +865,7 @@ destructor TDatabase.Destroy; end; function TDatabase.DuplicateSnippet(const ASnippet: TSnippet; - const ANewKey: string; const ANewCollectionID: TCollectionID; + const ANewKey: string; const ANewCollectionID: TVaultID; const ANewDisplayName: string; const ACatID: string): TSnippet; var Data: TSnippetEditData; @@ -994,8 +988,7 @@ function TDatabase.GetSnippets: TSnippetList; Result := fSnippets; end; -function TDatabase.GetUniqueSnippetKey( - const ACollectionID: TCollectionID): string; +function TDatabase.GetUniqueSnippetKey(const ACollectionID: TVaultID): string; var SnippetsInCollection: TSnippetList; Snippet: TSnippet; @@ -1031,7 +1024,7 @@ function TDatabase.InternalAddCategory(const CatID: string; end; function TDatabase.InternalAddSnippet(const AKey: string; - const ACollectionID: TCollectionID; const AData: TSnippetEditData): TSnippet; + const ACollectionID: TVaultID; const AData: TSnippetEditData): TSnippet; var Cat: TCategory; // category object containing new snippet resourcestring @@ -1297,14 +1290,14 @@ function TDBDataItemFactory.CreateCategory(const CatID: string; end; function TDBDataItemFactory.CreateSnippet(const Key: string; - const ACollectionID: TCollectionID; const Props: TSnippetData): TSnippet; + const ACollectionID: TVaultID; const Props: TSnippetData): TSnippet; begin Result := TSnippetEx.Create(Key, ACollectionID, Props); end; { TCollectionDataProvider } -constructor TCollectionDataProvider.Create(const ACollectionID: TCollectionID; +constructor TCollectionDataProvider.Create(const ACollectionID: TVaultID; const SnipList: TSnippetList; const Categories: TCategoryList); begin inherited Create; diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index e54da8c1b..0b3ecc82d 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -139,7 +139,7 @@ TDisplayNameComparer = class(TComparer) fXRef: TSnippetList; // List of cross-referenced snippets fExtra: IActiveText; // Further information for snippet fCompatibility: TCompileResults; // Snippet's compiler compatibility - fCollectionID: TCollectionID; // Snippet's collection ID + fCollectionID: TVaultID; // Snippet's vault ID fHiliteSource: Boolean; // If source is syntax highlighted fTestInfo: TSnippetTestInfo; // Level of testing of snippet function GetID: TSnippetID; @@ -168,11 +168,11 @@ TDisplayNameComparer = class(TComparer) /// Object constructor. Sets up snippet object with given property /// values belonging to a specified collection. /// string [in] Snippet's key. - /// TCollectionID [in] ID of collection - /// to which the snippet belongs. ID must not be null. + /// TVaultID [in] ID of vault to which + /// the snippet belongs. ID must not be null. /// TSnippetData [in] Values of snippet /// properties. - constructor Create(const AKey: string; const ACollectionID: TCollectionID; + constructor Create(const AKey: string; const ACollectionID: TVaultID; const Props: TSnippetData); destructor Destroy; override; @@ -226,8 +226,8 @@ TDisplayNameComparer = class(TComparer) {List of any other snippet in database on which this snippet depends} property XRef: TSnippetList read fXRef; {List of cross referenced snippets in database} - /// ID of collection to which the snippet belongs. - property CollectionID: TCollectionID read fCollectionID; + /// ID of vault to which the snippet belongs. + property CollectionID: TVaultID read fCollectionID; end; { @@ -287,13 +287,13 @@ TSnippetList = class(TObject) /// Finds a snippet in the list with whose key and collection ID /// match. /// string [in] Snippet's key. - /// TCollectionID [in] ID of collection - /// to which the snippet belongs. + /// TVaultID [in] ID of vault to which + /// the snippet belongs. /// Integer. [out] Set to the index of the /// required snippet in the list. Valid only if the snippet was found. /// /// Boolean. True if snippet found, False if not. - function Find(const SnippetKey: string; const ACollectionID: TCollectionID; + function Find(const SnippetKey: string; const ACollectionID: TVaultID; out Index: Integer): Boolean; overload; strict protected @@ -332,12 +332,12 @@ TSnippetList = class(TObject) /// Finds a snippet in the list with whose key and collection ID /// match. /// string [in] Snippet's key. - /// TCollectionID [in] ID of collection - /// to which the snippet belongs. + /// TVaultID [in] ID of vault to which + /// the snippet belongs. /// TSnippet. Reference to the required snippet or nil if /// not found. function Find(const SnippetKey: string; - const ACollectionID: TCollectionID): TSnippet; overload; + const ACollectionID: TVaultID): TSnippet; overload; function Contains(const Snippet: TSnippet): Boolean; {Checks whether list contains a specified snippet. @@ -360,10 +360,10 @@ TSnippetList = class(TObject) /// Counts number of snippets in list that belong to a specified /// collection. - /// TCollectionID [in] Required - /// collection. + /// TVaultID [in] Required vault. + /// /// Integer Number of snippets in the collection. - function Count(const ACollectionID: TCollectionID): Integer; overload; + function Count(const ACollectionID: TVaultID): Integer; overload; function Count: Integer; overload; {Counts number of snippets in list. @@ -376,11 +376,10 @@ TSnippetList = class(TObject) /// Checks if the sub-set of snippets in the list belonging to a /// specified collection is empty. - /// TCollectionID [in] ID of collection. - /// + /// TVaultID [in] ID of vault. /// Boolean True if the subset is empty, False otherwise. /// - function IsEmpty(const ACollectionID: TCollectionID): Boolean; overload; + function IsEmpty(const ACollectionID: TVaultID): Boolean; overload; property Items[Idx: Integer]: TSnippet read GetItem; default; {List of snippets} @@ -443,7 +442,7 @@ function TSnippet.CompareTo(const Snippet: TSnippet): Integer; end; constructor TSnippet.Create(const AKey: string; - const ACollectionID: TCollectionID; const Props: TSnippetData); + const ACollectionID: TVaultID; const Props: TSnippetData); begin Assert(ClassType <> TSnippet, ClassName + '.Create: must only be called from descendants.'); @@ -710,7 +709,7 @@ function TSnippetList.ContainsKinds(const Kinds: TSnippetKinds): Boolean; end; end; -function TSnippetList.Count(const ACollectionID: TCollectionID): Integer; +function TSnippetList.Count(const ACollectionID: TVaultID): Integer; var Snippet: TSnippet; // refers to all snippets in list begin @@ -750,7 +749,7 @@ destructor TSnippetList.Destroy; end; function TSnippetList.Find(const SnippetKey: string; - const ACollectionID: TCollectionID; out Index: Integer): Boolean; + const ACollectionID: TVaultID; out Index: Integer): Boolean; var TempSnippet: TSnippet; // temp snippet used to perform search NullData: TSnippetData; // nul data used to create snippet @@ -767,7 +766,7 @@ function TSnippetList.Find(const SnippetKey: string; end; function TSnippetList.Find(const SnippetKey: string; - const ACollectionID: TCollectionID): TSnippet; + const ACollectionID: TVaultID): TSnippet; var Idx: Integer; // index of snippet key in list begin @@ -811,7 +810,7 @@ function TSnippetList.IsEmpty: Boolean; Result := Count = 0; end; -function TSnippetList.IsEmpty(const ACollectionID: TCollectionID): Boolean; +function TSnippetList.IsEmpty(const ACollectionID: TVaultID): Boolean; begin Result := Count(ACollectionID) = 0; end; diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index 8de05b152..26bd7613e 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -99,13 +99,13 @@ class procedure TFavouritesPersist.Load(Favourites: TFavourites); procedure (AFields: TArray) var Key: string; - CollectionID: TCollectionID; + CollectionID: TVaultID; LastAccess: TDateTime; begin if Length(AFields) <> 3 then raise EFavouritesPersist.Create(sBadFormat); Key := StrTrim(AFields[0]); - CollectionID := TCollectionID.CreateFromHexString( + CollectionID := TVaultID.CreateFromHexString( StrTrim(AFields[1]) ); LastAccess := StrToDateTime(StrTrim(AFields[2]), DateFormatSettings); diff --git a/Src/FmAboutDlg.dfm b/Src/FmAboutDlg.dfm index c683d780e..478fb6456 100644 --- a/Src/FmAboutDlg.dfm +++ b/Src/FmAboutDlg.dfm @@ -33,6 +33,10 @@ inherited AboutDlg: TAboutDlg OnMouseDown = pcDetailMouseDown object tsProgram: TTabSheet Caption = 'About The Program' + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 inline frmProgram: THTMLTpltDlgFrame Left = 0 Top = 0 @@ -66,6 +70,10 @@ inherited AboutDlg: TAboutDlg object tsCollections: TTabSheet Caption = 'About Collections' ImageIndex = 1 + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 DesignSize = ( 401 190) @@ -104,6 +112,10 @@ inherited AboutDlg: TAboutDlg object tsPaths: TTabSheet Caption = 'Paths && Files' ImageIndex = 2 + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 DesignSize = ( 401 190) diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index e3c2fcee7..efd9a7c99 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -324,7 +324,7 @@ procedure TAboutDlg.ConfigForm; end; // Load collections into combo box & select default collection fCollList.ToStrings(cbCollection.Items); - cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); + cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); DisplayCollectionInfo(fCollList.Collection(cbCollection.ItemIndex)); // Set collections treeview and paths scrollbox background colours tvCollectionInfo.Color := ThemeServicesEx.GetTabBodyColour; diff --git a/Src/FmCodeImportDlg.dfm b/Src/FmCodeImportDlg.dfm index 8c3dfde69..7b30eb0c7 100644 --- a/Src/FmCodeImportDlg.dfm +++ b/Src/FmCodeImportDlg.dfm @@ -14,6 +14,10 @@ inherited CodeImportDlg: TCodeImportDlg object tsInfo: TTabSheet Caption = 'tsInfo' TabVisible = False + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblIntro: TLabel Left = 0 Top = 8 @@ -30,6 +34,10 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'tsFile' ImageIndex = 1 TabVisible = False + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblFile: TLabel Left = 0 Top = 8 @@ -96,6 +104,10 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'tsUpdate' ImageIndex = 3 TabVisible = False + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblImportList: TLabel Left = 0 Top = 53 @@ -147,6 +159,10 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'tsFinish' ImageIndex = 5 TabVisible = False + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblFinish: TLabel Left = 0 Top = 8 diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index 7b9bfa4f8..6d025f65b 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -117,9 +117,9 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) procedure UpdateDatabase; /// Displays names of imported snippets on finish page. procedure PresentResults; - /// Gets the ID of the collection into which all snippets are to - /// be imported. - function GetCollectionID: TCollectionID; + /// Gets the ID of the vault into which all snippets are to be + /// imported. + function GetCollectionID: TVaultID; strict protected /// Protected constructor that sets up object to use given import /// manager object. @@ -305,7 +305,7 @@ procedure TCodeImportDlg.FormDestroy(Sender: TObject); TObject(lvImports.Items[Idx].Data).Free; end; -function TCodeImportDlg.GetCollectionID: TCollectionID; +function TCodeImportDlg.GetCollectionID: TVaultID; begin Assert(cbCollection.ItemIndex >= 0, ClassName + '.GetCollectionID: no collection selected'); @@ -339,9 +339,9 @@ procedure TCodeImportDlg.InitForm; begin fCollList.ToStrings(cbCollection.Items); Assert(cbCollection.Items.Count > 0, ClassName + '.InitForm: no collections'); - Assert(TCollections.Instance.ContainsID(TCollectionID.Default), + Assert(TCollections.Instance.ContainsID(TVaultID.Default), ClassName + '.InitForm: default collection not found'); - cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); + cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); Assert(cbCollection.ItemIndex >= 0, ClassName + '.InitForm: default collection name not in cbCollection'); diff --git a/Src/FmCollectionBackup.pas b/Src/FmCollectionBackup.pas index d39d4aa33..e15697ab5 100644 --- a/Src/FmCollectionBackup.pas +++ b/Src/FmCollectionBackup.pas @@ -115,7 +115,7 @@ procedure TCollectionBackupDlg.ConfigForm; begin inherited; fCollList.ToStrings(cbCollection.Items); - cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); + cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); end; class function TCollectionBackupDlg.Execute(AOwner: TComponent; diff --git a/Src/FmDeleteUserDBDlg.dfm b/Src/FmDeleteUserDBDlg.dfm index d915e4668..d1e181c91 100644 --- a/Src/FmDeleteUserDBDlg.dfm +++ b/Src/FmDeleteUserDBDlg.dfm @@ -35,6 +35,7 @@ inherited DeleteUserDBDlg: TDeleteUserDBDlg Height = 210 Align = alTop TabOrder = 0 + TabStop = True ExplicitWidth = 369 ExplicitHeight = 210 inherited pnlBrowser: TPanel diff --git a/Src/FmDeleteUserDBDlg.pas b/Src/FmDeleteUserDBDlg.pas index b98b722c8..353aff673 100644 --- a/Src/FmDeleteUserDBDlg.pas +++ b/Src/FmDeleteUserDBDlg.pas @@ -106,7 +106,7 @@ procedure TDeleteUserDBDlg.ConfigForm; inherited; frmWarning.Initialise('dlg-dbdelete.html'); fCollList.ToStrings(cbCollection.Items); - cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); + cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); end; class function TDeleteUserDBDlg.Execute(AOwner: TComponent; diff --git a/Src/FmDependenciesDlg.dfm b/Src/FmDependenciesDlg.dfm index 45f0aa78d..e3d882f53 100644 --- a/Src/FmDependenciesDlg.dfm +++ b/Src/FmDependenciesDlg.dfm @@ -52,10 +52,6 @@ inherited DependenciesDlg: TDependenciesDlg object tsRequiredBy: TTabSheet Caption = 'Required By' ImageIndex = 1 - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblNoDependents: TLabel Left = 8 Top = 8 diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index cc723100b..a7a5e6f8b 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -67,14 +67,13 @@ TTVDraw = class(TSnippetsTVDraw) fRootID: TSnippetID; // ID of snippet whose dependency nodes displayed strict protected - /// Gets the collection ID, if any, associated with a tree - /// node. + /// Gets the vault ID, if any, associated with a tree node. + /// /// TTreeNode [in] Node to be checked. /// - /// TCollectionID. Associated collection ID. If - /// Node has no associated collection then a null collection ID - /// is returned. - function GetCollectionID(const Node: TTreeNode): TCollectionID; + /// TVaultID. Associated vault ID. If Node has + /// no associated vault then a null vault ID is returned. + function GetCollectionID(const Node: TTreeNode): TVaultID; override; function IsErrorNode(const Node: TTreeNode): Boolean; @@ -410,9 +409,9 @@ procedure TDependenciesDlg.lbDependentsDrawItem(Control: TWinControl; LB: TListBox; Canvas: TCanvas; - function ExtractCollectionItem: TCollectionID; + function ExtractCollectionItem: TVaultID; begin - Result := (LB.Items.Objects[Index] as TBox).Value; + Result := (LB.Items.Objects[Index] as TBox).Value; end; begin @@ -458,7 +457,7 @@ procedure TDependenciesDlg.PopulateRequiredByList; Assert(Assigned(ASnippet), ClassName + '.PopulateRequiredByList: Snippet id not found'); lbDependents.Items.AddObject( - ASnippet.DisplayName, TBox.Create(ASnippet.CollectionID) + ASnippet.DisplayName, TBox.Create(ASnippet.CollectionID) ); end; end; @@ -509,10 +508,10 @@ constructor TDependenciesDlg.TTVDraw.Create( end; function TDependenciesDlg.TTVDraw.GetCollectionID( - const Node: TTreeNode): TCollectionID; + const Node: TTreeNode): TVaultID; begin if not Assigned(Node.Data) then - Result := TCollectionID.CreateNull + Result := TVaultID.CreateNull else Result := TSnippet(Node.Data).CollectionID; end; diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index f874b197a..ab2b45a76 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -56,10 +56,9 @@ TPersistentOptions = class(TObject) fCollList: TCollectionListAdapter; fOptions: TPersistentOptions; fSnippetKey: string; - /// Returns the ID of the collection selected in the collections - /// drop down list, or the null collection ID if no collection is selected. - /// - function SelectedCollectionID: TCollectionID; + /// Returns the ID of the vault selected in the collections drop + /// down list, or the null vault ID if no vault is selected. + function SelectedCollectionID: TVaultID; function SelectedCategoryID: string; procedure ValidateData; procedure HandleException(const E: Exception); @@ -216,7 +215,7 @@ function TDuplicateSnippetDlg.SelectedCategoryID: string; Result := fCatList.CatID(cbCategory.ItemIndex); end; -function TDuplicateSnippetDlg.SelectedCollectionID: TCollectionID; +function TDuplicateSnippetDlg.SelectedCollectionID: TVaultID; begin Assert(cbCollection.ItemIndex >= 0, ClassName + '.SelectedCollectionID: no collection selected'); diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index 5148b5252..325ff2d2d 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -580,7 +580,7 @@ class function TFavouritesDlg.IsDisplayed: Boolean; procedure TFavouritesDlg.LVCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); var - CollectionID: TCollectionID; + CollectionID: TVaultID; begin CollectionID := (Item as TFavouriteListItem).Favourite.SnippetID.CollectionID; fLVFavs.Canvas.Font.Color := Preferences.GetSnippetHeadingColour( diff --git a/Src/FmSWAGImportDlg.dfm b/Src/FmSWAGImportDlg.dfm index 027a4b723..96f67658f 100644 --- a/Src/FmSWAGImportDlg.dfm +++ b/Src/FmSWAGImportDlg.dfm @@ -25,6 +25,10 @@ inherited SWAGImportDlg: TSWAGImportDlg object tsIntro: TTabSheet Caption = 'tsIntro' TabVisible = False + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 inline frmIntro: THTMLTpltDlgFrame Left = 0 Top = 0 @@ -55,6 +59,10 @@ inherited SWAGImportDlg: TSWAGImportDlg Caption = 'tsFolder' ImageIndex = 4 TabVisible = False + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblFolder: TLabel Left = 0 Top = 8 @@ -248,6 +256,10 @@ inherited SWAGImportDlg: TSWAGImportDlg Caption = 'tsFinish' ImageIndex = 3 TabVisible = False + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 inline frmOutro: THTMLTpltDlgFrame Left = 0 Top = 0 diff --git a/Src/FmSWAGImportDlg.pas b/Src/FmSWAGImportDlg.pas index e33029319..0de76a9df 100644 --- a/Src/FmSWAGImportDlg.pas +++ b/Src/FmSWAGImportDlg.pas @@ -155,10 +155,10 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) /// Retrieves import directory name from edit control where it is /// entered. function GetDirNameFromEditCtrl: string; - /// Retrieves collection specified by user that applies to - /// imported snippets. - /// TCollectionID. The required collection ID. - function SelectedCollectionID: TCollectionID; + /// Retrieves vault specified by user that applies to imported + /// snippets. + /// TVaultID. The required vault ID. + function SelectedCollectionID: TVaultID; /// Validates entries on the wizard page identified by the given /// page index. procedure ValidatePage(const PageIdx: Integer); @@ -535,9 +535,9 @@ procedure TSWAGImportDlg.ConfigForm; fCollList.ToStrings(cbCollection.Items); Assert(cbCollection.Items.Count > 0, ClassName + '.ConfigForm: no collections'); - Assert(TCollections.Instance.ContainsID(TCollectionID.Default), + Assert(TCollections.Instance.ContainsID(TVaultID.Default), ClassName + '.ConfigForm: default collection not found'); - cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); + cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); Assert(cbCollection.ItemIndex >= 0, ClassName + '.ConfigForm: default collection not in cbCollection'); end; @@ -871,7 +871,7 @@ procedure TSWAGImportDlg.PreviewSelectedPacket; ); end; -function TSWAGImportDlg.SelectedCollectionID: TCollectionID; +function TSWAGImportDlg.SelectedCollectionID: TVaultID; begin Assert(cbCollection.ItemIndex >= 0, ClassName + '.SelectedCollectionID: no collection selected'); diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index 37c0eed18..4a756351c 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -63,9 +63,9 @@ TSelectionSearchDlg = class(TGenericOKDlg, INoPublicConstruct) } /// Selects all snippets from the given collection. - /// TCollectionID ID of the required - /// collection. - procedure SelectDB(const ACollectionID: TCollectionID); + /// TVaultID ID of the required vault. + /// + procedure SelectDB(const ACollectionID: TVaultID); /// Populates collections pop-up menu with menu items. procedure PopulateCollectionsMenu; @@ -278,7 +278,7 @@ procedure TSelectionSearchDlg.PopulateCollectionsMenu; AddMenuItem(Collection); end; -procedure TSelectionSearchDlg.SelectDB(const ACollectionID: TCollectionID); +procedure TSelectionSearchDlg.SelectDB(const ACollectionID: TVaultID); var Snippet: TSnippet; // references each snippet in database SnippetList: TSnippetList; // list of selected snippets diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 5c7079dc3..3ccc12a15 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -178,13 +178,13 @@ TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) fMemoCaretPosDisplayMgr: TMemoCaretPosDisplayMgr; // Manages display of memo caret positions - /// Returns the ID of the collection that applies to a new or - /// existing snippet. - /// TCollectionID. The required collection ID. - /// For a new snippet the return value is the collection to be - /// applied to the snippet. For an existing snippet this is collection to - /// which the snippet already belongs. - function SelectedCollectionID: TCollectionID; + /// Returns the ID of the vault that applies to a new or existing + /// snippet. + /// TVaultID. The required vault ID. + /// For a new snippet the return value is the vault to be applied + /// to the snippet. For an existing snippet this is the value to which the + /// snippet already belongs. + function SelectedCollectionID: TVaultID; /// Returns a snippet key that is unique with the current /// snippet collection. @@ -892,7 +892,7 @@ procedure TSnippetsEditorDlg.InitControls; cbCategories.ItemIndex := fCatList.IndexOf(TCategory.DefaultID); if cbCategories.ItemIndex = -1 then cbCategories.ItemIndex := 0; - cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); + cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); Assert(cbCollection.ItemIndex >= 0, ClassName + '.InitControls: No default collection in cbCollection'); cbCollection.Visible := True; // can select collection of new snippet @@ -978,7 +978,7 @@ procedure TSnippetsEditorDlg.PopulateControls; fCollList.ToStrings(cbCollection.Items); end; -function TSnippetsEditorDlg.SelectedCollectionID: TCollectionID; +function TSnippetsEditorDlg.SelectedCollectionID: TVaultID; begin // If editing existing snippet ID then the collection cannot be edited if Assigned(fSnippet) then diff --git a/Src/FmUserDataPathDlg.pas b/Src/FmUserDataPathDlg.pas index 74215c0b8..a5981e27a 100644 --- a/Src/FmUserDataPathDlg.pas +++ b/Src/FmUserDataPathDlg.pas @@ -236,7 +236,7 @@ procedure TUserDataPathDlg.ConfigForm; frmProgress.Visible := False; frmProgress.Range := TRange.Create(0, 100); fCollList.ToStrings(cbCollection.Items); - cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); + cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); end; procedure TUserDataPathDlg.CopyFileHandler(Sender: TObject; diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index 41c8834d1..ddc7ff5d7 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -61,7 +61,7 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) /// Local copy of snippet heading / tree node colour for each /// collection. - fSnippetHeadingColours: TDictionary; + fSnippetHeadingColours: TDictionary; fGroupHeadingColourBox: TColorBoxEx; fGroupHeadingColourDlg: TColorDialogEx; @@ -88,7 +88,7 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) procedure SnippetHeadingColourBoxChange(Sender: TObject); procedure PopulateFontSizeCombos; procedure SetTabOrder; - function SelectedCollectionID: TCollectionID; + function SelectedCollectionID: TVaultID; public constructor Create(AOwner: TComponent); override; {Object constructor. Sets up frame and populates controls. @@ -164,7 +164,7 @@ procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences; var Collection: TCollection; begin - cbCollection.ItemIndex := fCollList.IndexOfUID(TCollectionID.Default); + cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); Assert(cbCollection.ItemIndex >= 0, ClassName + '.Activate: no default collection found in cbCollection'); SelectOverviewTreeState(Prefs.OverviewStartState); @@ -354,8 +354,8 @@ constructor TDisplayPrefsFrame.Create(AOwner: TComponent); PopulateFontSizeCombos; - fSnippetHeadingColours := TDictionary.Create( - TCollectionID.TComparer.Create + fSnippetHeadingColours := TDictionary.Create( + TVaultID.TComparer.Create ); fCollList := TCollectionListAdapter.Create; @@ -509,7 +509,7 @@ procedure TDisplayPrefsFrame.PopulateFontSizeCombos; TFontHelper.ListCommonFontSizes(cbDetailFontSize.Items); end; -function TDisplayPrefsFrame.SelectedCollectionID: TCollectionID; +function TDisplayPrefsFrame.SelectedCollectionID: TVaultID; begin Assert(cbCollection.ItemIndex >= 0, ClassName + '.SelectedCollectionID: no collection selected'); diff --git a/Src/FrOverview.dfm b/Src/FrOverview.dfm index 159f3cddc..b47989bbd 100644 --- a/Src/FrOverview.dfm +++ b/Src/FrOverview.dfm @@ -1,9 +1,9 @@ inherited OverviewFrame: TOverviewFrame inherited pnlTitle: TPanel inherited lblTitle: TLabel - Width = 54 + Width = 53 Caption = 'Overview' - ExplicitWidth = 54 + ExplicitWidth = 53 end object tbarOverview: TToolBar Left = 224 diff --git a/Src/FrOverview.pas b/Src/FrOverview.pas index aaeaf6e39..57fca0b78 100644 --- a/Src/FrOverview.pas +++ b/Src/FrOverview.pas @@ -79,10 +79,9 @@ TTVDraw = class(TSnippetsTVDraw) /// node. /// TTreeNode [in] Node to be checked. /// - /// TCollectionID. Associated collection ID. If - /// Node has no associated collection then a null collection ID - /// is returned. - function GetCollectionID(const Node: TTreeNode): TCollectionID; + /// TVaultID. Associated vault ID. If Node has + /// no associated vault then a null vault ID is returned. + function GetCollectionID(const Node: TTreeNode): TVaultID; override; function IsSectionHeadNode(const Node: TTreeNode): Boolean; @@ -965,7 +964,7 @@ procedure TOverviewFrame.UpdateTreeState(const State: TTreeNodeAction); { TOverviewFrame.TTVDraw } function TOverviewFrame.TTVDraw.GetCollectionID(const Node: TTreeNode): - TCollectionID; + TVaultID; var ViewItem: IView; // view item represented by node SnippetView: ISnippetView; // view item if node represents a snippet @@ -975,7 +974,7 @@ function TOverviewFrame.TTVDraw.GetCollectionID(const Node: TTreeNode): if Supports(ViewItem, ISnippetView, SnippetView) then Result := SnippetView.Snippet.CollectionID else - Result := TCollectionID.CreateNull; + Result := TVaultID.CreateNull; end; function TOverviewFrame.TTVDraw.IsSectionHeadNode( diff --git a/Src/FrSelectSnippetsBase.pas b/Src/FrSelectSnippetsBase.pas index 71a08498d..8b69abd06 100644 --- a/Src/FrSelectSnippetsBase.pas +++ b/Src/FrSelectSnippetsBase.pas @@ -54,10 +54,9 @@ TTVDraw = class(TSnippetsTVDraw) /// node. /// TTreeNode [in] Node to be checked. /// - /// TCollectionID. Associated collection ID. If - /// Node has no associated collection then a null collection ID - /// is returned. - function GetCollectionID(const Node: TTreeNode): TCollectionID; + /// TVaultID. Associated vault ID. If Node has + /// no associated vault then a null vault ID is returned. + function GetCollectionID(const Node: TTreeNode): TVaultID; override; function IsSectionHeadNode(const Node: TTreeNode): Boolean; @@ -276,7 +275,7 @@ function TSelectSnippetsBaseFrame.SnippetFromNode( { TSelectSnippetsBaseFrame.TTVDraw } function TSelectSnippetsBaseFrame.TTVDraw.GetCollectionID( - const Node: TTreeNode): TCollectionID; + const Node: TTreeNode): TVaultID; var SnipObj: TObject; // object referenced in Node.Data begin @@ -284,7 +283,7 @@ function TSelectSnippetsBaseFrame.TTVDraw.GetCollectionID( if SnipObj is TSnippet then Result := (SnipObj as TSnippet).CollectionID else - Result := TCollectionID.CreateNull + Result := TVaultID.CreateNull end; function TSelectSnippetsBaseFrame.TTVDraw.IsSectionHeadNode( diff --git a/Src/IntfNotifier.pas b/Src/IntfNotifier.pas index 5e07ab102..fcb8d741d 100644 --- a/Src/IntfNotifier.pas +++ b/Src/IntfNotifier.pas @@ -33,12 +33,12 @@ interface /// Displays a snippet. /// WideString [in] Required snippet's key. /// - /// TCollectionID [in] ID of the snippet's - /// collection. + /// TVaultID [in] ID of the snippet's vault. + /// /// WordBool [in] Whether to display snippet in a new /// detail pane tab. - procedure DisplaySnippet(const Key: WideString; - ACollectionID: TCollectionID; NewTab: WordBool); + procedure DisplaySnippet(const Key: WideString; ACollectionID: TVaultID; + NewTab: WordBool); /// Displays a category. /// WideString [in] ID of required category. @@ -66,10 +66,10 @@ interface /// Edits a snippet in Snippets Editor. /// WideString [in] Snippet's key. - /// TCollectionID [in] ID of the snippet's - /// collection. + /// TVaultID [in] ID of the snippet's vault. + /// procedure EditSnippet(const Key: WideString; - const ACollectionID: TCollectionID); + const ACollectionID: TVaultID); /// Displays news items from the CodeSnip news feed. procedure ShowNews; diff --git a/Src/SWAG.UImporter.pas b/Src/SWAG.UImporter.pas index 89cf2cdd4..2c68ea456 100644 --- a/Src/SWAG.UImporter.pas +++ b/Src/SWAG.UImporter.pas @@ -64,7 +64,7 @@ TSWAGImporter = class(TObject) TSnippetEditData; /// Imports (i.e. adds) the given SWAG packet into the user /// database as a CodeSnip format snippet. - procedure ImportPacketAsSnippet(const ACollectionID: TCollectionID; + procedure ImportPacketAsSnippet(const ACollectionID: TVaultID; const SWAGPacket: TSWAGPacket); class procedure EnsureSWAGCategoryExists; @@ -82,11 +82,13 @@ TSWAGImporter = class(TObject) procedure IncludePacket(const SWAGPacket: TSWAGPacket); /// Imports all the required SWAG packets into the user database /// as new snippets. + /// TVaultID [in] Vault into which + /// packets are imported. /// TProgressCallback [in] Optional callback to be /// called after each SWAG packet is imported. /// The packets that are imported are those that have been /// recorded by calling IncludePacket. - procedure Import(const ACollectionID: TCollectionID; + procedure Import(const ACollectionID: TVaultID; const Callback: TProgressCallback = nil); /// Description of the category in the user database used for all /// imported SWAG packets. @@ -256,7 +258,7 @@ function TSWAGImporter.ExtraBoilerplate: IActiveText; Result := fExtraBoilerplate; end; -procedure TSWAGImporter.Import(const ACollectionID: TCollectionID; +procedure TSWAGImporter.Import(const ACollectionID: TVaultID; const Callback: TProgressCallback); var SWAGPacket: TSWAGPacket; @@ -270,7 +272,7 @@ procedure TSWAGImporter.Import(const ACollectionID: TCollectionID; end; procedure TSWAGImporter.ImportPacketAsSnippet( - const ACollectionID: TCollectionID; const SWAGPacket: TSWAGPacket); + const ACollectionID: TVaultID; const SWAGPacket: TSWAGPacket); var SnippetKey: string; // unique ID of new snippet SnippetDetails: TSnippetEditData; // data describing new snippet diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index 44047f7e5..d468c247a 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -272,7 +272,7 @@ constructor TCodeExporter.InternalCreate(const SnipList: TSnippetList); for Snippet in SnipList do fSnippetKeyMap.Add( Snippet.ID, - (Database as IDatabaseEdit).GetUniqueSnippetKey(TCollectionID.Default) + (Database as IDatabaseEdit).GetUniqueSnippetKey(TVaultID.Default) ); end; @@ -422,7 +422,7 @@ procedure TCodeImporter.Execute(const Data: TBytes); // Note: in building snippet ID list we assume each snippet is from the // default collection. It may not be, but there is no way of telling // from XML. - Depends.Add(TSnippetID.Create(SnippetName, TCollectionID.Default)); + Depends.Add(TSnippetID.Create(SnippetName, TVaultID.Default)); end; // Reads description node and converts to active text. diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index 775d9f28f..a9ca697bd 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -109,7 +109,7 @@ TCodeImportMgr = class sealed(TObject) /// Value of ImportInfo property. fImportInfoList: TImportInfoList; /// Value of RequestCollectionCallback property. - fRequestCollectionCallback: TFunc; + fRequestCollectionCallback: TFunc; /// Initialises import information list with details of snippets /// read from import file. procedure InitImportInfoList; @@ -134,11 +134,10 @@ TCodeImportMgr = class sealed(TObject) /// List of information describing if and how to import snippets /// in import file. Permits customisation of import. property ImportInfo: TImportInfoList read fImportInfoList; - /// Callback that gets the ID of the collection that will receive - /// the imported snippets. - /// Defaults to the "user" collection ID if not assigned. - /// - property RequestCollectionCallback: TFunc + /// Callback that gets the ID of the vault that will receive the + /// imported snippets. + /// Defaults to the default vault ID if not assigned. + property RequestCollectionCallback: TFunc read fRequestCollectionCallback write fRequestCollectionCallback; end; @@ -174,9 +173,9 @@ constructor TCodeImportMgr.Create; SetLength(fSnippetInfoList, 0); fImportInfoList := TImportInfoList.Create; // set default event handler - fRequestCollectionCallback := function: TCollectionID + fRequestCollectionCallback := function: TVaultID begin - Result := TCollectionID.Default; + Result := TVaultID.Default; end; end; @@ -257,7 +256,7 @@ TSavedReferences = record Editor: IDatabaseEdit; // object used to update user database SnippetInfo: TSnippetInfo; // info about each snippet from import file ImportInfo: TImportInfo; // info about how / whether to import a snippet - CollectionID: TCollectionID; // collection into which we're importing + CollectionID: TVaultID; // collection into which we're importing SavedRefs: TList; // preserved references for each snippet SavedRef: TSavedReferences; // each record in Refs list SnippetDataNoRefs: TSnippetEditData; // snippet data with references cleared diff --git a/Src/UCollectionListAdapter.pas b/Src/UCollectionListAdapter.pas index 7d8dd1e97..fbf932efb 100644 --- a/Src/UCollectionListAdapter.pas +++ b/Src/UCollectionListAdapter.pas @@ -52,9 +52,8 @@ TCollectionListAdapter = class(TObject) /// TCollection. Required collection. function Collection(const AIndex: Integer): TCollection; - /// Gets list index of the collection with the specified UID. - /// - function IndexOfUID(const AUID: TCollectionID): Integer; + /// Gets list index of the vault with the specified UID. + function IndexOfUID(const AUID: TVaultID): Integer; end; implementation @@ -96,7 +95,7 @@ destructor TCollectionListAdapter.Destroy; inherited; end; -function TCollectionListAdapter.IndexOfUID(const AUID: TCollectionID): Integer; +function TCollectionListAdapter.IndexOfUID(const AUID: TVaultID): Integer; var Idx: Integer; begin diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index a5d4174e2..5629550a1 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -67,12 +67,12 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) /// Displays a snippet. /// WideString [in] Required snippet's key. /// - /// TCollectionID [in] ID of the snippet's - /// collection. + /// TVaultID [in] ID of the snippet's + /// vault. /// WordBool [in] Whether to display snippet in a new /// detail pane tab. procedure DisplaySnippet(const Key: WideString; - ACollectionID: TCollectionID; NewTab: WordBool); + ACollectionID: TVaultID; NewTab: WordBool); /// Displays a category. /// WideString [in] ID of required category. @@ -107,11 +107,11 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) /// Edits a snippet in Snippets Editor. /// WideString [in] Snippet's key. - /// TCollectionID [in] ID of the snippet's - /// collection. + /// TVaultID [in] ID of the snippet's + /// vault. /// Method of INotifier. procedure EditSnippet(const Key: WideString; - const ACollectionID: TCollectionID); + const ACollectionID: TVaultID); /// Displays news items from the CodeSnip news feed. /// Methods of INotifier. @@ -232,7 +232,7 @@ procedure TNotifier.DisplayCategory(const CatID: WideString; NewTab: WordBool); end; procedure TNotifier.DisplaySnippet(const Key: WideString; - ACollectionID: TCollectionID; NewTab: WordBool); + ACollectionID: TVaultID; NewTab: WordBool); begin if Assigned(fDisplaySnippetAction) then begin @@ -244,7 +244,7 @@ procedure TNotifier.DisplaySnippet(const Key: WideString; end; procedure TNotifier.EditSnippet(const Key: WideString; - const ACollectionID: TCollectionID); + const ACollectionID: TVaultID); begin if Assigned(fEditSnippetAction) then begin diff --git a/Src/UPreferences.pas b/Src/UPreferences.pas index da22563ff..16785a5d0 100644 --- a/Src/UPreferences.pas +++ b/Src/UPreferences.pas @@ -165,17 +165,17 @@ interface /// Gets the heading / tree node colour used for snippets from a /// specified collection. - /// TCollectionID [in] ID of required - /// collection. + /// TVaultID [in] ID of required vault. + /// /// TColor. Required colour. - function GetSnippetHeadingColour(const ACollectionID: TCollectionID): + function GetSnippetHeadingColour(const ACollectionID: TVaultID): TColor; /// Sets heading / tree node colour used for snippets from a /// specified collection. - /// TCollectionID [in] ID of required - /// collection. + /// TVaultID [in] ID of required vault. + /// /// TColor. Required colour. - procedure SetSnippetHeadingColour(const ACollectionID: TCollectionID; + procedure SetSnippetHeadingColour(const ACollectionID: TVaultID; const Value: TColor); /// Gets custom colours available for snippet headings / tree @@ -365,8 +365,8 @@ TPreferences = class(TInterfacedObject, /// fGroupHeadingCustomColours: IStringList; /// Records colour to be used for snippet headings and tree - /// nodes for each collection. - fSnippetHeadingColours: TDictionary; + /// nodes for each vault. + fSnippetHeadingColours: TDictionary; /// Records custom colours available for snippet heading and /// tree nodes. fSnippetHeadingCustomColours: IStringList; @@ -531,21 +531,20 @@ TPreferences = class(TInterfacedObject, procedure SetGroupHeadingCustomColours(const AColours: IStringList); /// Gets the heading / tree node colour used for snippets from a - /// specified collection. - /// TCollectionID [in] ID of required - /// collection. + /// specified vault. + /// TVaultID [in] ID of required vault. + /// /// TColor. Required colour. /// Method of IPreferences. - function GetSnippetHeadingColour(const ACollectionID: TCollectionID): - TColor; + function GetSnippetHeadingColour(const ACollectionID: TVaultID): TColor; /// Sets heading / tree node colour used for snippets from a /// specified collection. - /// TCollectionID [in] ID of required - /// collection. + /// TVaultID [in] ID of required vault. + /// /// TColor. Required colour. /// Method of IPreferences. - procedure SetSnippetHeadingColour(const ACollectionID: TCollectionID; + procedure SetSnippetHeadingColour(const ACollectionID: TVaultID; const Value: TColor); /// Gets custom colours available for snippet headings / tree @@ -774,8 +773,8 @@ constructor TPreferences.Create; fNamedHiliteAttrs := THiliteAttrsFactory.CreateNamedAttrs; fHiliteCustomColours := TIStringList.Create; fWarnings := TWarnings.Create; - fSnippetHeadingColours := TDictionary.Create( - TCollectionID.TComparer.Create + fSnippetHeadingColours := TDictionary.Create( + TVaultID.TComparer.Create ); fPageStructures := TSnippetPageStructures.Create; TDefaultPageStructures.SetDefaults(fPageStructures); @@ -874,7 +873,7 @@ function TPreferences.GetShowNewSnippetsInNewTabs: Boolean; end; function TPreferences.GetSnippetHeadingColour( - const ACollectionID: TCollectionID): TColor; + const ACollectionID: TVaultID): TColor; begin if fSnippetHeadingColours.ContainsKey(ACollectionID) then Result := fSnippetHeadingColours[ACollectionID] @@ -1006,7 +1005,7 @@ procedure TPreferences.SetShowNewSnippetsInNewTabs(const Value: Boolean); end; procedure TPreferences.SetSnippetHeadingColour( - const ACollectionID: TCollectionID; const Value: TColor); + const ACollectionID: TVaultID; const Value: TColor); begin fSnippetHeadingColours.AddOrSetValue(ACollectionID, Value); end; diff --git a/Src/URTFSnippetDoc.pas b/Src/URTFSnippetDoc.pas index 73afd5899..6a10e9529 100644 --- a/Src/URTFSnippetDoc.pas +++ b/Src/URTFSnippetDoc.pas @@ -77,11 +77,11 @@ TRTFSnippetDoc = class(TSnippetDoc) /// Initialises rich text document. procedure InitialiseDoc; override; /// Output given heading, i.e. snippet name for snippet from a - /// given collection.. - /// Heading is coloured according the the snippet's collection. + /// given vault. + /// Heading is coloured according the the snippet's vault. /// procedure RenderHeading(const Heading: string; - const ACollectionID: TCollectionID); override; + const ACollectionID: TVaultID); override; /// Adds given snippet description to document. /// Active text formatting is observed and styled to suit /// document. @@ -421,7 +421,7 @@ procedure TRTFSnippetDoc.RenderExtra(const ExtraText: IActiveText); end; procedure TRTFSnippetDoc.RenderHeading(const Heading: string; - const ACollectionID: TCollectionID); + const ACollectionID: TVaultID); begin fBuilder.SetFontStyle([fsBold]); fBuilder.SetFontSize(HeadingFontSize); diff --git a/Src/USnippetAction.pas b/Src/USnippetAction.pas index 5d17d1fcc..4ed01a40c 100644 --- a/Src/USnippetAction.pas +++ b/Src/USnippetAction.pas @@ -40,7 +40,7 @@ TSnippetAction = class(TBasicAction, ISetNotifier) /// Value of Key property. fKey: string; /// Value of CollectionID property. - fCollectionID: TCollectionID; + fCollectionID: TVaultID; /// Value of NewTab property. fNewTab: Boolean; /// Reference to Notifier object. @@ -63,7 +63,7 @@ TSnippetAction = class(TBasicAction, ISetNotifier) property Key: string read fKey write fKey; /// ID of the collection containing the snippet to be displayed. /// - property CollectionID: TCollectionID read fCollectionID write fCollectionID; + property CollectionID: TVaultID read fCollectionID write fCollectionID; /// Flag indicating if snippet is to be displayed in a new detail /// pane tab. property NewTab: Boolean read fNewTab write fNewTab; diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index 0f19169e0..68a0bbac1 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -54,10 +54,10 @@ TSnippetDoc = class(TObject) /// information for given snippet. function CompilerInfo(const Snippet: TSnippet): TCompileDocInfoArray; /// Generates and returns a string containing information about - /// the given collection. + /// the given vault. /// Information includes license and copyright information if - /// the collection's data format supports it. - function CollectionInfo(const ACollectionID: TCollectionID): string; + /// the vault's data format supports it. + function CollectionInfo(const ACollectionID: TVaultID): string; strict protected /// Initialise document. /// Does nothing. Descendant classes should perform any required @@ -65,11 +65,11 @@ TSnippetDoc = class(TObject) procedure InitialiseDoc; virtual; /// Output given heading, i.e. snippet name for snippet from a - /// given collection.. + /// given vault. /// Heading may be rendered differently depending on the snippet's - /// collection. + /// vault. procedure RenderHeading(const Heading: string; - const ACollectionID: TCollectionID); virtual; abstract; + const ACollectionID: TVaultID); virtual; abstract; /// Output given snippet description. procedure RenderDescription(const Desc: IActiveText); virtual; abstract; /// Output given source code. @@ -129,7 +129,7 @@ implementation { TSnippetDoc } -function TSnippetDoc.CollectionInfo(const ACollectionID: TCollectionID): string; +function TSnippetDoc.CollectionInfo(const ACollectionID: TVaultID): string; resourcestring sCollectionInfo = 'A snippet from the "%s" collection.'; var diff --git a/Src/USnippetIDListIOHandler.pas b/Src/USnippetIDListIOHandler.pas index 82c8eb5ac..fc1165ff1 100644 --- a/Src/USnippetIDListIOHandler.pas +++ b/Src/USnippetIDListIOHandler.pas @@ -85,7 +85,7 @@ procedure TSnippetIDListFileReader.ParseLine(AFields: TArray); var Key: string; CollectionHex: string; - CollectionID: TCollectionID; + CollectionID: TVaultID; begin Key := StrTrim(AFields[0]); if Key = '' then @@ -93,7 +93,7 @@ procedure TSnippetIDListFileReader.ParseLine(AFields: TArray); CollectionHex := StrTrim(AFields[1]); if CollectionHex = '' then raise ESnippetIDListFileReader.Create(sBadFileFormat); - CollectionID := TCollectionID.CreateFromHexString(CollectionHex); + CollectionID := TVaultID.CreateFromHexString(CollectionHex); fSnippetIDs.Add(TSnippetID.Create(Key, CollectionID)); end; diff --git a/Src/USnippetIDs.pas b/Src/USnippetIDs.pas index adfd71065..b4556bd51 100644 --- a/Src/USnippetIDs.pas +++ b/Src/USnippetIDs.pas @@ -34,9 +34,9 @@ TSnippetID = record var /// Value of Key property. fKey: string; - fCollectionID: TCollectionID; + fCollectionID: TVaultID; procedure SetKey(const AValue: string); - procedure SetCollectionID(const AValue: TCollectionID); + procedure SetCollectionID(const AValue: TVaultID); public type TComparer = class(TInterfacedObject, @@ -53,15 +53,15 @@ TComparer = class(TInterfacedObject, /// Snippet's key. property Key: string read fKey write SetKey; - /// ID of the collection to which a snippet with this ID belongs. + /// ID of the vault to which a snippet with this ID belongs. /// /// ID must not be null. - property CollectionID: TCollectionID + property CollectionID: TVaultID read fCollectionID write SetCollectionID; /// Creates a record with given property values. /// ACollectionID must not be null. - constructor Create(const AKey: string; const ACollectionID: TCollectionID); + constructor Create(const AKey: string; const ACollectionID: TVaultID); /// Creates copy of given snippet ID constructor Clone(const Src: TSnippetID); @@ -191,11 +191,11 @@ function TSnippetID.CompareTo(const SID: TSnippetID): Integer; begin Result := CompareKeys(Key, SID.Key); if Result = 0 then - Result := TCollectionID.Compare(CollectionID, SID.CollectionID); + Result := TVaultID.Compare(CollectionID, SID.CollectionID); end; constructor TSnippetID.Create(const AKey: string; - const ACollectionID: TCollectionID); + const ACollectionID: TVaultID); begin SetKey(AKey); SetCollectionID(ACollectionID); @@ -223,7 +223,7 @@ function TSnippetID.Hash: Integer; Result := not (SID1 = SID2); end; -procedure TSnippetID.SetCollectionID(const AValue: TCollectionID); +procedure TSnippetID.SetCollectionID(const AValue: TVaultID); begin Assert(not AValue.IsNull, 'TSnippetID.SetCollectionID: Value is null'); fCollectionID := AValue.Clone; diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index 2674623b8..02f6093a7 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -60,8 +60,8 @@ TSnippetValidator = class(TNoConstructObject) /// /// string [in] Key of snippet for which /// dependencies are to be checked. - /// TCollectionID [in] ID of the - /// collection to which snippet belongs. + /// TVaultID [in] ID of the vault to + /// which snippet belongs. /// TSnippetEditData [in] Data describing /// properties and references of snippet for which dependencies are to be /// checked. @@ -70,7 +70,7 @@ TSnippetValidator = class(TNoConstructObject) /// Boolean. True if dependency list is valid or /// False if not. class function ValidateDependsList(const AKey: string; - const ACollectionID: TCollectionID; const AData: TSnippetEditData; + const ACollectionID: TVaultID; const AData: TSnippetEditData; out AErrorMsg: string): Boolean; overload; class function ValidateSourceCode(const Source: string; @@ -268,17 +268,8 @@ class function TSnippetValidator.ValidateDependsList(const Snippet: TSnippet; end; class function TSnippetValidator.ValidateDependsList(const AKey: string; - const ACollectionID: TCollectionID; const AData: TSnippetEditData; + const ACollectionID: TVaultID; const AData: TSnippetEditData; out AErrorMsg: string): Boolean; - {Recursively checks dependency list of a snippet for validity. - @param SnippetKey [in] Key of snippet for which dependencies are to be - checked. - @param Data [in] Data describing properties and references of snippet for - which dependencies are to be checked. - @param ErrorMsg [out] Message that describes error. Undefined if True - returned. - @return True if dependency list is valid or False if not. - } var TempSnippet: TSnippet; // temporary snippet that is checked for dependencies begin diff --git a/Src/USnippetsTVDraw.pas b/Src/USnippetsTVDraw.pas index cd3191ad7..92315180f 100644 --- a/Src/USnippetsTVDraw.pas +++ b/Src/USnippetsTVDraw.pas @@ -32,13 +32,12 @@ interface } TSnippetsTVDraw = class abstract(TObject) strict protected - /// Gets the collection ID, if any, associated with a tree node. + /// Gets the vault ID, if any, associated with a tree node. /// /// TTreeNode [in] Node to be checked. - /// TCollectionID. Associated collection ID. If Node - /// has no associated collection then a null collection ID is returned. - /// - function GetCollectionID(const Node: TTreeNode): TCollectionID; + /// TVaultID. Associated vault ID. If Node has no + /// associated vault then a null vault ID is returned. + function GetCollectionID(const Node: TTreeNode): TVaultID; virtual; abstract; function IsSectionHeadNode(const Node: TTreeNode): Boolean; diff --git a/Src/UTextSnippetDoc.pas b/Src/UTextSnippetDoc.pas index f131dd624..e38a66965 100644 --- a/Src/UTextSnippetDoc.pas +++ b/Src/UTextSnippetDoc.pas @@ -47,11 +47,11 @@ TTextSnippetDoc = class(TSnippetDoc) procedure InitialiseDoc; override; /// Output given heading, i.e. snippet name for snippet from a - /// given collection. + /// given vault. /// Heading is output the same regardless of the snippet's /// collection. procedure RenderHeading(const Heading: string; - const ACollectionID: TCollectionID); override; + const ACollectionID: TVaultID); override; /// Interprets and adds given snippet description to document. /// /// Active text is converted to word-wrapped plain text @@ -166,7 +166,7 @@ procedure TTextSnippetDoc.RenderExtra(const ExtraText: IActiveText); end; procedure TTextSnippetDoc.RenderHeading(const Heading: string; - const ACollectionID: TCollectionID); + const ACollectionID: TVaultID); begin fWriter.WriteLine(Heading); end; diff --git a/Src/UWBExternal.pas b/Src/UWBExternal.pas index 851b1e93a..758946f5c 100644 --- a/Src/UWBExternal.pas +++ b/Src/UWBExternal.pas @@ -157,7 +157,7 @@ procedure TWBExternal.DisplaySnippet(const Key, CollectionIDAsHex: WideString; try if Assigned(fNotifier) then fNotifier.DisplaySnippet( - Key, TCollectionID.CreateFromHexString(CollectionIDAsHex), NewTab + Key, TVaultID.CreateFromHexString(CollectionIDAsHex), NewTab ); except HandleException; @@ -172,7 +172,7 @@ procedure TWBExternal.EditSnippet(const Key: WideString; try if Assigned(fNotifier) then fNotifier.EditSnippet( - Key, TCollectionID.CreateFromHexString(CollectionIDAsHex) + Key, TVaultID.CreateFromHexString(CollectionIDAsHex) ); except HandleException; From 663bf4b64e907e364fa70caf2a9a20f4e6aee12f Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 08:30:16 +0000 Subject: [PATCH 150/222] Rename ECollectionID as EVaultID Made minimal changes affected code in order to allow compilation to succeed. --- Src/DB.UCollections.pas | 4 ++-- Src/USnippetIDListIOHandler.pas | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 2312f3f26..0387f3cc5 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -62,7 +62,7 @@ TComparer = class(TInterfacedObject, class operator NotEqual(Left, Right: TVaultID): Boolean; end; - ECollectionID = class(ECodeSnip); + EVaultID = class(ECodeSnip); TCollection = class strict private @@ -426,7 +426,7 @@ class function TVaultID.CreateFromHexString( ConvertedBytes: TBytes; begin if not TryHexStringToBytes(AHexStr, ConvertedBytes) then - raise ECollectionID.Create(SBadHexString); + raise EVaultID.Create(SBadHexString); Result := TVaultID.Create(ConvertedBytes); end; diff --git a/Src/USnippetIDListIOHandler.pas b/Src/USnippetIDListIOHandler.pas index fc1165ff1..8efbd1e2b 100644 --- a/Src/USnippetIDListIOHandler.pas +++ b/Src/USnippetIDListIOHandler.pas @@ -110,7 +110,7 @@ function TSnippetIDListFileReader.ReadFile(const FileName: string): except on E: ETabSeparatedReader do raise ESnippetIDListFileReader.Create(E); - on E: ECollectionID do + on E: EVaultID do raise ESnippetIDListFileReader.Create(E); else raise; From a9737a527a544d8f3a7ee82cd7bd5a638bdac293 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 08:31:12 +0000 Subject: [PATCH 151/222] Rename TCollection as TVault Made minimal changes affected code in order to allow compilation to succeed. Updated many comments re those minimal changes. --- Src/DB.UCollections.pas | 86 +++++++++++++++++----------------- Src/DB.UDatabaseIO.pas | 42 ++++++++--------- Src/DB.UMain.pas | 4 +- Src/FmAboutDlg.pas | 12 ++--- Src/FmCollectionBackup.pas | 6 +-- Src/FmDeleteUserDBDlg.pas | 10 ++-- Src/FmDuplicateSnippetDlg.pas | 2 +- Src/FmSelectionSearchDlg.pas | 23 +++++---- Src/FrDisplayPrefs.pas | 6 +-- Src/UCollectionListAdapter.pas | 18 +++---- Src/UDetailPageHTML.pas | 2 +- Src/UPreferences.pas | 8 ++-- Src/URTFCategoryDoc.pas | 2 +- Src/URTFSnippetDoc.pas | 2 +- Src/USaveUnitMgr.pas | 14 +++--- Src/USnippetDoc.pas | 2 +- Src/USnippetSourceGen.pas | 14 +++--- Src/UUserDBBackup.pas | 30 +++++------- Src/UUserDBMgr.pas | 45 +++++++++--------- Src/UUserDBMove.pas | 12 ++--- 20 files changed, 166 insertions(+), 174 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 0387f3cc5..3e271a773 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -64,7 +64,7 @@ TComparer = class(TInterfacedObject, EVaultID = class(ECodeSnip); - TCollection = class + TVault = class strict private var fUID: TVaultID; @@ -75,13 +75,13 @@ TCollection = class public type TComparer = class(TInterfacedObject, - IComparer, IEqualityComparer + IComparer, IEqualityComparer ) public - function Compare(const Left, Right: TCollection): Integer; - function Equals(const Left, Right: TCollection): Boolean; + function Compare(const Left, Right: TVault): Integer; + function Equals(const Left, Right: TVault): Boolean; reintroduce; - function GetHashCode(const Value: TCollection): Integer; + function GetHashCode(const Value: TVault): Integer; reintroduce; end; /// Creates a collection record. @@ -114,31 +114,31 @@ TComparer = class(TInterfacedObject, TCollections = class sealed(TSingleton) strict private var - fItems: TList; - function GetItem(const Idx: Integer): TCollection; - procedure DoUpdate(const Idx: Integer; const ACollection: TCollection); + fItems: TList; + function GetItem(const Idx: Integer): TVault; + procedure DoUpdate(const Idx: Integer; const ACollection: TVault); class function GetInstance: TCollections; static; strict protected procedure Initialize; override; procedure Finalize; override; public class property Instance: TCollections read GetInstance; - function GetEnumerator: TEnumerator; + function GetEnumerator: TEnumerator; function IndexOfID(const AUID: TVaultID): Integer; function ContainsID(const AUID: TVaultID): Boolean; function ContainsName(const AName: string): Boolean; - function GetCollection(const AUID: TVaultID): TCollection; - function Default: TCollection; - procedure Add(const ACollection: TCollection); - procedure Update(const ACollection: TCollection); - procedure AddOrUpdate(const ACollection: TCollection); + function GetCollection(const AUID: TVaultID): TVault; + function Default: TVault; + procedure Add(const ACollection: TVault); + procedure Update(const ACollection: TVault); + procedure AddOrUpdate(const ACollection: TVault); procedure Delete(const AUID: TVaultID); procedure Clear; procedure Save; - function ToArray: TArray; + function ToArray: TArray; function GetAllIDs: TArray; function Count: Integer; - property Items[const Idx: Integer]: TCollection read GetItem; default; + property Items[const Idx: Integer]: TVault read GetItem; default; end; TCollectionsPersist = record @@ -150,7 +150,7 @@ TCollectionsPersist = record StorageFormatKey = 'Storage.Format'; StorageDirectoryKey = 'Storage.Directory'; class procedure SaveCollection(const AOrdinal: Cardinal; - const ACollection: TCollection); static; + const ACollection: TVault); static; class procedure LoadCollection(const AOrdinal: Cardinal; const ACollections: TCollections); static; public @@ -173,9 +173,9 @@ implementation resourcestring SBadHexString = 'Invalid Hex String.'; -{ TCollection } +{ TVault } -constructor TCollection.Create(const AUID: TVaultID; const AName: string; +constructor TVault.Create(const AUID: TVaultID; const AName: string; const AStorage: TDataStorageDetails); var TrimmedName: string; @@ -192,34 +192,34 @@ constructor TCollection.Create(const AUID: TVaultID; const AName: string; fStorage := AStorage; end; -function TCollection.IsDefault: Boolean; +function TVault.IsDefault: Boolean; begin Result := UID = TVaultID.Default; end; -function TCollection.IsValid: Boolean; +function TVault.IsValid: Boolean; begin - {TODO: Constructor enforces all these requirements, so #TCollection.IsValid + {TODO: Constructor enforces all these requirements, so #TVault.IsValid may not be needed.} Result := not fUID.IsNull and (fName <> '') and (fStorage.Format <> TDataFormatKind.Error); end; -procedure TCollection.SetMetaData(const AValue: TMetaData); +procedure TVault.SetMetaData(const AValue: TMetaData); begin fMetaData := AValue.Clone; end; { TCollections } -procedure TCollections.Add(const ACollection: TCollection); +procedure TCollections.Add(const ACollection: TVault); begin if not ContainsID(ACollection.UID) then fItems.Add(ACollection); end; -procedure TCollections.AddOrUpdate(const ACollection: TCollection); +procedure TCollections.AddOrUpdate(const ACollection: TVault); var Idx: Integer; begin @@ -247,7 +247,7 @@ function TCollections.ContainsID(const AUID: TVaultID): function TCollections.ContainsName(const AName: string): Boolean; var - Collection: TCollection; + Collection: TVault; begin Result := False; for Collection in fItems do @@ -260,7 +260,7 @@ function TCollections.Count: Integer; Result := fItems.Count; end; -function TCollections.Default: TCollection; +function TCollections.Default: TVault; begin Result := GetCollection(TVaultID.Default); end; @@ -282,9 +282,9 @@ procedure TCollections.Delete(const AUID: TVaultID); end; procedure TCollections.DoUpdate(const Idx: Integer; - const ACollection: TCollection); + const ACollection: TVault); var - OldEntry: TCollection; + OldEntry: TVault; begin OldEntry := fItems[Idx]; fItems[Idx] := ACollection; @@ -307,7 +307,7 @@ function TCollections.GetAllIDs: TArray; Result[Idx] := fItems[Idx].UID; end; -function TCollections.GetCollection(const AUID: TVaultID): TCollection; +function TCollections.GetCollection(const AUID: TVaultID): TVault; var Idx: Integer; begin @@ -317,7 +317,7 @@ function TCollections.GetCollection(const AUID: TVaultID): TCollection; Result := fItems[Idx]; end; -function TCollections.GetEnumerator: TEnumerator; +function TCollections.GetEnumerator: TEnumerator; begin Result := fItems.GetEnumerator; end; @@ -327,7 +327,7 @@ class function TCollections.GetInstance: TCollections; Result := TCollections.Create; end; -function TCollections.GetItem(const Idx: Integer): TCollection; +function TCollections.GetItem(const Idx: Integer): TVault; begin Result := fItems[Idx]; end; @@ -344,12 +344,12 @@ function TCollections.IndexOfID(const AUID: TVaultID): Integer; procedure TCollections.Initialize; begin - fItems := TList.Create; + fItems := TList.Create; TCollectionsPersist.Load(Self); // Ensure there is always at least the default collection present if not ContainsID(TVaultID.Default) then Add( - TCollection.Create( + TVault.Create( TVaultID.Default, 'Default', TDataStorageDetails.Create( @@ -365,12 +365,12 @@ procedure TCollections.Save; TCollectionsPersist.Save(Self); end; -function TCollections.ToArray: TArray; +function TCollections.ToArray: TArray; begin Result := fItems.ToArray; end; -procedure TCollections.Update(const ACollection: TCollection); +procedure TCollections.Update(const ACollection: TVault); var Idx: Integer; begin @@ -517,7 +517,7 @@ class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; ConfigSection: ISettingsSection; UID: TVaultID; Name: string; - Collection: TCollection; + Collection: TVault; StorageDetails: TDataStorageDetails; begin ConfigSection := Settings.ReadSection(ssCollection, IntToStr(AOrdinal)); @@ -533,7 +533,7 @@ class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; ), ConfigSection.GetString(StorageDirectoryKey, '') ); - Collection := TCollection.Create(UID, Name, StorageDetails); + Collection := TVault.Create(UID, Name, StorageDetails); ACollections.Add(Collection); end; @@ -553,7 +553,7 @@ class procedure TCollectionsPersist.Save(const end; class procedure TCollectionsPersist.SaveCollection(const AOrdinal: Cardinal; - const ACollection: TCollection); + const ACollection: TVault); var ConfigSection: ISettingsSection; begin @@ -566,19 +566,19 @@ class procedure TCollectionsPersist.SaveCollection(const AOrdinal: Cardinal; ConfigSection.Save; end; -{ TCollection.TComparer } +{ TVault.TComparer } -function TCollection.TComparer.Compare(const Left, Right: TCollection): Integer; +function TVault.TComparer.Compare(const Left, Right: TVault): Integer; begin Result := TVaultID.Compare(Left.UID, Right.UID); end; -function TCollection.TComparer.Equals(const Left, Right: TCollection): Boolean; +function TVault.TComparer.Equals(const Left, Right: TVault): Boolean; begin Result := Left.UID = Right.UID; end; -function TCollection.TComparer.GetHashCode(const Value: TCollection): Integer; +function TVault.TComparer.GetHashCode(const Value: TVault): Integer; begin Result := Value.UID.Hash; end; diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 3baacb4f0..02b1bed74 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -94,16 +94,14 @@ interface TDatabaseIOFactory = class(TNoConstructObject) public /// Creates and returns an object to be used to load the given - /// collection's data in the correct format. Nil is returned if no loader - /// object is supported. - class function CreateDBLoader(const Collection: TCollection): - IDataFormatLoader; + /// vault's data in the correct format. Nil is returned if no loader object + /// is supported. + class function CreateDBLoader(const Collection: TVault): IDataFormatLoader; /// Creates and returns an object to be used to save the given - /// collection's data in the correct format. Nil is return if no saver - /// object is supported. - class function CreateDBSaver(const Collection: TCollection): - IDataFormatSaver; + /// vaults's data in the correct format. Nil is return if no saver object + /// is supported. + class function CreateDBSaver(const Collection: TVault): IDataFormatSaver; /// Creates and returns an object to be used to load a list of /// globally stored categories. @@ -170,7 +168,7 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) fSnipList: TSnippetList; // Receives list of snippets fCategories: TCategoryList; // Receives list of categories fFactory: IDBDataItemFactory; // Object creates new categories and snippets - fCollection: TCollection; // Collection being loaded + fCollection: TVault; // Vault being loaded procedure LoadSnippets(const Cat: TCategory); {Loads all snippets in a category. @param Cat [in] Category to be loaded. @@ -220,9 +218,9 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) } property Categories: TCategoryList read fCategories; {Reference to category list} - property Collection: TCollection read fCollection; + property Collection: TVault read fCollection; public - constructor Create(const ACollection: TCollection); + constructor Create(const ACollection: TVault); { IDataFormatLoader method } procedure Load(const SnipList: TSnippetList; const Categories: TCategoryList; @@ -301,7 +299,7 @@ TFormatSaver = class abstract (TInterfacedObject, fSnipList: TSnippetList; // List of snippets to be written fCategories: TCategoryList; // List of categories to be written fProvider: IDBDataProvider; // Object used to get data to be written - fCollection: TCollection; // Collection being written + fCollection: TVault; // Vault being written /// Writes information about all snippets belonging to the /// collection. @@ -334,11 +332,11 @@ TFormatSaver = class abstract (TInterfacedObject, function CreateWriter: IDataWriter; virtual; abstract; /// Collection being saved. - property Collection: TCollection read fCollection; + property Collection: TVault read fCollection; public - /// Creates object that can save the given collection. - constructor Create(const ACollection: TCollection); + /// Creates object that can save the given vault. + constructor Create(const ACollection: TVault); /// Saves data to storage. /// TSnippetList [in] List of all snippets @@ -378,7 +376,7 @@ TDCSCV2FormatSaver = class(TFormatSaver, public /// Creates object that can save the given collection. - constructor Create(const ACollection: TCollection); + constructor Create(const ACollection: TVault); /// Saves data to storage. /// TSnippetList [in] List of all snippets @@ -472,7 +470,7 @@ TGlobalCategorySaver = class(TInterfacedObject, IGlobalCategorySaver) { TDatabaseIOFactory } -class function TDatabaseIOFactory.CreateDBLoader(const Collection: TCollection): +class function TDatabaseIOFactory.CreateDBLoader(const Collection: TVault): IDataFormatLoader; begin {TODO -cUDatabaseIO: Revise database loaders to get file path and other @@ -489,8 +487,8 @@ class function TDatabaseIOFactory.CreateDBLoader(const Collection: TCollection): end; end; -class function TDatabaseIOFactory.CreateDBSaver( - const Collection: TCollection): IDataFormatSaver; +class function TDatabaseIOFactory.CreateDBSaver(const Collection: TVault): + IDataFormatSaver; begin case Collection.Storage.Format of TDataFormatKind.DCSC_v2: @@ -518,7 +516,7 @@ class function TDatabaseIOFactory.CreateGlobalCategorySaver: { TDatabaseLoader } -constructor TDatabaseLoader.Create(const ACollection: TCollection); +constructor TDatabaseLoader.Create(const ACollection: TVault); begin inherited Create; fCollection := ACollection; @@ -761,7 +759,7 @@ function TNativeVaultFormatLoader.ErrorMessageHeading: string; { TFormatSaver } -constructor TFormatSaver.Create(const ACollection: TCollection); +constructor TFormatSaver.Create(const ACollection: TVault); begin inherited Create; fCollection := ACollection; @@ -852,7 +850,7 @@ procedure TDCSCV2FormatSaver.Backup; end; end; -constructor TDCSCV2FormatSaver.Create(const ACollection: TCollection); +constructor TDCSCV2FormatSaver.Create(const ACollection: TVault); begin inherited Create(ACollection); // Find a temp file name in system temp directory that doesn't yet exist diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 50a0e60b1..8e829fd51 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -1070,7 +1070,7 @@ procedure TDatabase.Load; var DataItemFactory: IDBDataItemFactory; CollectionLoader: IDataFormatLoader; - Collection: TCollection; + Collection: TVault; CatLoader: IGlobalCategoryLoader; begin // Clear the database @@ -1116,7 +1116,7 @@ procedure TDatabase.Save; var Provider: IDBDataProvider; CollectionSaver: IDataFormatSaver; - Collection: TCollection; + Collection: TVault; CatSaver: IGlobalCategorySaver; begin // Save categories diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index efd9a7c99..2bc36c6b8 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -131,10 +131,10 @@ TAboutDlg = class(TGenericViewDlg) /// information about the event. procedure HTMLEventHandler(Sender: TObject; const EventInfo: THTMLEventInfo); - /// Displays any meta data associated with a collection. - /// TCollection [in] Collection for which - /// meta data is to be displayed. - procedure DisplayCollectionInfo(ACollection: TCollection); + /// Displays any meta data associated with a vault. + /// TVault [in] Vault for which meta data + /// is to be displayed. + procedure DisplayCollectionInfo(ACollection: TVault); /// Displays content of a config file in a dialogue box or an /// error message if the file does not exist. /// string [in] Name of config file to display. @@ -298,7 +298,7 @@ procedure TAboutDlg.ConfigForm; end; var - Collection: TCollection; + Collection: TVault; TabIdx: Integer; resourcestring // Captions for custom controls @@ -333,7 +333,7 @@ procedure TAboutDlg.ConfigForm; InitHTMLFrames; end; -procedure TAboutDlg.DisplayCollectionInfo(ACollection: TCollection); +procedure TAboutDlg.DisplayCollectionInfo(ACollection: TVault); var HasEntries: Boolean; diff --git a/Src/FmCollectionBackup.pas b/Src/FmCollectionBackup.pas index e15697ab5..ae3388993 100644 --- a/Src/FmCollectionBackup.pas +++ b/Src/FmCollectionBackup.pas @@ -39,7 +39,7 @@ TCollectionBackupDlg = class(TGenericOKDlg) strict private var fFileName: string; - fCollection: TCollection; + fCollection: TVault; fCollList: TCollectionListAdapter; function GetFilePathFromEditCtrl: string; strict protected @@ -47,7 +47,7 @@ TCollectionBackupDlg = class(TGenericOKDlg) procedure ArrangeForm; override; public class function Execute(AOwner: TComponent; - out AFileName: string; out ACollection: TCollection): Boolean; + out AFileName: string; out ACollection: TVault): Boolean; end; implementation @@ -119,7 +119,7 @@ procedure TCollectionBackupDlg.ConfigForm; end; class function TCollectionBackupDlg.Execute(AOwner: TComponent; - out AFileName: string; out ACollection: TCollection): Boolean; + out AFileName: string; out ACollection: TVault): Boolean; var Dlg: TCollectionBackupDlg; begin diff --git a/Src/FmDeleteUserDBDlg.pas b/Src/FmDeleteUserDBDlg.pas index 353aff673..e453856d7 100644 --- a/Src/FmDeleteUserDBDlg.pas +++ b/Src/FmDeleteUserDBDlg.pas @@ -45,9 +45,9 @@ TDeleteUserDBDlg = class(TGenericOKDlg, INoPublicConstruct) cConfirmText = 'DELETE MY SNIPPETS'; var fPermissionGranted: Boolean; - fCollection: TCollection; + fCollection: TVault; fCollList: TCollectionListAdapter; - function SelectedCollection: TCollection; + function SelectedCollection: TVault; function IsValidPassword: Boolean; strict protected /// Protected constructor that sets up form. @@ -55,7 +55,7 @@ TDeleteUserDBDlg = class(TGenericOKDlg, INoPublicConstruct) procedure ConfigForm; override; procedure ArrangeForm; override; public - class function Execute(AOwner: TComponent; out ACollection: TCollection): Boolean; + class function Execute(AOwner: TComponent; out ACollection: TVault): Boolean; end; implementation @@ -110,7 +110,7 @@ procedure TDeleteUserDBDlg.ConfigForm; end; class function TDeleteUserDBDlg.Execute(AOwner: TComponent; - out ACollection: TCollection): Boolean; + out ACollection: TVault): Boolean; var Dlg: TDeleteUserDBDlg; begin @@ -149,7 +149,7 @@ function TDeleteUserDBDlg.IsValidPassword: Boolean; Result := edConfirm.Text = cConfirmText; end; -function TDeleteUserDBDlg.SelectedCollection: TCollection; +function TDeleteUserDBDlg.SelectedCollection: TVault; begin Result := fCollList.Collection(cbCollection.ItemIndex); end; diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index ab2b45a76..57f2b5f1d 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -188,7 +188,7 @@ procedure TDuplicateSnippetDlg.HandleException(const E: Exception); procedure TDuplicateSnippetDlg.InitForm; var SnippetCat: TCategory; - SnippetColl: TCollection; + SnippetColl: TVault; begin inherited; edDisplayName.Text := fSnippet.DisplayName; diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index 4a756351c..7bde72436 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -121,21 +121,20 @@ implementation TCollectionMenuItem = class(TMenuItem) strict private var - /// Value of CompilerVer property - fCollection: TCollection; + /// Value of Collection property + fCollection: TVault; public /// Constructs a menu item with all required properties and event /// handlers. /// TComponent [in] Menu item's owner. - /// TCollection [in] Collection whose name - /// is displayed in menu item. + /// TVault [in] Vault whose name is + /// displayed in menu item. /// TNotifyEvent [in] Reference to an event /// handler for menu item's OnClick event. - constructor Create(AOwner: TComponent; const ACollection: TCollection; + constructor Create(AOwner: TComponent; const ACollection: TVault; const AClickHandler: TNotifyEvent); reintroduce; - /// Version number of compiler whose name is displayed in menu - /// item's caption. - property Collection: TCollection read fCollection write fCollection; + /// Vault whose name is displayed in the menu item. + property Collection: TVault read fCollection write fCollection; end; { TSelectionSearchDlg } @@ -261,8 +260,8 @@ procedure TSelectionSearchDlg.InitForm; procedure TSelectionSearchDlg.PopulateCollectionsMenu; - /// Adds a menu item for given collection to the pop-up menu. - procedure AddMenuItem(const ACollection: TCollection); + /// Adds a menu item for given vault to the pop-up menu. + procedure AddMenuItem(const ACollection: TVault); begin mnuCollections.Items.Add( TCollectionMenuItem.Create( @@ -272,7 +271,7 @@ procedure TSelectionSearchDlg.PopulateCollectionsMenu; end; var - Collection: TCollection; + Collection: TVault; begin for Collection in TCollections.Instance do AddMenuItem(Collection); @@ -315,7 +314,7 @@ procedure TSelectionSearchDlg.SetSelectedSnippets(const Value: TSnippetList); { TCollectionMenuItem } constructor TCollectionMenuItem.Create(AOwner: TComponent; - const ACollection: TCollection; const AClickHandler: TNotifyEvent); + const ACollection: TVault; const AClickHandler: TNotifyEvent); begin inherited Create(AOwner); Caption := ACollection.Name; diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index ddc7ff5d7..84148a49e 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -162,7 +162,7 @@ procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences; @param Prefs [in] Object that provides info used to update controls. } var - Collection: TCollection; + Collection: TVault; begin cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); Assert(cbCollection.ItemIndex >= 0, @@ -280,7 +280,7 @@ procedure TDisplayPrefsFrame.ArrangeControls; procedure TDisplayPrefsFrame.btnDefColoursClick(Sender: TObject); var - Collection: TCollection; + Collection: TVault; begin // Restores default heading and source code background colours in colour // combo boxes @@ -388,7 +388,7 @@ procedure TDisplayPrefsFrame.Deactivate(const Prefs: IPreferences); @param Prefs [in] Object used to store information. } var - Collection: TCollection; + Collection: TVault; begin Prefs.ShowNewSnippetsInNewTabs := chkSnippetsInNewTab.Checked; Prefs.ShowEmptySections := not chkHideEmptySections.Checked; diff --git a/Src/UCollectionListAdapter.pas b/Src/UCollectionListAdapter.pas index fbf932efb..63c707af5 100644 --- a/Src/UCollectionListAdapter.pas +++ b/Src/UCollectionListAdapter.pas @@ -29,7 +29,7 @@ interface TCollectionListAdapter = class(TObject) strict private var - fCollectionList: TSortedList; + fCollectionList: TSortedList; public @@ -49,8 +49,8 @@ TCollectionListAdapter = class(TObject) /// /// Integer [in] Index of required collection. /// - /// TCollection. Required collection. - function Collection(const AIndex: Integer): TCollection; + /// TVault. Required vault. + function Collection(const AIndex: Integer): TVault; /// Gets list index of the vault with the specified UID. function IndexOfUID(const AUID: TVaultID): Integer; @@ -67,19 +67,19 @@ implementation { TCollectionListAdapter } -function TCollectionListAdapter.Collection(const AIndex: Integer): TCollection; +function TCollectionListAdapter.Collection(const AIndex: Integer): TVault; begin Result := fCollectionList[AIndex]; end; constructor TCollectionListAdapter.Create; var - Collection: TCollection; + Collection: TVault; begin inherited Create; - fCollectionList := TSortedList.Create( - TDelegatedComparer.Create( - function (const Left, Right: TCollection): Integer + fCollectionList := TSortedList.Create( + TDelegatedComparer.Create( + function (const Left, Right: TVault): Integer begin Result := StrCompareText(Left.Name, Right.Name) end @@ -107,7 +107,7 @@ function TCollectionListAdapter.IndexOfUID(const AUID: TVaultID): Integer; procedure TCollectionListAdapter.ToStrings(const AStrings: TStrings); var - Collection: TCollection; + Collection: TVault; begin for Collection in fCollectionList do AStrings.Add(Collection.Name); diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 1f7905dac..43e138d65 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -414,7 +414,7 @@ function TWelcomePageHTML.GetTemplateResName: string; procedure TWelcomePageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); var - Collection: TCollection; + Collection: TVault; CollectionCount: Integer; CollectionList: TStringBuilder; Compilers: ICompilers; diff --git a/Src/UPreferences.pas b/Src/UPreferences.pas index 16785a5d0..274ee872b 100644 --- a/Src/UPreferences.pas +++ b/Src/UPreferences.pas @@ -731,7 +731,7 @@ function Preferences: IPreferences; procedure TPreferences.Assign(const Src: IInterface); var SrcPref: IPreferences; // IPreferences interface of Src - Collection: TCollection; + Collection: TVault; begin // Get IPreferences interface of given object if not Supports(Src, IPreferences, SrcPref) then @@ -1056,7 +1056,7 @@ procedure TPreferences.SetWarnings(Warnings: IWarnings); function TPreferencesPersist.Clone: IInterface; var NewPref: IPreferences; // reference to new object's IPreferences interface - Collection: TCollection; + Collection: TVault; begin // Create new object Result := TPreferences.Create; @@ -1094,7 +1094,7 @@ function TPreferencesPersist.Clone: IInterface; constructor TPreferencesPersist.Create; var Storage: ISettingsSection; // object used to access persistent storage - Collection: TCollection; + Collection: TVault; const // Default margin size in millimeters cPrintPageMarginSizeMM = 25.0; @@ -1205,7 +1205,7 @@ constructor TPreferencesPersist.Create; destructor TPreferencesPersist.Destroy; var Storage: ISettingsSection; // object used to access persistent storage - Collection: TCollection; + Collection: TVault; begin // Wreite meta section (no sub-section name) Storage := Settings.EmptySection(ssPreferences); diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index 0d4009200..01afabc68 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -97,7 +97,7 @@ implementation constructor TRTFCategoryDoc.Create(const UseColour: Boolean); var - Collection: TCollection; + Collection: TVault; begin inherited Create; fUseColour := UseColour; diff --git a/Src/URTFSnippetDoc.pas b/Src/URTFSnippetDoc.pas index 6a10e9529..1a2ea1d57 100644 --- a/Src/URTFSnippetDoc.pas +++ b/Src/URTFSnippetDoc.pas @@ -163,7 +163,7 @@ function TRTFSnippetDoc.FinaliseDoc: TEncodedData; procedure TRTFSnippetDoc.InitialiseDoc; var - Collection: TCollection; + Collection: TVault; begin // Create object used to build main rich text document fBuilder := TRTFBuilder.Create(0); // Use default code page diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index 92debb94c..346f212de 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -45,9 +45,9 @@ TSaveUnitMgr = class(TSaveSourceMgr) /// Name of generated unit. /// If empty string a default name is used. fUnitName: string; - /// List of collections that have contributed snippets to the - /// source code being generated. - fCollections: TList; + /// List of vaults that have contributed snippets to the source + /// code being generated. + fCollections: TList; /// Gets name of unit to be used in generated code. function UnitName: string; /// Creates a string list containing comments to be written to @@ -152,7 +152,7 @@ function TSaveUnitMgr.CreateHeaderComments: IStringList; generator code in USnippetSourceGen and in TSnippetDoc.CollectionInfo - extract common code.} - function CreditsLine(const ACollection: TCollection): string; + function CreditsLine(const ACollection: TVault): string; var MetaData: TMetaData; begin @@ -171,7 +171,7 @@ function TSaveUnitMgr.CreateHeaderComments: IStringList; end; var - Collection: TCollection; + Collection: TVault; Credits: string; begin Result := TIStringList.Create; @@ -266,12 +266,12 @@ function TSaveUnitMgr.GetFileTypeDesc(const FileType: TSourceFileType): string; constructor TSaveUnitMgr.InternalCreate(const Snips: TSnippetList); var Snippet: TSnippet; // references each snippet in list - Collection: TCollection; + Collection: TVault; begin Assert(Assigned(Snips), ClassName + '.InternalCreate: Snips is nil'); inherited InternalCreate; - fCollections := TList.Create(TCollection.TComparer.Create); + fCollections := TList.Create(TVault.TComparer.Create); // Create source generator and initialize it with required snippets fSourceGen := TSourceGen.Create; diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index 68a0bbac1..16e2bad80 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -134,7 +134,7 @@ function TSnippetDoc.CollectionInfo(const ACollectionID: TVaultID): string; sCollectionInfo = 'A snippet from the "%s" collection.'; var MetaData: TMetaData; - Collection: TCollection; + Collection: TVault; begin Collection := TCollections.Instance.GetCollection(ACollectionID); MetaData := Collection.MetaData; diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index e4b32be2f..bf2cf1b1a 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -37,9 +37,9 @@ interface } TSnippetSourceGen = class sealed(TNoPublicConstructObject) strict private - /// List of collections that have contributed snippets to the - /// source code being generated. - fCollections: TList; + /// List of vaults that have contributed snippets to the source + /// code being generated. + fCollections: TList; fGenerator: TSourceGen; {Object used to generate the source code} procedure Initialize(View: IView); @@ -112,7 +112,7 @@ function TSnippetSourceGen.BuildHeaderComments: IStringList; } var MetaData: TMetaData; - Collection: TCollection; + Collection: TVault; Credits: string; resourcestring // Comment to be included at top of snippet @@ -122,7 +122,7 @@ function TSnippetSourceGen.BuildHeaderComments: IStringList; sCollectionList = 'The code was sourced from the following collections:'; sCollectionCredit = 'Collection "%0:s" is licensed under the %1:s'; - function CreditsLine(const ACollection: TCollection): string; + function CreditsLine(const ACollection: TVault): string; begin MetaData := ACollection.MetaData; Result := ''; @@ -247,7 +247,7 @@ procedure TSnippetSourceGen.Initialize(View: IView); var Snips: TSnippetList; // list of snippets in a category to display Snippet: TSnippet; // a snippet in Snips list - Collection: TCollection; + Collection: TVault; begin // Record required snippet(s) if Supports(View, ISnippetView) then @@ -286,7 +286,7 @@ constructor TSnippetSourceGen.InternalCreate(View: IView); Assert(CanGenerate(View), ClassName + '.InternalCreate: View not supported'); inherited InternalCreate; fGenerator := TSourceGen.Create; - fCollections := TList.Create(TCollection.TComparer.Create); + fCollections := TList.Create(TVault.TComparer.Create); Initialize(View); end; diff --git a/Src/UUserDBBackup.pas b/Src/UUserDBBackup.pas index c6a1a8323..05eaecc77 100644 --- a/Src/UUserDBBackup.pas +++ b/Src/UUserDBBackup.pas @@ -26,21 +26,19 @@ interface type - { - TUserDBBackup: - Sealed class that can create and restore backups of the user database. - Backups are single files. See UFolderBackup for details of file format. - } + {TODO -cVault: Rename TUserDBBackup class and UUserDBBackup unit.} + + /// Sealed class that can create and restore backups of vaults. + /// Backups are single files. + /// See UFolderBackup for details of the file format. + /// TUserDBBackup = class sealed(TFolderBackup) strict private - class function MakeFileID(const ACollection: TCollection): SmallInt; + class function MakeFileID(const ACollection: TVault): SmallInt; public - constructor Create(const BackupFile: string; - const ACollection: TCollection); - {Class constructor. Sets up object to backup user database to a specified - file. - @param BackupFile [in] Name of backup file. - } + /// Object constructor. Sets up the object to backup the given + /// vault to the given backup file. + constructor Create(const BackupFile: string; const ACollection: TVault); end; @@ -57,11 +55,7 @@ implementation { TUserDBBackup } constructor TUserDBBackup.Create(const BackupFile: string; - const ACollection: TCollection); - {Class constructor. Sets up object to backup user database to a specified - file. - @param BackupFile [in] Name of backup file. - } + const ACollection: TVault); begin inherited Create( ACollection.Storage.Directory, @@ -71,7 +65,7 @@ constructor TUserDBBackup.Create(const BackupFile: string; ); end; -class function TUserDBBackup.MakeFileID(const ACollection: TCollection): +class function TUserDBBackup.MakeFileID(const ACollection: TVault): SmallInt; begin // Backup file ID is $Fxxx where xxx is ordinal value of format kind. diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 56dc38823..fd1deb5bb 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -181,27 +181,27 @@ TRestoreThread = class(TThread) /// Name of backup file to be restored. fBakFileName: string; - fCollection: TCollection; + fCollection: TVault; strict protected /// Restores the user database from a backup. procedure Execute; override; public /// Constructs a new, suspended, thread that can restore the - /// database from the given backup file. + /// given vault from the given backup file. constructor Create(const BakFileName: string; - const ACollection: TCollection); + const ACollection: TVault); end; public - /// Performs a user database restoration operation from in a - /// background thread and displays a wait diaogue box if the operation - /// takes more than a given time to execute. Blocks until the thread - /// terminates. + /// Performs the restoration of a vault from a background thread + /// and displays a wait diaogue box if the operation takes more than a + /// given time to execute. Blocks until the thread terminates. /// TComponent [in] Component that owns the dialogue /// box, over which it is aligned. /// string [in] Name of backup file to be /// restored. + /// TVault Vault being restored. class procedure Execute(AOwner: TComponent; const BakFileName: string; - const ACollection: TCollection); + const ACollection: TVault); end; type @@ -217,26 +217,27 @@ TBackupThread = class(TThread) /// Name of backup file to be created. fBakFileName: string; - fCollection: TCollection; + fCollection: TVault; strict protected /// Backs up the user database. procedure Execute; override; public /// Constructs a new, suspended, thread that can backup the - /// database to the given backup file. + /// given vault to the given backup file. constructor Create(const BakFileName: string; - const ACollection: TCollection); + const ACollection: TVault); end; public - /// Performs a user database backup operation from in a background - /// thread and displays a wait diaogue box if the operation takes more than - /// a given time to execute. Blocks until the thread terminates. + /// Performs a vault backup operation in a background thread and + /// displays a wait diaogue box if the operation takes more than a given + /// time to execute. Blocks until the thread terminates. /// TComponent [in] Component that owns the dialogue /// box, over which it is aligned. /// string [in] Name of backup file to be /// created. + /// TVault Vault being backed up. class procedure Execute(AOwner: TComponent; const BakFileName: string; - const ACollection: TCollection); + const ACollection: TVault); end; { TUserDBMgr } @@ -256,7 +257,7 @@ class procedure TUserDBMgr.AddSnippet; class procedure TUserDBMgr.BackupDatabase(ParentCtrl: TComponent); var FileName: string; - Collection: TCollection; + Collection: TVault; resourcestring sOverwritePrompt = '"%s" already exists. OK to overwrite?'; begin @@ -322,7 +323,7 @@ class procedure TUserDBMgr.DeleteACategory; class function TUserDBMgr.DeleteDatabase: Boolean; var - CollectionToDelete: TCollection; + CollectionToDelete: TVault; begin if not TDeleteUserDBDlg.Execute(nil, CollectionToDelete) then Exit(False); @@ -440,7 +441,7 @@ class procedure TUserDBMgr.RenameACategory; class function TUserDBMgr.RestoreDatabase(ParentCtrl: TComponent): Boolean; var FileName: string; - Collection: TCollection; + Collection: TVault; resourcestring sFileDoesNotExist = '"%s" does not exist.'; begin @@ -513,7 +514,7 @@ procedure TUserDBSaveUI.TSaveThread.Execute; { TUserDBRestoreUI } class procedure TUserDBRestoreUI.Execute(AOwner: TComponent; - const BakFileName: string; const ACollection: TCollection); + const BakFileName: string; const ACollection: TVault); resourcestring // Caption for wait dialog sWaitCaption = 'Restoring database files...'; @@ -531,7 +532,7 @@ class procedure TUserDBRestoreUI.Execute(AOwner: TComponent; { TUserDBRestoreUI.TRestoreThread } constructor TUserDBRestoreUI.TRestoreThread.Create(const BakFileName: string; - const ACollection: TCollection); + const ACollection: TVault); begin inherited Create(True); fBakFileName := BakFileName; @@ -553,7 +554,7 @@ procedure TUserDBRestoreUI.TRestoreThread.Execute; { TUserDBBackupUI } class procedure TUserDBBackupUI.Execute(AOwner: TComponent; - const BakFileName: string; const ACollection: TCollection); + const BakFileName: string; const ACollection: TVault); resourcestring // Caption for wait dialog sWaitCaption = 'Backing up database...'; @@ -571,7 +572,7 @@ class procedure TUserDBBackupUI.Execute(AOwner: TComponent; { TUserDBBackupUI.TBackupThread } constructor TUserDBBackupUI.TBackupThread.Create(const BakFileName: string; - const ACollection: TCollection); + const ACollection: TVault); begin inherited Create(True); fBakFileName := BakFileName; diff --git a/Src/UUserDBMove.pas b/Src/UUserDBMove.pas index 6e5959adb..f52ea6183 100644 --- a/Src/UUserDBMove.pas +++ b/Src/UUserDBMove.pas @@ -45,8 +45,8 @@ TUserDBMove = class(TObject) fSourceDir: string; /// Required new collection data directory. fDestDir: string; - /// Collection to be moved. - fCollection: TCollection; + /// Vault to be moved. + fCollection: TVault; /// Instance of class used to perform directory move. fDirCopier: TDirectoryCopier; /// Validates source and destination directories. @@ -72,11 +72,11 @@ TUserDBMove = class(TObject) constructor Create; /// Destroys current object instance. destructor Destroy; override; - /// Moves collection data from its current directory to the given - /// new directory. + /// Moves vault data from its current directory to the given new + /// directory. /// Raises EInOutError exceptions if an error occurs. /// - procedure MoveTo(const ACollection: TCollection; const ADirectory: string); + procedure MoveTo(const ACollection: TVault; const ADirectory: string); /// Event triggered just before file copying begins and once for /// each file copied. Reports progress towards completion of copy /// operation. @@ -116,7 +116,7 @@ destructor TUserDBMove.Destroy; inherited; end; -procedure TUserDBMove.MoveTo(const ACollection: TCollection; +procedure TUserDBMove.MoveTo(const ACollection: TVault; const ADirectory: string); begin fCollection := ACollection; From 6229207e082b17307597727fc7643a19799a004b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 08:41:56 +0000 Subject: [PATCH 152/222] Rename TCollections as TVaults Made minimal changes affected code in order to allow compilation to succeed. Updated a few comments re those minimal changes. --- Src/DB.UCollections.pas | 87 +++++++++++++++++----------------- Src/DB.UMain.pas | 8 ++-- Src/FmAboutDlg.pas | 2 +- Src/FmCodeImportDlg.pas | 2 +- Src/FmDuplicateSnippetDlg.pas | 2 +- Src/FmSWAGImportDlg.pas | 2 +- Src/FmSelectionSearchDlg.pas | 2 +- Src/FrDisplayPrefs.pas | 6 +-- Src/UCollectionListAdapter.pas | 2 +- Src/UDetailPageHTML.pas | 4 +- Src/UPreferences.pas | 8 ++-- Src/URTFCategoryDoc.pas | 2 +- Src/URTFSnippetDoc.pas | 2 +- Src/USaveUnitMgr.pas | 4 +- Src/USnippetDoc.pas | 2 +- Src/USnippetSourceGen.pas | 4 +- Src/UStatusBarMgr.pas | 2 +- Src/UUserDBMove.pas | 4 +- 18 files changed, 72 insertions(+), 73 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 3e271a773..c5ea563e1 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -111,27 +111,27 @@ TComparer = class(TInterfacedObject, function IsDefault: Boolean; end; - TCollections = class sealed(TSingleton) + TVaults = class sealed(TSingleton) strict private var fItems: TList; function GetItem(const Idx: Integer): TVault; - procedure DoUpdate(const Idx: Integer; const ACollection: TVault); - class function GetInstance: TCollections; static; + procedure DoUpdate(const Idx: Integer; const AVault: TVault); + class function GetInstance: TVaults; static; strict protected procedure Initialize; override; procedure Finalize; override; public - class property Instance: TCollections read GetInstance; + class property Instance: TVaults read GetInstance; function GetEnumerator: TEnumerator; function IndexOfID(const AUID: TVaultID): Integer; function ContainsID(const AUID: TVaultID): Boolean; function ContainsName(const AName: string): Boolean; function GetCollection(const AUID: TVaultID): TVault; function Default: TVault; - procedure Add(const ACollection: TVault); - procedure Update(const ACollection: TVault); - procedure AddOrUpdate(const ACollection: TVault); + procedure Add(const AVault: TVault); + procedure Update(const AVault: TVault); + procedure AddOrUpdate(const AVault: TVault); procedure Delete(const AUID: TVaultID); procedure Clear; procedure Save; @@ -152,10 +152,10 @@ TCollectionsPersist = record class procedure SaveCollection(const AOrdinal: Cardinal; const ACollection: TVault); static; class procedure LoadCollection(const AOrdinal: Cardinal; - const ACollections: TCollections); static; + const ACollections: TVaults); static; public - class procedure Save(const ACollections: TCollections); static; - class procedure Load(const ACollections: TCollections); static; + class procedure Save(const ACollections: TVaults); static; + class procedure Load(const ACollections: TVaults); static; end; implementation @@ -211,26 +211,26 @@ procedure TVault.SetMetaData(const AValue: TMetaData); fMetaData := AValue.Clone; end; -{ TCollections } +{ TVaults } -procedure TCollections.Add(const ACollection: TVault); +procedure TVaults.Add(const AVault: TVault); begin - if not ContainsID(ACollection.UID) then - fItems.Add(ACollection); + if not ContainsID(AVault.UID) then + fItems.Add(AVault); end; -procedure TCollections.AddOrUpdate(const ACollection: TVault); +procedure TVaults.AddOrUpdate(const AVault: TVault); var Idx: Integer; begin - Idx := IndexOfID(ACollection.UID); + Idx := IndexOfID(AVault.UID); if Idx < 0 then - fItems.Add(ACollection) + fItems.Add(AVault) else - DoUpdate(Idx, ACollection); + DoUpdate(Idx, AVault); end; -procedure TCollections.Clear; +procedure TVaults.Clear; var Idx: Integer; begin @@ -239,13 +239,13 @@ procedure TCollections.Clear; fItems.Clear; end; -function TCollections.ContainsID(const AUID: TVaultID): +function TVaults.ContainsID(const AUID: TVaultID): Boolean; begin Result := IndexOfID(AUID) >= 0; end; -function TCollections.ContainsName(const AName: string): Boolean; +function TVaults.ContainsName(const AName: string): Boolean; var Collection: TVault; begin @@ -255,17 +255,17 @@ function TCollections.ContainsName(const AName: string): Boolean; Exit(True); end; -function TCollections.Count: Integer; +function TVaults.Count: Integer; begin Result := fItems.Count; end; -function TCollections.Default: TVault; +function TVaults.Default: TVault; begin Result := GetCollection(TVaultID.Default); end; -procedure TCollections.Delete(const AUID: TVaultID); +procedure TVaults.Delete(const AUID: TVaultID); resourcestring sCantDelete = 'Cannot delete the default collection'; var @@ -281,24 +281,23 @@ procedure TCollections.Delete(const AUID: TVaultID); end; end; -procedure TCollections.DoUpdate(const Idx: Integer; - const ACollection: TVault); +procedure TVaults.DoUpdate(const Idx: Integer; const AVault: TVault); var OldEntry: TVault; begin OldEntry := fItems[Idx]; - fItems[Idx] := ACollection; + fItems[Idx] := AVault; OldEntry.Free; end; -procedure TCollections.Finalize; +procedure TVaults.Finalize; begin Save; Clear; fItems.Free; end; -function TCollections.GetAllIDs: TArray; +function TVaults.GetAllIDs: TArray; var Idx: Integer; begin @@ -307,7 +306,7 @@ function TCollections.GetAllIDs: TArray; Result[Idx] := fItems[Idx].UID; end; -function TCollections.GetCollection(const AUID: TVaultID): TVault; +function TVaults.GetCollection(const AUID: TVaultID): TVault; var Idx: Integer; begin @@ -317,22 +316,22 @@ function TCollections.GetCollection(const AUID: TVaultID): TVault; Result := fItems[Idx]; end; -function TCollections.GetEnumerator: TEnumerator; +function TVaults.GetEnumerator: TEnumerator; begin Result := fItems.GetEnumerator; end; -class function TCollections.GetInstance: TCollections; +class function TVaults.GetInstance: TVaults; begin - Result := TCollections.Create; + Result := TVaults.Create; end; -function TCollections.GetItem(const Idx: Integer): TVault; +function TVaults.GetItem(const Idx: Integer): TVault; begin Result := fItems[Idx]; end; -function TCollections.IndexOfID(const AUID: TVaultID): Integer; +function TVaults.IndexOfID(const AUID: TVaultID): Integer; var Idx: Integer; begin @@ -342,7 +341,7 @@ function TCollections.IndexOfID(const AUID: TVaultID): Integer; Exit(Idx); end; -procedure TCollections.Initialize; +procedure TVaults.Initialize; begin fItems := TList.Create; TCollectionsPersist.Load(Self); @@ -360,23 +359,23 @@ procedure TCollections.Initialize; ); end; -procedure TCollections.Save; +procedure TVaults.Save; begin TCollectionsPersist.Save(Self); end; -function TCollections.ToArray: TArray; +function TVaults.ToArray: TArray; begin Result := fItems.ToArray; end; -procedure TCollections.Update(const ACollection: TVault); +procedure TVaults.Update(const AVault: TVault); var Idx: Integer; begin - Idx := IndexOfID(ACollection.UID); + Idx := IndexOfID(AVault.UID); if Idx >= 0 then - DoUpdate(Idx, ACollection); + DoUpdate(Idx, AVault); end; { TVaultID } @@ -499,7 +498,7 @@ function TVaultID.TComparer.GetHashCode( { TCollectionsPersist } class procedure TCollectionsPersist.Load( - const ACollections: TCollections); + const ACollections: TVaults); var ConfigSection: ISettingsSection; Count: Integer; @@ -512,7 +511,7 @@ class procedure TCollectionsPersist.Load( end; class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; - const ACollections: TCollections); + const ACollections: TVaults); var ConfigSection: ISettingsSection; UID: TVaultID; @@ -538,7 +537,7 @@ class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; end; class procedure TCollectionsPersist.Save(const - ACollections: TCollections); + ACollections: TVaults); var ConfigSection: ISettingsSection; Idx: Integer; diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 8e829fd51..f98690de3 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -1080,8 +1080,8 @@ procedure TDatabase.Load; // to this unit DataItemFactory := TDBDataItemFactory.Create; try - // Load all collections - for Collection in TCollections.Instance do + // Load all vaults + for Collection in TVaults.Instance do begin CollectionLoader := TDatabaseIOFactory.CreateDBLoader(Collection); if Assigned(CollectionLoader) then @@ -1122,8 +1122,8 @@ procedure TDatabase.Save; // Save categories CatSaver := TDatabaseIOFactory.CreateGlobalCategorySaver; CatSaver.Save(fCategories); - // Save all collections - for Collection in TCollections.Instance do + // Save all vaults + for Collection in TVaults.Instance do begin Provider := TCollectionDataProvider.Create( Collection.UID, fSnippets, fCategories diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index 2bc36c6b8..1854dbe05 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -311,7 +311,7 @@ procedure TAboutDlg.ConfigForm; fPathInfoBoxes.Add( CreatePathInfoBox(sInstallPathGpCaption, TAppInfo.AppExeDir, 1) ); - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do begin Inc(TabIdx); fPathInfoBoxes.Add( diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index 6d025f65b..8de26cb78 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -339,7 +339,7 @@ procedure TCodeImportDlg.InitForm; begin fCollList.ToStrings(cbCollection.Items); Assert(cbCollection.Items.Count > 0, ClassName + '.InitForm: no collections'); - Assert(TCollections.Instance.ContainsID(TVaultID.Default), + Assert(TVaults.Instance.ContainsID(TVaultID.Default), ClassName + '.InitForm: default collection not found'); cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); Assert(cbCollection.ItemIndex >= 0, diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 57f2b5f1d..2bfdf79ee 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -202,7 +202,7 @@ procedure TDuplicateSnippetDlg.InitForm; Assert(Assigned(SnippetCat), ClassName + '.InitForm: invalid category'); cbCategory.ItemIndex := cbCategory.Items.IndexOf(SnippetCat.Description); - SnippetColl := TCollections.Instance.GetCollection(fSnippet.CollectionID); + SnippetColl := TVaults.Instance.GetCollection(fSnippet.CollectionID); cbCollection.ItemIndex := cbCollection.Items.IndexOf(SnippetColl.Name); chkEdit.Checked := fOptions.EditSnippetOnClose; diff --git a/Src/FmSWAGImportDlg.pas b/Src/FmSWAGImportDlg.pas index 0de76a9df..30bc39082 100644 --- a/Src/FmSWAGImportDlg.pas +++ b/Src/FmSWAGImportDlg.pas @@ -535,7 +535,7 @@ procedure TSWAGImportDlg.ConfigForm; fCollList.ToStrings(cbCollection.Items); Assert(cbCollection.Items.Count > 0, ClassName + '.ConfigForm: no collections'); - Assert(TCollections.Instance.ContainsID(TVaultID.Default), + Assert(TVaults.Instance.ContainsID(TVaultID.Default), ClassName + '.ConfigForm: default collection not found'); cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); Assert(cbCollection.ItemIndex >= 0, diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index 7bde72436..fb0054ee7 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -273,7 +273,7 @@ procedure TSelectionSearchDlg.PopulateCollectionsMenu; var Collection: TVault; begin - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do AddMenuItem(Collection); end; diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index 84148a49e..a94512587 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -174,7 +174,7 @@ procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences; chkSnippetsInNewTab.Checked := Prefs.ShowNewSnippetsInNewTabs; fGroupHeadingColourBox.Selected := Prefs.GroupHeadingColour; fSnippetHeadingColours.Clear; - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do fSnippetHeadingColours.Add( Collection.UID, Prefs.GetSnippetHeadingColour(Collection.UID) ); @@ -286,7 +286,7 @@ procedure TDisplayPrefsFrame.btnDefColoursClick(Sender: TObject); // combo boxes fGroupHeadingColourBox.Selected := clDefGroupHeading; fSnippetHeadingColourBox.Selected := clDefSnippetHeading; - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do fSnippetHeadingColours[Collection.UID] := clDefSnippetHeading; fSourceBGColourBox.Selected := clSourceBg; fUIChanged := True; @@ -401,7 +401,7 @@ procedure TDisplayPrefsFrame.Deactivate(const Prefs: IPreferences); fGroupHeadingColourDlg.CustomColors, True ); - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do Prefs.SetSnippetHeadingColour( Collection.UID, fSnippetHeadingColours[Collection.UID] ); diff --git a/Src/UCollectionListAdapter.pas b/Src/UCollectionListAdapter.pas index 63c707af5..a95a4b86a 100644 --- a/Src/UCollectionListAdapter.pas +++ b/Src/UCollectionListAdapter.pas @@ -85,7 +85,7 @@ constructor TCollectionListAdapter.Create; end ) ); - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do fCollectionList.Add(Collection); end; diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 43e138d65..0a5ba88b1 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -426,14 +426,14 @@ procedure TWelcomePageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); 'externalScript', TJavaScript.LoadScript('external.js', etWindows1252) ); - CollectionCount := TCollections.Instance.Count; + CollectionCount := TVaults.Instance.Count; Tplt.ResolvePlaceholderHTML( 'CollectionCount', IntToStr(CollectionCount) ); CollectionList := TStringBuilder.Create; try - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do CollectionList.AppendLine( THTML.CompoundTag( 'li', diff --git a/Src/UPreferences.pas b/Src/UPreferences.pas index 274ee872b..ccedf0aeb 100644 --- a/Src/UPreferences.pas +++ b/Src/UPreferences.pas @@ -748,7 +748,7 @@ procedure TPreferences.Assign(const Src: IInterface); Self.fShowNewSnippetsInNewTabs := SrcPref.ShowNewSnippetsInNewTabs; Self.fGroupHeadingColour := SrcPref.GetGroupHeadingColour; Self.fGroupHeadingCustomColours := SrcPref.GetGroupHeadingCustomColours; - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do Self.SetSnippetHeadingColour( Collection.UID, SrcPref.GetSnippetHeadingColour(Collection.UID) ); @@ -1073,7 +1073,7 @@ function TPreferencesPersist.Clone: IInterface; NewPref.ShowNewSnippetsInNewTabs := Self.fShowNewSnippetsInNewTabs; NewPref.GroupHeadingColour := Self.fGroupHeadingColour; NewPref.GroupHeadingCustomColours := Self.fGroupHeadingCustomColours; - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do NewPref.SetSnippetHeadingColour( Collection.UID, Self.GetSnippetHeadingColour(Collection.UID) ); @@ -1131,7 +1131,7 @@ constructor TPreferencesPersist.Create; ); fSnippetHeadingColours.Clear; - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do begin fSnippetHeadingColours.AddOrSetValue( Collection.UID, @@ -1228,7 +1228,7 @@ destructor TPreferencesPersist.Destroy; 'GroupHeadingCustomColour%d', fGroupHeadingCustomColours ); - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do begin if fSnippetHeadingColours.ContainsKey(Collection.UID) then Storage.SetInteger( diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index 01afabc68..b3de47776 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -106,7 +106,7 @@ constructor TRTFCategoryDoc.Create(const UseColour: Boolean); fBuilder.FontTable.Add(MainFontName, rgfSwiss, 0); fBuilder.FontTable.Add(MonoFontName, rgfModern, 0); // Set up colour table - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do fBuilder.ColourTable.Add( Preferences.GetSnippetHeadingColour(Collection.UID) ); diff --git a/Src/URTFSnippetDoc.pas b/Src/URTFSnippetDoc.pas index 1a2ea1d57..e11522025 100644 --- a/Src/URTFSnippetDoc.pas +++ b/Src/URTFSnippetDoc.pas @@ -174,7 +174,7 @@ procedure TRTFSnippetDoc.InitialiseDoc; fBuilder.ColourTable.Add(clWarningText); fBuilder.ColourTable.Add(clVarText); fBuilder.ColourTable.Add(clExternalLink); - for Collection in TCollections.Instance do + for Collection in TVaults.Instance do fBuilder.ColourTable.Add( Preferences.GetSnippetHeadingColour(Collection.UID) ); diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index 346f212de..84255993f 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -277,10 +277,10 @@ constructor TSaveUnitMgr.InternalCreate(const Snips: TSnippetList); fSourceGen := TSourceGen.Create; fSourceGen.IncludeSnippets(Snips); - // Count the number of collections containing snippet in the list + // Count the number of vaults containing snippet in the list for Snippet in Snips do begin - Collection := TCollections.Instance.GetCollection(Snippet.CollectionID); + Collection := TVaults.Instance.GetCollection(Snippet.CollectionID); if not fCollections.Contains(Collection) then fCollections.Add(Collection); end; diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index 16e2bad80..d63e85b94 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -136,7 +136,7 @@ function TSnippetDoc.CollectionInfo(const ACollectionID: TVaultID): string; MetaData: TMetaData; Collection: TVault; begin - Collection := TCollections.Instance.GetCollection(ACollectionID); + Collection := TVaults.Instance.GetCollection(ACollectionID); MetaData := Collection.MetaData; Result := ''; if TMetaDataCap.License in MetaData.Capabilities then diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index bf2cf1b1a..f58415281 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -255,7 +255,7 @@ procedure TSnippetSourceGen.Initialize(View: IView); // view is single snippet: just record that Snippet := (View as ISnippetView).Snippet; fGenerator.IncludeSnippet(Snippet); - fCollections.Add(TCollections.Instance.GetCollection(Snippet.CollectionID)); + fCollections.Add(TVaults.Instance.GetCollection(Snippet.CollectionID)); end else begin @@ -266,7 +266,7 @@ procedure TSnippetSourceGen.Initialize(View: IView); fGenerator.IncludeSnippets(Snips); // ignores freeform snippets for Snippet in Snips do begin - Collection := TCollections.Instance.GetCollection(Snippet.CollectionID); + Collection := TVaults.Instance.GetCollection(Snippet.CollectionID); if not fCollections.Contains(Collection) then fCollections.Add(Collection); end; diff --git a/Src/UStatusBarMgr.pas b/Src/UStatusBarMgr.pas index 5d9f219a1..6f0e77beb 100644 --- a/Src/UStatusBarMgr.pas +++ b/Src/UStatusBarMgr.pas @@ -364,7 +364,7 @@ procedure TStatusBarMgr.ShowSnippetsInfo; begin // Calculate database stats TotalSnippets := Database.Snippets.Count; - TotalCollections := TCollections.Instance.Count; + TotalCollections := TVaults.Instance.Count; // Build display text and display it fStatusBar.Panels[cDBPanel].Text := Format( sStats, diff --git a/Src/UUserDBMove.pas b/Src/UUserDBMove.pas index f52ea6183..a5eabca6f 100644 --- a/Src/UUserDBMove.pas +++ b/Src/UUserDBMove.pas @@ -142,9 +142,9 @@ procedure TUserDBMove.ReportDeleteProgress(Sender: TObject; procedure TUserDBMove.SetNewDBDirectory(Sender: TObject); var - Collections: TCollections; + Collections: TVaults; begin - Collections := TCollections.Instance; + Collections := TVaults.Instance; // record new location BEFORE deleting old directory fCollection.Storage.Directory := fDestDir; Collections.Update(fCollection); From 6b97a567d91b9652272e152f83f1770ae04fe1d2 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 08:49:41 +0000 Subject: [PATCH 153/222] Rename TCollectionsPersist as TVaultsPersist Also renamed methods and parameters that referred to collection(s) to refer instead to vault(s) --- Src/DB.UCollections.pas | 54 ++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 28 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index c5ea563e1..6ce76c2c7 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -141,7 +141,7 @@ TVaults = class sealed(TSingleton) property Items[const Idx: Integer]: TVault read GetItem; default; end; - TCollectionsPersist = record + TVaultsPersist = record strict private const CountKey = 'Count'; @@ -149,13 +149,13 @@ TCollectionsPersist = record NameKey = 'Name'; StorageFormatKey = 'Storage.Format'; StorageDirectoryKey = 'Storage.Directory'; - class procedure SaveCollection(const AOrdinal: Cardinal; - const ACollection: TVault); static; - class procedure LoadCollection(const AOrdinal: Cardinal; - const ACollections: TVaults); static; + class procedure SaveVault(const AOrdinal: Cardinal; const AVault: TVault); + static; + class procedure LoadVault(const AOrdinal: Cardinal; const AVaults: TVaults); + static; public - class procedure Save(const ACollections: TVaults); static; - class procedure Load(const ACollections: TVaults); static; + class procedure Save(const AVaults: TVaults); static; + class procedure Load(const AVaults: TVaults); static; end; implementation @@ -344,7 +344,7 @@ function TVaults.IndexOfID(const AUID: TVaultID): Integer; procedure TVaults.Initialize; begin fItems := TList.Create; - TCollectionsPersist.Load(Self); + TVaultsPersist.Load(Self); // Ensure there is always at least the default collection present if not ContainsID(TVaultID.Default) then Add( @@ -361,7 +361,7 @@ procedure TVaults.Initialize; procedure TVaults.Save; begin - TCollectionsPersist.Save(Self); + TVaultsPersist.Save(Self); end; function TVaults.ToArray: TArray; @@ -495,10 +495,9 @@ function TVaultID.TComparer.GetHashCode( Result := Value.Hash; end; -{ TCollectionsPersist } +{ TVaultsPersist } -class procedure TCollectionsPersist.Load( - const ACollections: TVaults); +class procedure TVaultsPersist.Load(const AVaults: TVaults); var ConfigSection: ISettingsSection; Count: Integer; @@ -507,11 +506,11 @@ class procedure TCollectionsPersist.Load( ConfigSection := Settings.ReadSection(ssCollections); Count := ConfigSection.GetInteger(CountKey, 0); for Idx := 0 to Pred(Count) do - LoadCollection(Idx, ACollections); + LoadVault(Idx, AVaults); end; -class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; - const ACollections: TVaults); +class procedure TVaultsPersist.LoadVault(const AOrdinal: Cardinal; + const AVaults: TVaults); var ConfigSection: ISettingsSection; UID: TVaultID; @@ -521,7 +520,7 @@ class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; begin ConfigSection := Settings.ReadSection(ssCollection, IntToStr(AOrdinal)); UID := TVaultID.Create(ConfigSection.GetBytes(UIDKey)); - if ACollections.ContainsID(UID) then + if AVaults.ContainsID(UID) then // Don't load a duplicate collection Exit; Name := ConfigSection.GetString(NameKey, ''); @@ -533,35 +532,34 @@ class procedure TCollectionsPersist.LoadCollection(const AOrdinal: Cardinal; ConfigSection.GetString(StorageDirectoryKey, '') ); Collection := TVault.Create(UID, Name, StorageDetails); - ACollections.Add(Collection); + AVaults.Add(Collection); end; -class procedure TCollectionsPersist.Save(const - ACollections: TVaults); +class procedure TVaultsPersist.Save(const AVaults: TVaults); var ConfigSection: ISettingsSection; Idx: Integer; begin // Save number of collections ConfigSection := Settings.EmptySection(ssCollections); - ConfigSection.SetInteger(CountKey, ACollections.Count); + ConfigSection.SetInteger(CountKey, AVaults.Count); ConfigSection.Save; // Save each collection's properties in its own section - for Idx := 0 to Pred(ACollections.Count) do - SaveCollection(Idx, ACollections[Idx]); + for Idx := 0 to Pred(AVaults.Count) do + SaveVault(Idx, AVaults[Idx]); end; -class procedure TCollectionsPersist.SaveCollection(const AOrdinal: Cardinal; - const ACollection: TVault); +class procedure TVaultsPersist.SaveVault(const AOrdinal: Cardinal; + const AVault: TVault); var ConfigSection: ISettingsSection; begin // Save info about collection format in its own section ConfigSection := Settings.EmptySection(ssCollection, IntToStr(AOrdinal)); - ConfigSection.SetBytes(UIDKey, ACollection.UID.ToArray); - ConfigSection.SetString(NameKey, ACollection.Name); - ConfigSection.SetInteger(StorageFormatKey, Ord(ACollection.Storage.Format)); - ConfigSection.SetString(StorageDirectoryKey, ACollection.Storage.Directory); + ConfigSection.SetBytes(UIDKey, AVault.UID.ToArray); + ConfigSection.SetString(NameKey, AVault.Name); + ConfigSection.SetInteger(StorageFormatKey, Ord(AVault.Storage.Format)); + ConfigSection.SetString(StorageDirectoryKey, AVault.Storage.Directory); ConfigSection.Save; end; From 4b904b7e6b0428f5ea6e575aabfb4d3789459b8e Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 08:58:21 +0000 Subject: [PATCH 154/222] Rename method & identifiers in DB.UCollections Renamed the public TVaults.GetCollection method to TVaults.GetVault. Updated affected code that uses this method. Renamed various local variables re change from collection(s) to vault(s). Changed strings that referred to collections to refer to vaults. Corrected comments Tidied up the code. --- Src/DB.UCollections.pas | 84 ++++++++++++++++------------------- Src/FmDuplicateSnippetDlg.pas | 2 +- Src/USaveUnitMgr.pas | 2 +- Src/USnippetDoc.pas | 2 +- Src/USnippetSourceGen.pas | 4 +- 5 files changed, 43 insertions(+), 51 deletions(-) diff --git a/Src/DB.UCollections.pas b/Src/DB.UCollections.pas index 6ce76c2c7..339606073 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.UCollections.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). * - * Implements support for multiple snippet collections. + * Implements support for multiple snippet vaults. } @@ -40,10 +40,8 @@ TComparer = class(TInterfacedObject, ) public function Compare(const Left, Right: TVaultID): Integer; - function Equals(const Left, Right: TVaultID): Boolean; - reintroduce; - function GetHashCode(const Value: TVaultID): Integer; - reintroduce; + function Equals(const Left, Right: TVaultID): Boolean; reintroduce; + function GetHashCode(const Value: TVaultID): Integer; reintroduce; end; constructor Create(const ABytes: TBytes); overload; constructor Create(const AStr: string); overload; @@ -79,35 +77,29 @@ TComparer = class(TInterfacedObject, ) public function Compare(const Left, Right: TVault): Integer; - function Equals(const Left, Right: TVault): Boolean; - reintroduce; - function GetHashCode(const Value: TVault): Integer; - reintroduce; + function Equals(const Left, Right: TVault): Boolean; reintroduce; + function GetHashCode(const Value: TVault): Integer; reintroduce; end; - /// Creates a collection record. - /// TVaultID [in] Unique ID of the - /// collection. Must not be null. - /// string [in] Name of collection. Should be - /// unique. Must not be empty or only whitespace. + /// Creates a vault object. + /// TVaultID [in] Unique ID of the vault. Must + /// not be null. + /// string [in] Name of vault. Should be unique. + /// Must not be empty or only whitespace. constructor Create(const AUID: TVaultID; const AName: string; const AStorage: TDataStorageDetails); - /// Collection identifier. Must be unique. - property UID: TVaultID - read fUID; - /// Collection name. Must be unique. - property Name: string read - fName; - /// Collection storage information. - property Storage: TDataStorageDetails - read fStorage; - /// Meta data associated with the collection. + /// Vault identifier. Must be unique. + property UID: TVaultID read fUID; + /// Vault name. Must be unique. + property Name: string read fName; + /// Vault storage information. + property Storage: TDataStorageDetails read fStorage; + /// Meta data associated with the vault. /// Meta data is read from and written to the associated storage. /// - property MetaData: TMetaData - read fMetaData write SetMetaData; + property MetaData: TMetaData read fMetaData write SetMetaData; /// Checks if this record's fields are valid. function IsValid: Boolean; - /// Checks if this record is the default collection. + /// Checks if this record is the default vault. function IsDefault: Boolean; end; @@ -127,7 +119,7 @@ TVaults = class sealed(TSingleton) function IndexOfID(const AUID: TVaultID): Integer; function ContainsID(const AUID: TVaultID): Boolean; function ContainsName(const AName: string): Boolean; - function GetCollection(const AUID: TVaultID): TVault; + function GetVault(const AUID: TVaultID): TVault; function Default: TVault; procedure Add(const AVault: TVault); procedure Update(const AVault: TVault); @@ -181,12 +173,12 @@ constructor TVault.Create(const AUID: TVaultID; const AName: string; TrimmedName: string; begin TrimmedName := StrTrim(AName); - Assert(not AUID.IsNull, 'TCollection.Create: AUID is null'); + Assert(not AUID.IsNull, 'TVault.Create: AUID is null'); Assert(TrimmedName <> '', - 'TCollection.Create: AName is empty or only whitespace'); + 'TVault.Create: AName is empty or only whitespace'); {TODO -cRefactor: move following into IsValid method of TDataDetails} Assert(AStorage.Format <> TDataFormatKind.Error, - 'TCollection.Create: ADataDetails.Kind = TCollectionFormatKind.Error'); + 'TVault.Create: ADataDetails.Kind = TDataFormatKind.Error'); fUID := AUID.Clone; fName := TrimmedName; fStorage := AStorage; @@ -247,11 +239,11 @@ function TVaults.ContainsID(const AUID: TVaultID): function TVaults.ContainsName(const AName: string): Boolean; var - Collection: TVault; + Vault: TVault; begin Result := False; - for Collection in fItems do - if StrSameText(AName, Collection.Name) then + for Vault in fItems do + if StrSameText(AName, Vault.Name) then Exit(True); end; @@ -262,12 +254,12 @@ function TVaults.Count: Integer; function TVaults.Default: TVault; begin - Result := GetCollection(TVaultID.Default); + Result := GetVault(TVaultID.Default); end; procedure TVaults.Delete(const AUID: TVaultID); resourcestring - sCantDelete = 'Cannot delete the default collection'; + sCantDelete = 'Cannot delete the default vault'; var Idx: Integer; begin @@ -306,7 +298,7 @@ function TVaults.GetAllIDs: TArray; Result[Idx] := fItems[Idx].UID; end; -function TVaults.GetCollection(const AUID: TVaultID): TVault; +function TVaults.GetVault(const AUID: TVaultID): TVault; var Idx: Integer; begin @@ -345,7 +337,7 @@ procedure TVaults.Initialize; begin fItems := TList.Create; TVaultsPersist.Load(Self); - // Ensure there is always at least the default collection present + // Ensure there is always at least the default vault present if not ContainsID(TVaultID.Default) then Add( TVault.Create( @@ -439,7 +431,7 @@ class function TVaultID.CreateNull: TVaultID; class function TVaultID.Default: TVaultID; begin - // Default collection is an empty GUID = 16 zero bytes + // Default vault is an empty GUID = 16 zero bytes Result := TVaultID.Create(TGUID.Empty); end; @@ -515,13 +507,13 @@ class procedure TVaultsPersist.LoadVault(const AOrdinal: Cardinal; ConfigSection: ISettingsSection; UID: TVaultID; Name: string; - Collection: TVault; + Vault: TVault; StorageDetails: TDataStorageDetails; begin ConfigSection := Settings.ReadSection(ssCollection, IntToStr(AOrdinal)); UID := TVaultID.Create(ConfigSection.GetBytes(UIDKey)); if AVaults.ContainsID(UID) then - // Don't load a duplicate collection + // Don't load a duplicate vault Exit; Name := ConfigSection.GetString(NameKey, ''); @@ -531,8 +523,8 @@ class procedure TVaultsPersist.LoadVault(const AOrdinal: Cardinal; ), ConfigSection.GetString(StorageDirectoryKey, '') ); - Collection := TVault.Create(UID, Name, StorageDetails); - AVaults.Add(Collection); + Vault := TVault.Create(UID, Name, StorageDetails); + AVaults.Add(Vault); end; class procedure TVaultsPersist.Save(const AVaults: TVaults); @@ -540,11 +532,11 @@ class procedure TVaultsPersist.Save(const AVaults: TVaults); ConfigSection: ISettingsSection; Idx: Integer; begin - // Save number of collections + // Save number of vaults ConfigSection := Settings.EmptySection(ssCollections); ConfigSection.SetInteger(CountKey, AVaults.Count); ConfigSection.Save; - // Save each collection's properties in its own section + // Save each vault's properties in its own section for Idx := 0 to Pred(AVaults.Count) do SaveVault(Idx, AVaults[Idx]); end; @@ -554,7 +546,7 @@ class procedure TVaultsPersist.SaveVault(const AOrdinal: Cardinal; var ConfigSection: ISettingsSection; begin - // Save info about collection format in its own section + // Save info about vault format in its own section ConfigSection := Settings.EmptySection(ssCollection, IntToStr(AOrdinal)); ConfigSection.SetBytes(UIDKey, AVault.UID.ToArray); ConfigSection.SetString(NameKey, AVault.Name); diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 2bfdf79ee..78d73c19c 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -202,7 +202,7 @@ procedure TDuplicateSnippetDlg.InitForm; Assert(Assigned(SnippetCat), ClassName + '.InitForm: invalid category'); cbCategory.ItemIndex := cbCategory.Items.IndexOf(SnippetCat.Description); - SnippetColl := TVaults.Instance.GetCollection(fSnippet.CollectionID); + SnippetColl := TVaults.Instance.GetVault(fSnippet.CollectionID); cbCollection.ItemIndex := cbCollection.Items.IndexOf(SnippetColl.Name); chkEdit.Checked := fOptions.EditSnippetOnClose; diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index 84255993f..3dd5d635d 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -280,7 +280,7 @@ constructor TSaveUnitMgr.InternalCreate(const Snips: TSnippetList); // Count the number of vaults containing snippet in the list for Snippet in Snips do begin - Collection := TVaults.Instance.GetCollection(Snippet.CollectionID); + Collection := TVaults.Instance.GetVault(Snippet.CollectionID); if not fCollections.Contains(Collection) then fCollections.Add(Collection); end; diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index d63e85b94..f2c354748 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -136,7 +136,7 @@ function TSnippetDoc.CollectionInfo(const ACollectionID: TVaultID): string; MetaData: TMetaData; Collection: TVault; begin - Collection := TVaults.Instance.GetCollection(ACollectionID); + Collection := TVaults.Instance.GetVault(ACollectionID); MetaData := Collection.MetaData; Result := ''; if TMetaDataCap.License in MetaData.Capabilities then diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index f58415281..5f0b2f241 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -255,7 +255,7 @@ procedure TSnippetSourceGen.Initialize(View: IView); // view is single snippet: just record that Snippet := (View as ISnippetView).Snippet; fGenerator.IncludeSnippet(Snippet); - fCollections.Add(TVaults.Instance.GetCollection(Snippet.CollectionID)); + fCollections.Add(TVaults.Instance.GetVault(Snippet.CollectionID)); end else begin @@ -266,7 +266,7 @@ procedure TSnippetSourceGen.Initialize(View: IView); fGenerator.IncludeSnippets(Snips); // ignores freeform snippets for Snippet in Snips do begin - Collection := TVaults.Instance.GetCollection(Snippet.CollectionID); + Collection := TVaults.Instance.GetVault(Snippet.CollectionID); if not fCollections.Contains(Collection) then fCollections.Add(Collection); end; From ffa0171e9a3d3f38c45c11b119cc8dfbeb1d6e3d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 09:18:58 +0000 Subject: [PATCH 155/222] Rename DB.UCollections unit as DB.Vaults Updated all units that used the renamed unit to use the renamed version. --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/DB.UCategory.pas | 4 +- Src/DB.UDatabaseIO.pas | 2 +- Src/DB.UMain.pas | 2 +- Src/DB.USnippet.pas | 2 +- Src/{DB.UCollections.pas => DB.Vaults.pas} | 6 +-- Src/Favourites.UPersist.pas | 2 +- Src/FmAboutDlg.pas | 2 +- Src/FmCodeExportDlg.pas | 14 +++++-- Src/FmCodeImportDlg.pas | 2 +- Src/FmCollectionBackup.pas | 2 +- Src/FmDeleteUserDBDlg.pas | 2 +- Src/FmDependenciesDlg.pas | 16 ++++++-- Src/FmDuplicateSnippetDlg.pas | 13 +++++-- Src/FmFavouritesDlg.pas | 17 ++++++-- Src/FmFindXRefsDlg.pas | 2 +- Src/FmMain.pas | 45 +++++++++++++++++----- Src/FmSWAGImportDlg.pas | 2 +- Src/FmSelectionSearchDlg.pas | 19 +++++++-- Src/FmSnippetsEditorDlg.pas | 38 ++++++++++++++---- Src/FmTestCompileDlg.pas | 2 +- Src/FmUserDataPathDlg.pas | 2 +- Src/FrDetailView.pas | 23 ++++++++--- Src/FrDisplayPrefs.pas | 2 +- Src/FrOverview.pas | 22 +++++++++-- Src/FrSelectSnippetsBase.pas | 2 +- Src/FrSelectUserSnippets.pas | 2 +- Src/IntfNotifier.pas | 2 +- Src/SWAG.UImporter.pas | 2 +- Src/UAppInfo.pas | 2 +- Src/UCodeImportExport.pas | 2 +- Src/UCodeImportMgr.pas | 2 +- Src/UCodeShareMgr.pas | 2 +- Src/UCollectionListAdapter.pas | 2 +- Src/UDetailPageHTML.pas | 2 +- Src/UNotifier.pas | 2 +- Src/UPreferences.pas | 12 ++++-- Src/URTFCategoryDoc.pas | 5 ++- Src/URTFSnippetDoc.pas | 12 ++++-- Src/USaveUnitMgr.pas | 2 +- Src/USnippetAction.pas | 2 +- Src/USnippetDoc.pas | 8 +++- Src/USnippetIDListIOHandler.pas | 2 +- Src/USnippetIDs.pas | 2 +- Src/USnippetSourceGen.pas | 2 +- Src/USnippetValidator.pas | 2 +- Src/USnippetsChkListMgr.pas | 2 +- Src/USnippetsTVDraw.pas | 2 +- Src/UStatusBarMgr.pas | 2 +- Src/UTextSnippetDoc.pas | 7 +++- Src/UUserDBBackup.pas | 2 +- Src/UUserDBMgr.pas | 2 +- Src/UUserDBMove.pas | 2 +- Src/UWBExternal.pas | 2 +- 55 files changed, 241 insertions(+), 98 deletions(-) rename Src/{DB.UCollections.pas => DB.Vaults.pas} (98%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index d179cdb10..060086421 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -373,7 +373,7 @@ uses FmRegisterCompilersDlg in 'FmRegisterCompilersDlg.pas' {RegisterCompilersDlg}, ClassHelpers.UGraphics in 'ClassHelpers.UGraphics.pas', ClassHelpers.UActions in 'ClassHelpers.UActions.pas', - DB.UCollections in 'DB.UCollections.pas', + DB.Vaults in 'DB.Vaults.pas', UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas', DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas', UCollectionListAdapter in 'UCollectionListAdapter.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index a08de9434..11e8bc08f 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -579,7 +579,7 @@ - + diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index 5a613c68d..b9ca3eddc 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -20,8 +20,8 @@ interface // Delphi Generics.Collections, // Project - DB.UCollections, - DB.USnippet; + DB.USnippet, + DB.Vaults; type diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 02b1bed74..76b01fe39 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -21,10 +21,10 @@ interface uses // Project - DB.UCollections, DB.UCategory, DB.UMain, DB.USnippet, + DB.Vaults, UBaseObjects, UExceptions; diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index f98690de3..69332d14b 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -24,8 +24,8 @@ interface ActiveText.UMain, Compilers.UGlobals, DB.UCategory, - DB.UCollections, DB.USnippet, + DB.Vaults, UContainers, UIStringList, UMultiCastEvents, diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 0b3ecc82d..d0775f759 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -24,8 +24,8 @@ interface // Project ActiveText.UMain, Compilers.UGlobals, - DB.UCollections, DB.USnippetKind, + DB.Vaults, UContainers, UIStringList, USnippetIDs; diff --git a/Src/DB.UCollections.pas b/Src/DB.Vaults.pas similarity index 98% rename from Src/DB.UCollections.pas rename to Src/DB.Vaults.pas index 339606073..b9645d617 100644 --- a/Src/DB.UCollections.pas +++ b/Src/DB.Vaults.pas @@ -9,7 +9,7 @@ } -unit DB.UCollections; +unit DB.Vaults; {$ScopedEnums ON} @@ -97,9 +97,9 @@ TComparer = class(TInterfacedObject, /// Meta data is read from and written to the associated storage. /// property MetaData: TMetaData read fMetaData write SetMetaData; - /// Checks if this record's fields are valid. + /// Checks if this object's fields are valid. function IsValid: Boolean; - /// Checks if this record is the default vault. + /// Checks if this object is the default vault. function IsDefault: Boolean; end; diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index 26bd7613e..585280cfc 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -58,8 +58,8 @@ implementation IOUtils, Classes, /// Project - DB.UCollections, DB.UMain, + DB.Vaults, UAppInfo, UConsts, UIOUtils, diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index 1854dbe05..1910624ea 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -28,7 +28,7 @@ interface // Project Browser.UHTMLEvents, DB.MetaData, - DB.UCollections, + DB.Vaults, FmGenericViewDlg, FrBrowserBase, FrHTMLDlg, diff --git a/Src/FmCodeExportDlg.pas b/Src/FmCodeExportDlg.pas index 37ea3c549..5931a2c8c 100644 --- a/Src/FmCodeExportDlg.pas +++ b/Src/FmCodeExportDlg.pas @@ -76,9 +76,17 @@ implementation // Delphi SysUtils, Dialogs, // Project - DB.UCollections, - UCodeImportExport, UCtrlArranger, UEncodings, UExceptions, UIOUtils, - UMessageBox, UOpenDialogHelper, USaveDialogEx, UStrUtils, UUtils; + DB.Vaults, + UCodeImportExport, + UCtrlArranger, + UEncodings, + UExceptions, + UIOUtils, + UMessageBox, + UOpenDialogHelper, + USaveDialogEx, + UStrUtils, + UUtils; {$R *.dfm} diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index 8de26cb78..7673dfc4f 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -25,7 +25,7 @@ interface ExtCtrls, Forms, // Project - DB.UCollections, + DB.Vaults, FmWizardDlg, UBaseObjects, UCodeImportMgr, diff --git a/Src/FmCollectionBackup.pas b/Src/FmCollectionBackup.pas index ae3388993..a762b28c0 100644 --- a/Src/FmCollectionBackup.pas +++ b/Src/FmCollectionBackup.pas @@ -21,7 +21,7 @@ interface StdCtrls, ExtCtrls, // Project - DB.UCollections, + DB.Vaults, FmGenericOKDlg, UCollectionListAdapter; diff --git a/Src/FmDeleteUserDBDlg.pas b/Src/FmDeleteUserDBDlg.pas index e453856d7..38ef21a36 100644 --- a/Src/FmDeleteUserDBDlg.pas +++ b/Src/FmDeleteUserDBDlg.pas @@ -22,7 +22,7 @@ interface ExtCtrls, Classes, // Project - DB.UCollections, + DB.Vaults, FmGenericOKDlg, FrBrowserBase, FrHTMLDlg, diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index a7a5e6f8b..74a672c43 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -18,10 +18,20 @@ interface uses // Delphi - ComCtrls, StdCtrls, Controls, ExtCtrls, Classes, Windows, ActnList, + ComCtrls, + StdCtrls, + Controls, + ExtCtrls, + Classes, + Windows, + ActnList, // Project - DB.UCollections, - DB.USnippet, FmGenericViewDlg, UBaseObjects, USearch, USnippetIDs, + DB.USnippet, + DB.Vaults, + FmGenericViewDlg, + UBaseObjects, + USearch, + USnippetIDs, USnippetsTVDraw; diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 78d73c19c..7ff4dddb8 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -17,10 +17,17 @@ interface uses // Delphi - SysUtils, Controls, StdCtrls, ExtCtrls, Classes, + SysUtils, + Controls, + StdCtrls, + ExtCtrls, + Classes, // Project - DB.UCollections, - DB.USnippet, FmGenericOKDlg, UBaseObjects, UCategoryListAdapter, + DB.USnippet, + DB.Vaults, + FmGenericOKDlg, + UBaseObjects, + UCategoryListAdapter, UCollectionListAdapter, UIStringList; diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index 325ff2d2d..ca3353e89 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -271,11 +271,20 @@ implementation uses // Delphi - SysUtils, DateUtils, Windows, Graphics, + SysUtils, + DateUtils, + Windows, + Graphics, // Project - DB.UCollections, - DB.UMain, DB.USnippet, UCtrlArranger, UMessageBox, UPreferences, USettings, - UStructs, UStrUtils; + DB.UMain, + DB.USnippet, + DB.Vaults, + UCtrlArranger, + UMessageBox, + UPreferences, + USettings, + UStructs, + UStrUtils; {$R *.dfm} diff --git a/Src/FmFindXRefsDlg.pas b/Src/FmFindXRefsDlg.pas index 829cf9873..cc6192e15 100644 --- a/Src/FmFindXRefsDlg.pas +++ b/Src/FmFindXRefsDlg.pas @@ -130,7 +130,7 @@ implementation SysUtils, Graphics, // Project - DB.UCollections, + DB.Vaults, UColours, UCtrlArranger, UPreferences, diff --git a/Src/FmMain.pas b/Src/FmMain.pas index 0d9c56435..7a6307bf2 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -580,19 +580,46 @@ implementation uses // Delphi - Windows, Graphics, + Windows, + Graphics, // Project ClassHelpers.UControls, ClassHelpers.UGraphics, DB.UCategory, - DB.UCollections, - DB.UMain, DB.USnippet, FmSplash, FmTrappedBugReportDlg, - FmWaitDlg, IntfFrameMgrs, UActionFactory, UAppInfo, - UCodeShareMgr, UCommandBars, UConsts, UCopyInfoMgr, - UCopySourceMgr, UDatabaseLoader, UDatabaseLoaderUI, UDetailTabAction, - UEditSnippetAction, UExceptions, UHelpMgr, UHistoryMenus, UKeysHelper, - UMessageBox, UNotifier, UNulDropTarget, UPrintMgr, UQuery, USaveSnippetMgr, - USaveUnitMgr, USelectionIOMgr, UUrl, UUserDBMgr, UView, UViewItemAction, + DB.UMain, + DB.USnippet, + DB.Vaults, + FmSplash, + FmTrappedBugReportDlg, + FmWaitDlg, + IntfFrameMgrs, + UActionFactory, + UAppInfo, + UCodeShareMgr, + UCommandBars, + UConsts, + UCopyInfoMgr, + UCopySourceMgr, + UDatabaseLoader, + UDatabaseLoaderUI, + UDetailTabAction, + UEditSnippetAction, + UExceptions, + UHelpMgr, + UHistoryMenus, + UKeysHelper, + UMessageBox, + UNotifier, + UNulDropTarget, + UPrintMgr, + UQuery, + USaveSnippetMgr, + USaveUnitMgr, + USelectionIOMgr, + UUrl, + UUserDBMgr, + UView, + UViewItemAction, UWBExternal; diff --git a/Src/FmSWAGImportDlg.pas b/Src/FmSWAGImportDlg.pas index 30bc39082..977509f07 100644 --- a/Src/FmSWAGImportDlg.pas +++ b/Src/FmSWAGImportDlg.pas @@ -28,7 +28,7 @@ interface Classes, Generics.Collections, // Project - DB.UCollections, + DB.Vaults, FmWizardDlg, FrBrowserBase, FrFixedHTMLDlg, diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index fb0054ee7..aec070472 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -18,11 +18,22 @@ interface uses // Delphi - Forms, StdCtrls, Controls, ExtCtrls, Classes, Buttons, Menus, + Forms, + StdCtrls, + Controls, + ExtCtrls, + Classes, + Buttons, + Menus, // Project - DB.UCollections, - DB.USnippet, FmGenericOKDlg, FrCheckedTV, FrSelectSnippets, - FrSelectSnippetsBase, UBaseObjects, USearch; + DB.USnippet, + DB.Vaults, + FmGenericOKDlg, + FrCheckedTV, + FrSelectSnippets, + FrSelectSnippetsBase, + UBaseObjects, + USearch; type diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 3ccc12a15..27ce16af8 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -18,15 +18,39 @@ interface uses // Delphi - SysUtils, Classes, ActnList, Buttons, StdCtrls, Forms, Controls, CheckLst, - ComCtrls, ExtCtrls, StdActns, Menus, ImgList, + SysUtils, + Classes, + ActnList, + Buttons, + StdCtrls, + Forms, + Controls, + CheckLst, + ComCtrls, + ExtCtrls, + StdActns, + Menus, + ImgList, // Project - ActiveText.UMain, Compilers.UGlobals, - DB.UCollections, DB.USnippet, FmGenericOKDlg, - FrBrowserBase, FrFixedHTMLDlg, FrHTMLDlg, UBaseObjects, UCategoryListAdapter, + ActiveText.UMain, + Compilers.UGlobals, + DB.USnippet, + DB.Vaults, + FmGenericOKDlg, + FrBrowserBase, + FrFixedHTMLDlg, + FrHTMLDlg, + UBaseObjects, + UCategoryListAdapter, UCollectionListAdapter, - UCompileMgr, UCompileResultsLBMgr, UCSSBuilder, UMemoCaretPosDisplayMgr, - UMemoHelper, USnipKindListAdapter, USnippetsChkListMgr, UUnitsChkListMgr, + UCompileMgr, + UCompileResultsLBMgr, + UCSSBuilder, + UMemoCaretPosDisplayMgr, + UMemoHelper, + USnipKindListAdapter, + USnippetsChkListMgr, + UUnitsChkListMgr, FmSnippetsEditorDlg.FrActiveTextEditor; diff --git a/Src/FmTestCompileDlg.pas b/Src/FmTestCompileDlg.pas index 359c09892..43d2050e5 100644 --- a/Src/FmTestCompileDlg.pas +++ b/Src/FmTestCompileDlg.pas @@ -160,7 +160,7 @@ implementation Graphics, Types {for inlining}, // Project - DB.UCollections, + DB.Vaults, UColours, UCtrlArranger, UFontHelper, diff --git a/Src/FmUserDataPathDlg.pas b/Src/FmUserDataPathDlg.pas index a5981e27a..813521f01 100644 --- a/Src/FmUserDataPathDlg.pas +++ b/Src/FmUserDataPathDlg.pas @@ -133,7 +133,7 @@ implementation // Delphi IOUtils, // Project - DB.UCollections, + DB.Vaults, UAppInfo, UBrowseForFolderDlg, UCtrlArranger, diff --git a/Src/FrDetailView.pas b/Src/FrDetailView.pas index 74a90931a..327ccefcc 100644 --- a/Src/FrDetailView.pas +++ b/Src/FrDetailView.pas @@ -115,13 +115,24 @@ implementation uses // Delphi - SysUtils, Menus, Math, + SysUtils, + Menus, + Math, // Project - ActiveText.UHTMLRenderer, Browser.UHighlighter, - DB.UCollections, - Hiliter.UAttrs, Hiliter.UCSS, - Hiliter.UGlobals, UColours, UCSSUtils, UFontHelper, UPreferences, UQuery, - USystemInfo, UUtils, UWBCommandBars; + ActiveText.UHTMLRenderer, + Browser.UHighlighter, + DB.Vaults, + Hiliter.UAttrs, + Hiliter.UCSS, + Hiliter.UGlobals, + UColours, + UCSSUtils, + UFontHelper, + UPreferences, + UQuery, + USystemInfo, + UUtils, + UWBCommandBars; {$R *.dfm} diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index a94512587..7cf16ee85 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -25,7 +25,7 @@ interface Graphics, Generics.Collections, // Project - DB.UCollections, + DB.Vaults, FrPrefsBase, UCollectionListAdapter, UColorBoxEx, diff --git a/Src/FrOverview.pas b/Src/FrOverview.pas index 57fca0b78..da5806a6c 100644 --- a/Src/FrOverview.pas +++ b/Src/FrOverview.pas @@ -18,11 +18,25 @@ interface uses // Delphi - ComCtrls, Controls, Classes, Windows, ExtCtrls, StdCtrls, ToolWin, Menus, + ComCtrls, + Controls, + Classes, + Windows, + ExtCtrls, + StdCtrls, + ToolWin, + Menus, // Project - DB.UCollections, - DB.USnippet, FrTitled, IntfFrameMgrs, IntfNotifier, UCommandBars, - UOverviewTreeState, USnippetsTVDraw, UView, UViewItemTreeNode; + DB.USnippet, + DB.Vaults, + FrTitled, + IntfFrameMgrs, + IntfNotifier, + UCommandBars, + UOverviewTreeState, + USnippetsTVDraw, + UView, + UViewItemTreeNode; type diff --git a/Src/FrSelectSnippetsBase.pas b/Src/FrSelectSnippetsBase.pas index 8b69abd06..e5e1130ca 100644 --- a/Src/FrSelectSnippetsBase.pas +++ b/Src/FrSelectSnippetsBase.pas @@ -23,9 +23,9 @@ interface Classes, ComCtrls, // Project - DB.UCollections, DB.UCategory, DB.USnippet, + DB.Vaults, FrCheckedTV, USnippetsTVDraw; diff --git a/Src/FrSelectUserSnippets.pas b/Src/FrSelectUserSnippets.pas index dd616fbdc..155d770c2 100644 --- a/Src/FrSelectUserSnippets.pas +++ b/Src/FrSelectUserSnippets.pas @@ -52,7 +52,7 @@ implementation uses - DB.UCollections; + DB.Vaults; {$R *.dfm} diff --git a/Src/IntfNotifier.pas b/Src/IntfNotifier.pas index fcb8d741d..8ed204229 100644 --- a/Src/IntfNotifier.pas +++ b/Src/IntfNotifier.pas @@ -20,7 +20,7 @@ interface // Delphi Classes, ActiveX, Windows, // Project - DB.UCollections, + DB.Vaults, UView; diff --git a/Src/SWAG.UImporter.pas b/Src/SWAG.UImporter.pas index 2c68ea456..453bcf04c 100644 --- a/Src/SWAG.UImporter.pas +++ b/Src/SWAG.UImporter.pas @@ -22,8 +22,8 @@ interface // Project ActiveText.UMain, DB.UCategory, - DB.UCollections, DB.USnippet, + DB.Vaults, SWAG.UCommon; diff --git a/Src/UAppInfo.pas b/Src/UAppInfo.pas index 8a51d0666..a8559f650 100644 --- a/Src/UAppInfo.pas +++ b/Src/UAppInfo.pas @@ -132,7 +132,7 @@ implementation // Delphi SysUtils, // Project - DB.UCollections, + DB.Vaults, USettings, UStrUtils, USystemInfo, diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index d468c247a..207ac2cd2 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -181,9 +181,9 @@ implementation XMLDom, // Project ActiveText.UMain, - DB.UCollections, DB.UMain, DB.USnippetKind, + DB.Vaults, UAppInfo, USnippetExtraHelper, UStructs, diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index a9ca697bd..30191fbd6 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -22,7 +22,7 @@ interface Generics.Collections, Generics.Defaults, // Project - DB.UCollections, + DB.Vaults, UCodeImportExport, UExceptions, UIStringList; diff --git a/Src/UCodeShareMgr.pas b/Src/UCodeShareMgr.pas index add374d25..1da428608 100644 --- a/Src/UCodeShareMgr.pas +++ b/Src/UCodeShareMgr.pas @@ -59,8 +59,8 @@ implementation // Delphi SysUtils, // Project - DB.UCollections, DB.UMain, + DB.Vaults, FmCodeExportDlg, FmCodeImportDlg, UCodeImportMgr; diff --git a/Src/UCollectionListAdapter.pas b/Src/UCollectionListAdapter.pas index a95a4b86a..87c0b099e 100644 --- a/Src/UCollectionListAdapter.pas +++ b/Src/UCollectionListAdapter.pas @@ -18,7 +18,7 @@ interface // Delphi Classes, // Project - DB.UCollections, + DB.Vaults, UContainers; type diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 0a5ba88b1..6b9d042e7 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -68,9 +68,9 @@ implementation // Project Compilers.UGlobals, Compilers.UCompilers, - DB.UCollections, DB.UMain, DB.USnippet, + DB.Vaults, UConsts, UContainers, UCSSUtils, diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index 5629550a1..85045d010 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -19,7 +19,7 @@ interface // Delphi Classes, ActiveX, // Project - DB.UCollections, + DB.Vaults, IntfNotifier, UView; diff --git a/Src/UPreferences.pas b/Src/UPreferences.pas index ccedf0aeb..4edfbdae5 100644 --- a/Src/UPreferences.pas +++ b/Src/UPreferences.pas @@ -19,9 +19,15 @@ interface // Delphi Graphics, // Project - DB.UCollections, - Hiliter.UGlobals, UIStringList, UMeasurement, UPrintInfo, - USnippetPageStructure, USourceFileInfo, USourceGen, UWarnings; + DB.Vaults, + Hiliter.UGlobals, + UIStringList, + UMeasurement, + UPrintInfo, + USnippetPageStructure, + USourceFileInfo, + USourceGen, + UWarnings; type diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index b3de47776..a410ae6dd 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -90,7 +90,10 @@ implementation uses // Project - ActiveText.UMain, DB.UCollections, UColours, UPreferences; + ActiveText.UMain, + DB.Vaults, + UColours, + UPreferences; { TRTFCategoryDoc } diff --git a/Src/URTFSnippetDoc.pas b/Src/URTFSnippetDoc.pas index e11522025..f557c45fe 100644 --- a/Src/URTFSnippetDoc.pas +++ b/Src/URTFSnippetDoc.pas @@ -18,9 +18,15 @@ interface uses // Project - DB.UCollections, - ActiveText.UMain, ActiveText.URTFRenderer, Hiliter.UGlobals, UEncodings, - UIStringList, USnippetDoc, URTFBuilder, URTFStyles; + ActiveText.UMain, + ActiveText.URTFRenderer, + DB.Vaults, + Hiliter.UGlobals, + UEncodings, + UIStringList, + USnippetDoc, + URTFBuilder, + URTFStyles; type diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index 3dd5d635d..2af2f0e28 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -20,8 +20,8 @@ interface // Delphi Generics.Collections, // Project - DB.UCollections, DB.USnippet, + DB.Vaults, UIStringList, USourceFileInfo, USaveSourceMgr, diff --git a/Src/USnippetAction.pas b/Src/USnippetAction.pas index 4ed01a40c..5f4a44d9e 100644 --- a/Src/USnippetAction.pas +++ b/Src/USnippetAction.pas @@ -19,7 +19,7 @@ interface // Delphi Classes, // Project - DB.UCollections, + DB.Vaults, IntfNotifier; diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index f2c354748..1a8ad90d2 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -21,8 +21,12 @@ interface // Delphi Classes, // Project - DB.UCollections, - ActiveText.UMain, Compilers.UGlobals, DB.USnippet, UEncodings, UIStringList; + DB.Vaults, + ActiveText.UMain, + Compilers.UGlobals, + DB.USnippet, + UEncodings, + UIStringList; type diff --git a/Src/USnippetIDListIOHandler.pas b/Src/USnippetIDListIOHandler.pas index 8efbd1e2b..3bbe95b12 100644 --- a/Src/USnippetIDListIOHandler.pas +++ b/Src/USnippetIDListIOHandler.pas @@ -65,7 +65,7 @@ implementation // Delphi Classes, // Project - DB.UCollections, + DB.Vaults, UStrUtils, UTabSeparatedFileIO; diff --git a/Src/USnippetIDs.pas b/Src/USnippetIDs.pas index b4556bd51..9380e21e8 100644 --- a/Src/USnippetIDs.pas +++ b/Src/USnippetIDs.pas @@ -22,7 +22,7 @@ interface Generics.Defaults, // Project IntfCommon, - DB.UCollections; + DB.Vaults; type diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index 5f0b2f241..1a81153fd 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -21,7 +21,7 @@ interface Generics.Collections, // Project DB.MetaData, - DB.UCollections, + DB.Vaults, UBaseObjects, UIStringList, USourceGen, diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index 02f6093a7..baf098002 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -18,9 +18,9 @@ interface uses // Project ActiveText.UMain, - DB.UCollections, DB.USnippet, DB.USnippetKind, + DB.Vaults, UBaseObjects, UStructs; diff --git a/Src/USnippetsChkListMgr.pas b/Src/USnippetsChkListMgr.pas index bbc9a8ba5..4a028eede 100644 --- a/Src/USnippetsChkListMgr.pas +++ b/Src/USnippetsChkListMgr.pas @@ -103,7 +103,7 @@ implementation Graphics, StdCtrls, // Project - DB.UCollections, + DB.Vaults, UColours, UGraphicUtils, UPreferences; diff --git a/Src/USnippetsTVDraw.pas b/Src/USnippetsTVDraw.pas index 92315180f..2f3c7036a 100644 --- a/Src/USnippetsTVDraw.pas +++ b/Src/USnippetsTVDraw.pas @@ -20,7 +20,7 @@ interface // Delphi ComCtrls, // Project - DB.UCollections; + DB.Vaults; type diff --git a/Src/UStatusBarMgr.pas b/Src/UStatusBarMgr.pas index 6f0e77beb..41fda6ac1 100644 --- a/Src/UStatusBarMgr.pas +++ b/Src/UStatusBarMgr.pas @@ -121,8 +121,8 @@ implementation SysUtils, Forms, // Project - DB.UCollections, DB.UMain, + DB.Vaults, UQuery, USearch, UStructs; diff --git a/Src/UTextSnippetDoc.pas b/Src/UTextSnippetDoc.pas index e38a66965..55e24ca47 100644 --- a/Src/UTextSnippetDoc.pas +++ b/Src/UTextSnippetDoc.pas @@ -20,8 +20,11 @@ interface // Delphi Classes, // Project - DB.UCollections, - ActiveText.UMain, UEncodings, UIStringList, USnippetDoc; + ActiveText.UMain, + DB.Vaults, + UEncodings, + UIStringList, + USnippetDoc; type diff --git a/Src/UUserDBBackup.pas b/Src/UUserDBBackup.pas index 05eaecc77..9e3b8e8e9 100644 --- a/Src/UUserDBBackup.pas +++ b/Src/UUserDBBackup.pas @@ -20,7 +20,7 @@ interface uses // Project - DB.UCollections, + DB.Vaults, UFolderBackup; diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index fd1deb5bb..d03644d52 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -96,9 +96,9 @@ implementation Windows {for inlining}, IOUtils, // Project - DB.UCollections, DB.UMain, DB.USnippet, + DB.Vaults, FmAddCategoryDlg, FmCollectionBackup, FmDeleteCategoryDlg, diff --git a/Src/UUserDBMove.pas b/Src/UUserDBMove.pas index a5eabca6f..81a3d983a 100644 --- a/Src/UUserDBMove.pas +++ b/Src/UUserDBMove.pas @@ -17,7 +17,7 @@ interface uses // Project - DB.UCollections, + DB.Vaults, UDirectoryCopier; diff --git a/Src/UWBExternal.pas b/Src/UWBExternal.pas index 758946f5c..8753749c7 100644 --- a/Src/UWBExternal.pas +++ b/Src/UWBExternal.pas @@ -112,7 +112,7 @@ implementation // Delphi Forms, // Project - DB.UCollections, + DB.Vaults, UAppInfo; From a1a15b7cd6dcfc94fe29959364bfd3d054335c4a Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 14:50:23 +0000 Subject: [PATCH 156/222] Rename TSnippetID.CollectionID property to VaultID Renamed any method parameters in USnippetIDs with "collection" in their names to use "vault" instead. Also made minimal changes to code affected by the renaming. Updated commenting in USnippetIDs unit to replace references to collection with references to vault. --- Src/DB.UMain.pas | 2 +- Src/DB.USnippet.pas | 2 +- Src/Favourites.UPersist.pas | 2 +- Src/FmFavouritesDlg.pas | 6 ++--- Src/UCodeImportMgr.pas | 2 +- Src/USnippetIDListIOHandler.pas | 2 +- Src/USnippetIDs.pas | 44 ++++++++++++++++----------------- 7 files changed, 29 insertions(+), 31 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 69332d14b..18813be54 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -1229,7 +1229,7 @@ function TDatabase.UpdateSnippet(const ASnippet: TSnippet; InternalDeleteSnippet(ASnippet); // add new, post-update snippet with same key & collection ID as old snippet Result := InternalAddSnippet( - PreservedSnippetID.Key, PreservedSnippetID.CollectionID, AData + PreservedSnippetID.Key, PreservedSnippetID.VaultID, AData ); // add updated snippet to referrer lists of referring snippets diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index d0775f759..e0d42e01a 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -782,7 +782,7 @@ function TSnippetList.Find(const SnippetID: TSnippetID): TSnippet; @return Reference to required snippet or nil if not found. } begin - Result := Find(SnippetID.Key, SnippetID.CollectionID); + Result := Find(SnippetID.Key, SnippetID.VaultID); end; function TSnippetList.GetEnumerator: TEnumerator; diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index 585280cfc..4eaf7fdf6 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -145,7 +145,7 @@ class procedure TFavouritesPersist.Save(Favourites: TFavourites); TSVWriter.WriteLine( [ Fav.SnippetID.Key, - Fav.SnippetID.CollectionID.ToHexString, + Fav.SnippetID.VaultID.ToHexString, DateTimeToStr(Fav.LastAccessed, DateFormatSettings) ] ); diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index ca3353e89..12a798dfb 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -353,9 +353,7 @@ procedure TFavouritesDlg.actDisplayExecute(Sender: TObject); LI := fLVFavs.Selected as TFavouriteListItem; SelectedSnippet := LI.Favourite.SnippetID; fNotifier.DisplaySnippet( - SelectedSnippet.Key, - SelectedSnippet.CollectionID, - chkNewTab.Checked + SelectedSnippet.Key, SelectedSnippet.VaultID, chkNewTab.Checked ); fFavourites.Touch(SelectedSnippet); fLVFavs.Selected := FindListItem(SelectedSnippet); @@ -591,7 +589,7 @@ procedure TFavouritesDlg.LVCustomDrawItem(Sender: TCustomListView; var CollectionID: TVaultID; begin - CollectionID := (Item as TFavouriteListItem).Favourite.SnippetID.CollectionID; + CollectionID := (Item as TFavouriteListItem).Favourite.SnippetID.VaultID; fLVFavs.Canvas.Font.Color := Preferences.GetSnippetHeadingColour( CollectionID ); diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index 30191fbd6..b4a9af248 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -241,7 +241,7 @@ procedure TCodeImportMgr.UpdateDatabase; for SnippetID in ARefs do begin if fImportInfoList.FindByKey(SnippetID.Key, Info) and not Info.Skip then - Result.Add(TSnippetID.Create(Info.NewKey, SnippetID.CollectionID)); + Result.Add(TSnippetID.Create(Info.NewKey, SnippetID.VaultID)); end; end; diff --git a/Src/USnippetIDListIOHandler.pas b/Src/USnippetIDListIOHandler.pas index 3bbe95b12..8563904af 100644 --- a/Src/USnippetIDListIOHandler.pas +++ b/Src/USnippetIDListIOHandler.pas @@ -145,7 +145,7 @@ procedure TSnippetIDListFileWriter.WriteFile(const FileName: string; try try for SnippetID in SnippetIDs do - TSVWriter.WriteLine([SnippetID.Key, SnippetID.CollectionID.ToHexString]); + TSVWriter.WriteLine([SnippetID.Key, SnippetID.VaultID.ToHexString]); finally TSVWriter.Free; end; diff --git a/Src/USnippetIDs.pas b/Src/USnippetIDs.pas index 9380e21e8..d1e94eb08 100644 --- a/Src/USnippetIDs.pas +++ b/Src/USnippetIDs.pas @@ -28,15 +28,16 @@ interface type /// Record that uniquely identifies a code snippet. - /// Comprises the snippet's key and collection. + /// Comprises the snippet's key and vault ID. TSnippetID = record strict private var /// Value of Key property. fKey: string; - fCollectionID: TVaultID; + /// Value of VaultID property. + fVaultID: TVaultID; procedure SetKey(const AValue: string); - procedure SetCollectionID(const AValue: TVaultID); + procedure SetVaultID(const AValue: TVaultID); public type TComparer = class(TInterfacedObject, @@ -55,13 +56,13 @@ TComparer = class(TInterfacedObject, /// ID of the vault to which a snippet with this ID belongs. /// - /// ID must not be null. - property CollectionID: TVaultID - read fCollectionID write SetCollectionID; + /// VaultID must not be null. + property VaultID: TVaultID + read fVaultID write SetVaultID; /// Creates a record with given property values. - /// ACollectionID must not be null. - constructor Create(const AKey: string; const ACollectionID: TVaultID); + /// AVaultID must not be null. + constructor Create(const AKey: string; const AVaultID: TVaultID); /// Creates copy of given snippet ID constructor Clone(const Src: TSnippetID); @@ -179,7 +180,7 @@ implementation constructor TSnippetID.Clone(const Src: TSnippetID); begin - Create(Src.Key, Src.CollectionID); + Create(Src.Key, Src.VaultID); end; class function TSnippetID.CompareKeys(const Left, Right: string): Integer; @@ -191,14 +192,13 @@ function TSnippetID.CompareTo(const SID: TSnippetID): Integer; begin Result := CompareKeys(Key, SID.Key); if Result = 0 then - Result := TVaultID.Compare(CollectionID, SID.CollectionID); + Result := TVaultID.Compare(VaultID, SID.VaultID); end; -constructor TSnippetID.Create(const AKey: string; - const ACollectionID: TVaultID); +constructor TSnippetID.Create(const AKey: string; const AVaultID: TVaultID); begin SetKey(AKey); - SetCollectionID(ACollectionID); + SetVaultID(AVaultID); end; class operator TSnippetID.Equal(const SID1, SID2: TSnippetID): Boolean; @@ -211,9 +211,9 @@ function TSnippetID.Hash: Integer; PartialHash: Integer; KeyBytes: TBytes; begin - // Hash is created from hash of CollectionID property combined with hash of - // Key property after converting to a byte array in UTF8 format. - PartialHash := fCollectionID.Hash; + // Hash is created from hash of VaultID property combined with hash of Key + // property after converting to a byte array in UTF8 format. + PartialHash := fVaultID.Hash; KeyBytes := TEncoding.UTF8.GetBytes(fKey); Result := BobJenkinsHash(KeyBytes[0], Length(KeyBytes), PartialHash); end; @@ -223,18 +223,18 @@ function TSnippetID.Hash: Integer; Result := not (SID1 = SID2); end; -procedure TSnippetID.SetCollectionID(const AValue: TVaultID); -begin - Assert(not AValue.IsNull, 'TSnippetID.SetCollectionID: Value is null'); - fCollectionID := AValue.Clone; -end; - procedure TSnippetID.SetKey(const AValue: string); begin fKey := StrTrim(AValue); Assert(fKey <> '', 'TSnippetID.SetKey: Value is whitespace or empty'); end; +procedure TSnippetID.SetVaultID(const AValue: TVaultID); +begin + Assert(not AValue.IsNull, 'TSnippetID.SetVaultID: Value is null'); + fVaultID := AValue.Clone; +end; + { TSnippetID.TComparer } function TSnippetID.TComparer.Compare(const Left, Right: TSnippetID): Integer; From dc035103c625a76b34fab13fffe58715998a367b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 15:08:28 +0000 Subject: [PATCH 157/222] Rename TSnippet.CollectionID property to VaultID Renamed any method parameters in DB.USnippet with "collection" in their names to use "vault" instead. Also made minimal changes to code affected by the renaming. Updated commenting in DB.USnippet unit to replace references to collection with references to vault. --- Src/DB.UDatabaseIO.pas | 4 +- Src/DB.UMain.pas | 6 +- Src/DB.USnippet.pas | 102 ++++++++++++++++------------------ Src/FmDependenciesDlg.pas | 4 +- Src/FmDuplicateSnippetDlg.pas | 2 +- Src/FmFindXRefsDlg.pas | 2 +- Src/FmMain.pas | 2 +- Src/FmSelectionSearchDlg.pas | 2 +- Src/FmSnippetsEditorDlg.pas | 6 +- Src/FmTestCompileDlg.pas | 2 +- Src/FrDetailView.pas | 2 +- Src/FrOverview.pas | 2 +- Src/FrSelectSnippetsBase.pas | 2 +- Src/UDetailPageHTML.pas | 2 +- Src/URTFCategoryDoc.pas | 2 +- Src/USaveUnitMgr.pas | 2 +- Src/USnippetDoc.pas | 4 +- Src/USnippetHTML.pas | 2 +- Src/USnippetSourceGen.pas | 4 +- Src/USnippetsChkListMgr.pas | 2 +- 20 files changed, 76 insertions(+), 80 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 76b01fe39..cd18bf65c 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -554,7 +554,7 @@ procedure TDatabaseLoader.HandleException(const E: Exception); function TDatabaseLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; begin - Result := Snippet.CollectionID = Collection.UID; + Result := Snippet.VaultID = Collection.UID; end; procedure TDatabaseLoader.Load(const SnipList: TSnippetList; @@ -822,7 +822,7 @@ procedure TFormatSaver.WriteSnippets; begin for Snippet in fSnipList do begin - if Snippet.CollectionID = fCollection.UID then + if Snippet.VaultID = fCollection.UID then begin // Get and write a snippet's properties Props := fProvider.GetSnippetProps(Snippet); diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 18813be54..1f89a9d52 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -781,7 +781,7 @@ function TDatabase.CreateTempSnippet(const Snippet: TSnippet): TSnippet; ClassName + '.CreateTempSnippet: Snippet is a TSnippetEx'); Data := (Snippet as TSnippetEx).GetEditData; Result := TTempSnippet.Create( - Snippet.Key, Snippet.CollectionID, (Snippet as TSnippetEx).GetProps); + Snippet.Key, Snippet.VaultID, (Snippet as TSnippetEx).GetProps); (Result as TTempSnippet).UpdateRefs( (Snippet as TSnippetEx).GetReferences, fSnippets ); @@ -1000,7 +1000,7 @@ function TDatabase.GetUniqueSnippetKey(const ACollectionID: TVaultID): string; try // Build list of all snippets in collection for Snippet in fSnippets do - if Snippet.CollectionID = ACollectionID then + if Snippet.VaultID = ACollectionID then SnippetsInCollection.Add(Snippet); repeat Result := TUniqueID.GenerateAlpha; @@ -1319,7 +1319,7 @@ function TCollectionDataProvider.GetCategorySnippets( begin Result := TIStringList.Create; for Snippet in Cat.Snippets do - if Snippet.CollectionID = fCollectionID then + if Snippet.VaultID = fCollectionID then Result.Add(Snippet.Key); end; diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index e0d42e01a..83d651791 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -132,14 +132,14 @@ TDisplayNameComparer = class(TComparer) fCategory: string; // Name of snippet's category fDescription: IActiveText; // Description of snippet fSourceCode: string; // Snippet source code - fKey: string; // Snippet key: unique in collection + fKey: string; // Snippet key: unique in vault fDisplayName: string; // Display name of snippet fUnits: TStringList; // List of required units fDepends: TSnippetList; // List of required snippets fXRef: TSnippetList; // List of cross-referenced snippets fExtra: IActiveText; // Further information for snippet fCompatibility: TCompileResults; // Snippet's compiler compatibility - fCollectionID: TVaultID; // Snippet's vault ID + fVaultID: TVaultID; // Snippet's vault ID fHiliteSource: Boolean; // If source is syntax highlighted fTestInfo: TSnippetTestInfo; // Level of testing of snippet function GetID: TSnippetID; @@ -166,13 +166,13 @@ TDisplayNameComparer = class(TComparer) public /// Object constructor. Sets up snippet object with given property - /// values belonging to a specified collection. + /// values belonging to a specified vault. /// string [in] Snippet's key. - /// TVaultID [in] ID of vault to which - /// the snippet belongs. ID must not be null. + /// TVaultID [in] ID of vault to which the + /// snippet belongs. Must not be null. /// TSnippetData [in] Values of snippet /// properties. - constructor Create(const AKey: string; const ACollectionID: TVaultID; + constructor Create(const AKey: string; const AVaultID: TVaultID; const Props: TSnippetData); destructor Destroy; override; @@ -185,13 +185,14 @@ TDisplayNameComparer = class(TComparer) /// this snippet is less than Snippets or +ve if this snippet is /// greater than Snippet. function CompareTo(const Snippet: TSnippet): Integer; + + /// Checks if this snippet is same as another snippet. Snippets + /// are considered equal if they have the same key and vault ID. + /// TSnippet [in] Snippet being compared. + /// + /// Boolean.True if snippets are equal, False if not. + /// function IsEqual(const Snippet: TSnippet): Boolean; - {Checks if this snippet is same as another snippet. Snippets are - considered equal if they have the same key and come from the same - collection. - @param Snippet [in] Snippet being compared. - @return True if snippets are equal, False if not. - } function CanCompile: Boolean; {Checks if snippet can be compiled. @return True if compilation supported and False if not. @@ -227,7 +228,7 @@ TDisplayNameComparer = class(TComparer) property XRef: TSnippetList read fXRef; {List of cross referenced snippets in database} /// ID of vault to which the snippet belongs. - property CollectionID: TVaultID read fCollectionID; + property VaultID: TVaultID read fVaultID; end; { @@ -284,16 +285,16 @@ TSnippetList = class(TObject) @return Snippet at specified index in list. } - /// Finds a snippet in the list with whose key and collection ID - /// match. + /// Finds a snippet in the list with whose key and vault ID match. + /// /// string [in] Snippet's key. - /// TVaultID [in] ID of vault to which - /// the snippet belongs. + /// TVaultID [in] ID of vault to which the + /// snippet belongs. /// Integer. [out] Set to the index of the /// required snippet in the list. Valid only if the snippet was found. /// /// Boolean. True if snippet found, False if not. - function Find(const SnippetKey: string; const ACollectionID: TVaultID; + function Find(const SnippetKey: string; const AVaultID: TVaultID; out Index: Integer): Boolean; overload; strict protected @@ -329,15 +330,15 @@ TSnippetList = class(TObject) @return Reference to required snippet or nil if not found. } - /// Finds a snippet in the list with whose key and collection ID - /// match. + /// Finds a snippet in the list with whose key and vault ID match. + /// /// string [in] Snippet's key. - /// TVaultID [in] ID of vault to which - /// the snippet belongs. + /// TVaultID [in] ID of vault to which the + /// snippet belongs. /// TSnippet. Reference to the required snippet or nil if /// not found. - function Find(const SnippetKey: string; - const ACollectionID: TVaultID): TSnippet; overload; + function Find(const SnippetKey: string; const AVaultID: TVaultID): TSnippet; + overload; function Contains(const Snippet: TSnippet): Boolean; {Checks whether list contains a specified snippet. @@ -359,11 +360,11 @@ TSnippetList = class(TObject) } /// Counts number of snippets in list that belong to a specified - /// collection. - /// TVaultID [in] Required vault. + /// vault. + /// TVaultID [in] ID of required vault. /// - /// Integer Number of snippets in the collection. - function Count(const ACollectionID: TVaultID): Integer; overload; + /// Integer Number of snippets in the vault. + function Count(const AVaultID: TVaultID): Integer; overload; function Count: Integer; overload; {Counts number of snippets in list. @@ -375,11 +376,11 @@ TSnippetList = class(TObject) } /// Checks if the sub-set of snippets in the list belonging to a - /// specified collection is empty. - /// TVaultID [in] ID of vault. + /// specified vault is empty. + /// TVaultID [in] ID of vault. /// Boolean True if the subset is empty, False otherwise. /// - function IsEmpty(const ACollectionID: TVaultID): Boolean; overload; + function IsEmpty(const AVaultID: TVaultID): Boolean; overload; property Items[Idx: Integer]: TSnippet read GetItem; default; {List of snippets} @@ -441,13 +442,13 @@ function TSnippet.CompareTo(const Snippet: TSnippet): Integer; Result := Self.ID.CompareTo(Snippet.ID); end; -constructor TSnippet.Create(const AKey: string; - const ACollectionID: TVaultID; const Props: TSnippetData); +constructor TSnippet.Create(const AKey: string; const AVaultID: TVaultID; + const Props: TSnippetData); begin Assert(ClassType <> TSnippet, ClassName + '.Create: must only be called from descendants.'); - Assert(not ACollectionID.IsNull, - ClassName + '.Create: ACollectionID is null'); + Assert(not AVaultID.IsNull, + ClassName + '.Create: AVaultID is null'); inherited Create; // Record simple property values SetKey(AKey); @@ -457,8 +458,8 @@ constructor TSnippet.Create(const AKey: string; // Create snippets lists for Depends and XRef properties fDepends := TSnippetListEx.Create; fXRef := TSnippetListEx.Create; - // The following property added to support multiple snippet collections - fCollectionID := ACollectionID.Clone; + // The following property added to support multiple snippet vaults + fVaultID := AVaultID.Clone; end; destructor TSnippet.Destroy; @@ -491,7 +492,7 @@ function TSnippet.GetID: TSnippetID; @return Required ID. } begin - Result := TSnippetID.Create(fKey, fCollectionID); + Result := TSnippetID.Create(fKey, fVaultID); end; function TSnippet.Hash: Integer; @@ -501,11 +502,6 @@ function TSnippet.Hash: Integer; end; function TSnippet.IsEqual(const Snippet: TSnippet): Boolean; - {Checks if this snippet is same as another snippet. Snippets are considered - equal if they have the same key and come from the same collection. - @param Snippet [in] Snippet being compared. - @return True if snippets are equal, False if not. - } begin Result := CompareTo(Snippet) = 0; end; @@ -709,13 +705,13 @@ function TSnippetList.ContainsKinds(const Kinds: TSnippetKinds): Boolean; end; end; -function TSnippetList.Count(const ACollectionID: TVaultID): Integer; +function TSnippetList.Count(const AVaultID: TVaultID): Integer; var Snippet: TSnippet; // refers to all snippets in list begin Result := 0; for Snippet in Self do - if Snippet.CollectionID = ACollectionID then + if Snippet.VaultID = AVaultID then Inc(Result); end; @@ -748,8 +744,8 @@ destructor TSnippetList.Destroy; inherited; end; -function TSnippetList.Find(const SnippetKey: string; - const ACollectionID: TVaultID; out Index: Integer): Boolean; +function TSnippetList.Find(const SnippetKey: string; const AVaultID: TVaultID; + out Index: Integer): Boolean; var TempSnippet: TSnippet; // temp snippet used to perform search NullData: TSnippetData; // nul data used to create snippet @@ -757,7 +753,7 @@ function TSnippetList.Find(const SnippetKey: string; // We need a temporary snippet object in order to perform binary search using // object list's built in search NullData.Init; - TempSnippet := TTempSnippet.Create(SnippetKey, ACollectionID, NullData); + TempSnippet := TTempSnippet.Create(SnippetKey, AVaultID, NullData); try Result := fList.Find(TempSnippet, Index); finally @@ -765,12 +761,12 @@ function TSnippetList.Find(const SnippetKey: string; end; end; -function TSnippetList.Find(const SnippetKey: string; - const ACollectionID: TVaultID): TSnippet; +function TSnippetList.Find(const SnippetKey: string; const AVaultID: TVaultID): + TSnippet; var Idx: Integer; // index of snippet key in list begin - if Find(SnippetKey, ACollectionID, Idx) then + if Find(SnippetKey, AVaultID, Idx) then Result := Items[Idx] else Result := nil; @@ -810,9 +806,9 @@ function TSnippetList.IsEmpty: Boolean; Result := Count = 0; end; -function TSnippetList.IsEmpty(const ACollectionID: TVaultID): Boolean; +function TSnippetList.IsEmpty(const AVaultID: TVaultID): Boolean; begin - Result := Count(ACollectionID) = 0; + Result := Count(AVaultID) = 0; end; function TSnippetList.IsEqual(const AList: TSnippetList): Boolean; diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index 74a672c43..15f5a10a6 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -467,7 +467,7 @@ procedure TDependenciesDlg.PopulateRequiredByList; Assert(Assigned(ASnippet), ClassName + '.PopulateRequiredByList: Snippet id not found'); lbDependents.Items.AddObject( - ASnippet.DisplayName, TBox.Create(ASnippet.CollectionID) + ASnippet.DisplayName, TBox.Create(ASnippet.VaultID) ); end; end; @@ -523,7 +523,7 @@ function TDependenciesDlg.TTVDraw.GetCollectionID( if not Assigned(Node.Data) then Result := TVaultID.CreateNull else - Result := TSnippet(Node.Data).CollectionID; + Result := TSnippet(Node.Data).VaultID; end; function TDependenciesDlg.TTVDraw.IsErrorNode( diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 7ff4dddb8..9fa7265a4 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -209,7 +209,7 @@ procedure TDuplicateSnippetDlg.InitForm; Assert(Assigned(SnippetCat), ClassName + '.InitForm: invalid category'); cbCategory.ItemIndex := cbCategory.Items.IndexOf(SnippetCat.Description); - SnippetColl := TVaults.Instance.GetVault(fSnippet.CollectionID); + SnippetColl := TVaults.Instance.GetVault(fSnippet.VaultID); cbCollection.ItemIndex := cbCollection.Items.IndexOf(SnippetColl.Name); chkEdit.Checked := fOptions.EditSnippetOnClose; diff --git a/Src/FmFindXRefsDlg.pas b/Src/FmFindXRefsDlg.pas index cc6192e15..b9528b58c 100644 --- a/Src/FmFindXRefsDlg.pas +++ b/Src/FmFindXRefsDlg.pas @@ -235,7 +235,7 @@ procedure TFindXRefsDlg.ConfigForm; // Set label font styles and colours lblSnippetName.Font.Style := [fsBold]; lblSnippetName.Font.Color := - Preferences.GetSnippetHeadingColour(fSnippet.CollectionID); + Preferences.GetSnippetHeadingColour(fSnippet.VaultID); // Display selected snippet name in appropriate controls lblSnippetName.Caption := fSnippet.DisplayName; chkIncludeSnippet.Caption := Format( diff --git a/Src/FmMain.pas b/Src/FmMain.pas index 7a6307bf2..e7ddd3948 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -798,7 +798,7 @@ procedure TMainForm.actEditSnippetExecute(Sender: TObject); Assert(TUserDBMgr.CanEdit(fMainDisplayMgr.CurrentView), ClassName + '.actEditSnippetExecute: Can''t edit current view item'); Snippet := (fMainDisplayMgr.CurrentView as ISnippetView).Snippet; - fNotifier.EditSnippet(Snippet.Key, Snippet.CollectionID); + fNotifier.EditSnippet(Snippet.Key, Snippet.VaultID); // display of updated snippet is handled by snippets change event handler end; diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index aec070472..1430206ae 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -296,7 +296,7 @@ procedure TSelectionSearchDlg.SelectDB(const ACollectionID: TVaultID); SnippetList := TSnippetList.Create; try for Snippet in Database.Snippets do - if Snippet.CollectionID = ACollectionID then + if Snippet.VaultID = ACollectionID then SnippetList.Add(Snippet); frmSelect.SelectedSnippets := SnippetList; finally diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 27ce16af8..fcbe5ba39 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -891,7 +891,7 @@ procedure TSnippetsEditorDlg.InitControls; frmDescription.ActiveText := fSnippet.Description; edDisplayName.Text := fSnippet.DisplayName; cbCategories.ItemIndex := fCatList.IndexOf(fSnippet.Category); - cbCollection.ItemIndex := fCollList.IndexOfUID(fSnippet.CollectionID); + cbCollection.ItemIndex := fCollList.IndexOfUID(fSnippet.VaultID); cbCollection.Visible := False; // can't change existing snippet collection lblCollectionInfo.Caption := cbCollection.Text; lblCollectionInfo.Visible := True; @@ -1007,7 +1007,7 @@ function TSnippetsEditorDlg.SelectedCollectionID: TVaultID; // If editing existing snippet ID then the collection cannot be edited if Assigned(fSnippet) then // Editing existing snippet: can't change collection - Result := fSnippet.CollectionID + Result := fSnippet.VaultID else // Editing new snippet: chosing collection is permitted Result := fCollList.Collection(cbCollection.ItemIndex).UID; @@ -1076,7 +1076,7 @@ procedure TSnippetsEditorDlg.UpdateReferences; } for Snippet in Database.Snippets do begin - if Snippet.CollectionID <> SelectedCollectionID then + if Snippet.VaultID <> SelectedCollectionID then Continue; if Snippet.ID <> EditSnippetID then begin diff --git a/Src/FmTestCompileDlg.pas b/Src/FmTestCompileDlg.pas index 43d2050e5..0cec0e356 100644 --- a/Src/FmTestCompileDlg.pas +++ b/Src/FmTestCompileDlg.pas @@ -289,7 +289,7 @@ procedure TTestCompileDlg.ConfigForm; // Set required label fonts and captions TFontHelper.SetDefaultBaseFont(lblSnippetName.Font); lblSnippetName.Font.Color := - Preferences.GetSnippetHeadingColour(fSnippet.CollectionID); + Preferences.GetSnippetHeadingColour(fSnippet.VaultID); lblSnippetName.Caption := fSnippet.DisplayName; end; diff --git a/Src/FrDetailView.pas b/Src/FrDetailView.pas index 327ccefcc..c4b69631a 100644 --- a/Src/FrDetailView.pas +++ b/Src/FrDetailView.pas @@ -394,7 +394,7 @@ function TDetailViewFrame.GetHeadingColour(AView: IView): TColor; begin if Supports(AView, ISnippetView, SnippetView) then Result := Preferences.GetSnippetHeadingColour( - SnippetView.Snippet.CollectionID + SnippetView.Snippet.VaultID ) else Result := Preferences.GroupHeadingColour; diff --git a/Src/FrOverview.pas b/Src/FrOverview.pas index da5806a6c..7a86b80cf 100644 --- a/Src/FrOverview.pas +++ b/Src/FrOverview.pas @@ -986,7 +986,7 @@ function TOverviewFrame.TTVDraw.GetCollectionID(const Node: TTreeNode): // TODO -cBug: Exception reported as issue #70 could have moved here ViewItem := (Node as TViewItemTreeNode).ViewItem; if Supports(ViewItem, ISnippetView, SnippetView) then - Result := SnippetView.Snippet.CollectionID + Result := SnippetView.Snippet.VaultID else Result := TVaultID.CreateNull; end; diff --git a/Src/FrSelectSnippetsBase.pas b/Src/FrSelectSnippetsBase.pas index e5e1130ca..fbacfe843 100644 --- a/Src/FrSelectSnippetsBase.pas +++ b/Src/FrSelectSnippetsBase.pas @@ -281,7 +281,7 @@ function TSelectSnippetsBaseFrame.TTVDraw.GetCollectionID( begin SnipObj := TObject(Node.Data); if SnipObj is TSnippet then - Result := (SnipObj as TSnippet).CollectionID + Result := (SnipObj as TSnippet).VaultID else Result := TVaultID.CreateNull end; diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 6b9d042e7..448c94429 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -515,7 +515,7 @@ procedure TSnippetInfoPageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); Tplt.ResolvePlaceholderText( 'EditEventHandler', TJavaScript.LiteralFunc( - 'editSnippet', [GetSnippet.Key, GetSnippet.CollectionID.ToHexString] + 'editSnippet', [GetSnippet.Key, GetSnippet.VaultID.ToHexString] ) ); SnippetHTML := TSnippetHTML.Create(GetSnippet); diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index a410ae6dd..6b3c94767 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -235,7 +235,7 @@ procedure TRTFCategoryDoc.OutputSnippetSubHeading(const Snippet: TSnippet); fBuilder.SetFont(MainFontName); fBuilder.SetFontSize(SubHeadingFontSize); fBuilder.SetFontStyle([fsBold]); - SetColour(Preferences.GetSnippetHeadingColour(Snippet.CollectionID)); + SetColour(Preferences.GetSnippetHeadingColour(Snippet.VaultID)); fBuilder.AddText(Snippet.DisplayName); fBuilder.EndPara; fBuilder.EndGroup; diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index 2af2f0e28..5ab0e2493 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -280,7 +280,7 @@ constructor TSaveUnitMgr.InternalCreate(const Snips: TSnippetList); // Count the number of vaults containing snippet in the list for Snippet in Snips do begin - Collection := TVaults.Instance.GetVault(Snippet.CollectionID); + Collection := TVaults.Instance.GetVault(Snippet.VaultID); if not fCollections.Contains(Collection) then fCollections.Add(Collection); end; diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index 1a8ad90d2..646c986a6 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -206,7 +206,7 @@ function TSnippetDoc.Generate(const Snippet: TSnippet): TEncodedData; Assert(Assigned(Snippet), ClassName + '.Create: Snippet is nil'); // generate document InitialiseDoc; - RenderHeading(Snippet.DisplayName, Snippet.CollectionID); + RenderHeading(Snippet.DisplayName, Snippet.VaultID); RenderDescription(Snippet.Description); RenderSourceCode(Snippet.SourceCode); RenderTitledText( @@ -228,7 +228,7 @@ function TSnippetDoc.Generate(const Snippet: TSnippet): TEncodedData; end; if Snippet.Extra.HasContent then RenderExtra(Snippet.Extra); - RenderCollectionInfo(CollectionInfo(Snippet.CollectionID)); + RenderCollectionInfo(CollectionInfo(Snippet.VaultID)); Result := FinaliseDoc; end; diff --git a/Src/USnippetHTML.pas b/Src/USnippetHTML.pas index e5783b245..48c19f26d 100644 --- a/Src/USnippetHTML.pas +++ b/Src/USnippetHTML.pas @@ -207,7 +207,7 @@ class function TSnippetHTML.SnippetALink(const Snippet: TSnippet): string; // Create javascript link enclosing snippet key Result := JSALink( TJavaScript.LiteralFunc( - 'displaySnippet', [Snippet.Key, Snippet.CollectionID.ToHexString] + 'displaySnippet', [Snippet.Key, Snippet.VaultID.ToHexString] ), 'snippet-link', Snippet.DisplayName diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index 1a81153fd..337b62dcb 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -255,7 +255,7 @@ procedure TSnippetSourceGen.Initialize(View: IView); // view is single snippet: just record that Snippet := (View as ISnippetView).Snippet; fGenerator.IncludeSnippet(Snippet); - fCollections.Add(TVaults.Instance.GetVault(Snippet.CollectionID)); + fCollections.Add(TVaults.Instance.GetVault(Snippet.VaultID)); end else begin @@ -266,7 +266,7 @@ procedure TSnippetSourceGen.Initialize(View: IView); fGenerator.IncludeSnippets(Snips); // ignores freeform snippets for Snippet in Snips do begin - Collection := TVaults.Instance.GetVault(Snippet.CollectionID); + Collection := TVaults.Instance.GetVault(Snippet.VaultID); if not fCollections.Contains(Collection) then fCollections.Add(Collection); end; diff --git a/Src/USnippetsChkListMgr.pas b/Src/USnippetsChkListMgr.pas index 4a028eede..b9a606cf5 100644 --- a/Src/USnippetsChkListMgr.pas +++ b/Src/USnippetsChkListMgr.pas @@ -204,7 +204,7 @@ procedure TSnippetsChkListMgr.DrawItem(Control: TWinControl; Index: Integer; Canvas := fCLB.Canvas; if not (odSelected in State) then Canvas.Font.Color := Preferences.GetSnippetHeadingColour( - (fCLB.Items.Objects[Index] as TSnippet).CollectionID + (fCLB.Items.Objects[Index] as TSnippet).VaultID ); Canvas.TextRect( Rect, From 02e2023b88bad2f975abd1d14dd741d20bd66748 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 15:26:42 +0000 Subject: [PATCH 158/222] Renaming in DB.UDatabaseIO unit Updated various identifiers and comments that referred to collections to reference vaults. None of these changes affected the interface with other units. --- Src/DB.UDatabaseIO.pas | 133 +++++++++++++++++++++-------------------- 1 file changed, 67 insertions(+), 66 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index cd18bf65c..c98e39a30 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -31,16 +31,16 @@ interface type - /// Interface to objects that can load data into a collection within - /// the database from storage in a supported data format. + /// Interface to objects that can load data into a vault within the + /// database from storage in a supported data format. IDataFormatLoader = interface(IInterface) ['{C6AF94FC-F56F-44AE-9E79-3B0CD0BB21D4}'] - /// Loads data from storage into a collection within the database. + /// Loads data from storage into a vault within the database. /// /// TSnippetList [in] Receives information - /// about each snippet in the collection. + /// about each snippet in the vault. /// TCategoryList [in] Receives information - /// about each category in the collection. + /// about each category in the vault. /// DBDataItemFactory [in] Object /// used to create new categories and snippets. procedure Load(const SnipList: TSnippetList; @@ -48,8 +48,8 @@ interface const DBDataItemFactory: IDBDataItemFactory); end; - /// Interface to objects that can save data from a collection within - /// the database into storage in a supported data format. + /// Interface to objects that can save data from a vault within the + /// database into storage in a supported data format. IDataFormatSaver = interface(IInterface) ['{F46EE2E3-68A7-4877-9E04-192D15D29BB1}'] /// Saves data to storage. @@ -64,7 +64,7 @@ interface end; /// Interface to object that can save global category information, - /// regardless of any categories saved with collections. + /// regardless of any categories saved with vaults. IGlobalCategoryLoader = interface(IInterface) ['{0029F641-FAC4-43C8-A412-F70554BDCF28}'] /// Loads categories data from global storage. @@ -77,7 +77,7 @@ interface end; /// Interface to object that can load global category information, - /// regardless of any categories loaded with collections. + /// regardless of any categories loaded with vaults. IGlobalCategorySaver = interface(IInterface) ['{D967E4FC-32FA-47F8-9BE0-4B25C7215CCA}'] /// Saves category data to global storage. @@ -96,12 +96,12 @@ TDatabaseIOFactory = class(TNoConstructObject) /// Creates and returns an object to be used to load the given /// vault's data in the correct format. Nil is returned if no loader object /// is supported. - class function CreateDBLoader(const Collection: TVault): IDataFormatLoader; + class function CreateDBLoader(const AVault: TVault): IDataFormatLoader; /// Creates and returns an object to be used to save the given /// vaults's data in the correct format. Nil is return if no saver object /// is supported. - class function CreateDBSaver(const Collection: TVault): IDataFormatSaver; + class function CreateDBSaver(const AVault: TVault): IDataFormatSaver; /// Creates and returns an object to be used to load a list of /// globally stored categories. @@ -168,7 +168,7 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) fSnipList: TSnippetList; // Receives list of snippets fCategories: TCategoryList; // Receives list of categories fFactory: IDBDataItemFactory; // Object creates new categories and snippets - fCollection: TVault; // Vault being loaded + fVault: TVault; // Vault being loaded procedure LoadSnippets(const Cat: TCategory); {Loads all snippets in a category. @param Cat [in] Category to be loaded. @@ -218,9 +218,10 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) } property Categories: TCategoryList read fCategories; {Reference to category list} - property Collection: TVault read fCollection; + /// The vault being loaded. + property Vault: TVault read fVault; public - constructor Create(const ACollection: TVault); + constructor Create(const AVault: TVault); { IDataFormatLoader method } procedure Load(const SnipList: TSnippetList; const Categories: TCategoryList; @@ -289,7 +290,7 @@ TNativeVaultFormatLoader = class(TDatabaseLoader, IDataFormatLoader) Would need to make sure all .Save methods in sub-classes are identical first. } - /// Base for classes that save a collection to storage. + /// Base for classes that save a vault to storage. TFormatSaver = class abstract (TInterfacedObject, IDataFormatSaver ) @@ -299,22 +300,22 @@ TFormatSaver = class abstract (TInterfacedObject, fSnipList: TSnippetList; // List of snippets to be written fCategories: TCategoryList; // List of categories to be written fProvider: IDBDataProvider; // Object used to get data to be written - fCollection: TVault; // Vault being written + fVault: TVault; // Vault being saved /// Writes information about all snippets belonging to the - /// collection. + /// vault being saved. procedure WriteSnippets; /// Writes information about categories relevant to the - /// collection. + /// vault. procedure WriteCategories; - /// Writes the collection's meta data, if supported. + /// Writes the vault's meta data, if supported. procedure WriteMetaData; strict protected - /// Saves collection to storage. + /// Saves vault to storage. /// TSnippetList [in] List of all snippets /// in the database. /// TCategoryList [in] List of all @@ -331,12 +332,12 @@ TFormatSaver = class abstract (TInterfacedObject, /// IDataWriter. Required writer object. function CreateWriter: IDataWriter; virtual; abstract; - /// Collection being saved. - property Collection: TVault read fCollection; + /// Vault being saved. + property Vault: TVault read fVault; public /// Creates object that can save the given vault. - constructor Create(const ACollection: TVault); + constructor Create(const AVault: TVault); /// Saves data to storage. /// TSnippetList [in] List of all snippets @@ -351,7 +352,7 @@ TFormatSaver = class abstract (TInterfacedObject, const Provider: IDBDataProvider); virtual; abstract; end; - /// Class used to write data from a collection to storage in the + /// Class used to write data from a vault to storage in the /// DelphiDabbler Code Snippets v2 data format. TDCSCV2FormatSaver = class(TFormatSaver, IDataFormatSaver @@ -375,8 +376,8 @@ TDCSCV2FormatSaver = class(TFormatSaver, public - /// Creates object that can save the given collection. - constructor Create(const ACollection: TVault); + /// Creates object that can save the given vault. + constructor Create(const AVault: TVault); /// Saves data to storage. /// TSnippetList [in] List of all snippets @@ -391,8 +392,8 @@ TDCSCV2FormatSaver = class(TFormatSaver, const Provider: IDBDataProvider); override; end; - /// Class used to write data from a collection to storage in - /// CodeSnip's native v4 data format. + /// Class used to write data from a vault to storage in CodeSnip's + /// native v4 data format. TNativeV4FormatSaver = class(TFormatSaver, IDataFormatSaver ) @@ -444,7 +445,7 @@ TNativeVaultFormatSaver = class(TFormatSaver, end; /// Class used to save global category information, regardless of - /// any categories saved with collections. + /// any categories saved with vaults. TGlobalCategoryLoader = class(TInterfacedObject, IGlobalCategoryLoader) public /// Loads categories data from global storage. @@ -458,7 +459,7 @@ TGlobalCategoryLoader = class(TInterfacedObject, IGlobalCategoryLoader) end; /// Class used to save global category information, regardless of - /// any categories saved with collections. + /// any categories saved with vaults. TGlobalCategorySaver = class(TInterfacedObject, IGlobalCategorySaver) public /// Saves category data to global storage. @@ -470,33 +471,33 @@ TGlobalCategorySaver = class(TInterfacedObject, IGlobalCategorySaver) { TDatabaseIOFactory } -class function TDatabaseIOFactory.CreateDBLoader(const Collection: TVault): +class function TDatabaseIOFactory.CreateDBLoader(const AVault: TVault): IDataFormatLoader; begin {TODO -cUDatabaseIO: Revise database loaders to get file path and other - info from collection instead of hard wiring it.} - case Collection.Storage.Format of + info from vault instead of hard wiring it.} + case AVault.Storage.Format of TDataFormatKind.DCSC_v2: - Result := TDCSCV2FormatLoader.Create(Collection); + Result := TDCSCV2FormatLoader.Create(AVault); TDataFormatKind.Native_v4: - Result := TNativeV4FormatLoader.Create(Collection); + Result := TNativeV4FormatLoader.Create(AVault); TDataFormatKind.Native_Vault: - Result := TNativeVaultFormatLoader.Create(Collection); + Result := TNativeVaultFormatLoader.Create(AVault); else Result := nil; end; end; -class function TDatabaseIOFactory.CreateDBSaver(const Collection: TVault): +class function TDatabaseIOFactory.CreateDBSaver(const AVault: TVault): IDataFormatSaver; begin - case Collection.Storage.Format of + case AVault.Storage.Format of TDataFormatKind.DCSC_v2: - Result := TDCSCV2FormatSaver.Create(Collection); + Result := TDCSCV2FormatSaver.Create(AVault); TDataFormatKind.Native_v4: - Result := TNativeV4FormatSaver.Create(Collection); + Result := TNativeV4FormatSaver.Create(AVault); TDataFormatKind.Native_Vault: - Result := TNativeVaultFormatSaver.Create(Collection); + Result := TNativeVaultFormatSaver.Create(AVault); else Result := nil; end; @@ -516,10 +517,10 @@ class function TDatabaseIOFactory.CreateGlobalCategorySaver: { TDatabaseLoader } -constructor TDatabaseLoader.Create(const ACollection: TVault); +constructor TDatabaseLoader.Create(const AVault: TVault); begin inherited Create; - fCollection := ACollection; + fVault := AVault; end; procedure TDatabaseLoader.CreateCategory(const CatID: string; @@ -535,7 +536,7 @@ procedure TDatabaseLoader.CreateCategory(const CatID: string; function TDatabaseLoader.FindSnippet(const SnippetKey: string; const SnipList: TSnippetList): TSnippet; begin - Result := SnipList.Find(SnippetKey, Collection.UID); + Result := SnipList.Find(SnippetKey, Vault.UID); end; procedure TDatabaseLoader.HandleException(const E: Exception); @@ -554,7 +555,7 @@ procedure TDatabaseLoader.HandleException(const E: Exception); function TDatabaseLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; begin - Result := Snippet.VaultID = Collection.UID; + Result := Snippet.VaultID = Vault.UID; end; procedure TDatabaseLoader.Load(const SnipList: TSnippetList; @@ -591,8 +592,8 @@ procedure TDatabaseLoader.Load(const SnipList: TSnippetList; if IsNativeSnippet(Snippet) then LoadReferences(Snippet); end; - // Get collection's meta data - fCollection.MetaData := fReader.GetMetaData; + // Get vault's meta data + Vault.MetaData := fReader.GetMetaData; except on E: Exception do HandleException(E); @@ -677,12 +678,12 @@ procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); for SnippetKey in SnippetKeys do begin // Check if snippet exists in current database and add it to list if not - Snippet := fSnipList.Find(SnippetKey, Collection.UID); + Snippet := fSnipList.Find(SnippetKey, Vault.UID); if not Assigned(Snippet) then begin fReader.GetSnippetProps(SnippetKey, SnippetProps); Snippet := fFactory.CreateSnippet( - SnippetKey, Collection.UID, SnippetProps + SnippetKey, Vault.UID, SnippetProps ); fSnipList.Add(Snippet); end; @@ -700,7 +701,7 @@ function TDCSCV2FormatLoader.CreateReader: IDataReader; @return Reader object instance. } begin - Result := TIniDataReader.Create(Collection.Storage.Directory); + Result := TIniDataReader.Create(Vault.Storage.Directory); if not Result.DatabaseExists then Result := TNulDataReader.Create; end; @@ -723,7 +724,7 @@ function TNativeV4FormatLoader.CreateReader: IDataReader; @return Reader object instance. } begin - Result := TXMLDataReader.Create(Collection.Storage.Directory); + Result := TXMLDataReader.Create(Vault.Storage.Directory); if not Result.DatabaseExists then Result := TNulDataReader.Create; end; @@ -742,27 +743,27 @@ function TNativeV4FormatLoader.ErrorMessageHeading: string; function TNativeVaultFormatLoader.CreateReader: IDataReader; begin - Result := TNativeDataReader.Create(Collection.Storage.Directory); + Result := TNativeDataReader.Create(Vault.Storage.Directory); if not Result.DatabaseExists then Result := TNulDataReader.Create; end; function TNativeVaultFormatLoader.ErrorMessageHeading: string; resourcestring - sError = 'Error loading the collection %0:s using the %1:s data format:'; + sError = 'Error loading the vault %0:s using the %1:s data format:'; begin Result := Format( sError, - [Collection.Name, TDataFormatInfo.GetName(Collection.Storage.Format)] + [Vault.Name, TDataFormatInfo.GetName(Vault.Storage.Format)] ); end; { TFormatSaver } -constructor TFormatSaver.Create(const ACollection: TVault); +constructor TFormatSaver.Create(const AVault: TVault); begin inherited Create; - fCollection := ACollection; + fVault := AVault; end; procedure TFormatSaver.DoSave(const SnipList: TSnippetList; @@ -800,7 +801,7 @@ procedure TFormatSaver.WriteCategories; procedure TFormatSaver.WriteMetaData; begin - fWriter.WriteMetaData(fCollection.MetaData); + fWriter.WriteMetaData(Vault.MetaData); end; procedure TFormatSaver.WriteSnippets; @@ -822,7 +823,7 @@ procedure TFormatSaver.WriteSnippets; begin for Snippet in fSnipList do begin - if Snippet.VaultID = fCollection.UID then + if Snippet.VaultID = Vault.UID then begin // Get and write a snippet's properties Props := fProvider.GetSnippetProps(Snippet); @@ -842,7 +843,7 @@ procedure TDCSCV2FormatSaver.Backup; var FB: TUserDBBackup; // TODO -cRefactoring: this is correct class (will change) begin - FB := TUserDBBackup.Create(fBakFile, Collection); + FB := TUserDBBackup.Create(fBakFile, Vault); try FB.Backup; finally @@ -850,9 +851,9 @@ procedure TDCSCV2FormatSaver.Backup; end; end; -constructor TDCSCV2FormatSaver.Create(const ACollection: TVault); +constructor TDCSCV2FormatSaver.Create(const AVault: TVault); begin - inherited Create(ACollection); + inherited Create(AVault); // Find a temp file name in system temp directory that doesn't yet exist repeat fBakFile := TPath.Combine( @@ -863,14 +864,14 @@ constructor TDCSCV2FormatSaver.Create(const ACollection: TVault); function TDCSCV2FormatSaver.CreateWriter: IDataWriter; begin - Result := TIniDataWriter.Create(Collection.Storage.Directory); + Result := TIniDataWriter.Create(Vault.Storage.Directory); end; procedure TDCSCV2FormatSaver.Restore; var FB: TUserDBBackup; begin - FB := TUserDBBackup.Create(fBakFile, Collection); + FB := TUserDBBackup.Create(fBakFile, Vault); try FB.Restore; finally @@ -898,13 +899,13 @@ procedure TDCSCV2FormatSaver.Save(const SnipList: TSnippetList; function TNativeV4FormatSaver.CreateWriter: IDataWriter; begin - Result := TXMLDataWriter.Create(Collection.Storage.Directory); + Result := TXMLDataWriter.Create(Vault.Storage.Directory); end; procedure TNativeV4FormatSaver.Save(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); begin - {TODO -cVault: Backup and restore this collection per the DCSC v2 loader} + {TODO -cVault: Backup and restore this vault per the DCSC v2 loader} DoSave(SnipList, Categories, Provider); end; @@ -912,7 +913,7 @@ procedure TNativeV4FormatSaver.Save(const SnipList: TSnippetList; function TNativeVaultFormatSaver.CreateWriter: IDataWriter; begin - Result := TNativeDataWriter.Create(Collection.Storage.Directory); + Result := TNativeDataWriter.Create(Vault.Storage.Directory); end; procedure TNativeVaultFormatSaver.Save(const SnipList: TSnippetList; From 0d3df72d2b2a1d98214fc1e077347d6ecd066d8a Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 17:06:43 +0000 Subject: [PATCH 159/222] Renaming in DB.UMain unit Updated various identifiers and comments that referred to collections to reference vaults. None of these changes affected the interface with other units. Revised comments that refer to the user and main databases to simply refer to the database in general. --- Src/DB.UMain.pas | 287 +++++++++++++++++++++++------------------------ 1 file changed, 140 insertions(+), 147 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 1f89a9d52..90ab6b19c 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -6,7 +6,7 @@ * Copyright (C) 2005-2024, Peter Johnson (gravatar.com/delphidabbler). * * Defines a singleton object and subsidiary classes that encapsulate the - * snippets and categories in the CodeSnip database and user defined databases. + * snippets and categories in the snippets database. } @@ -37,7 +37,7 @@ interface { TDatabaseChangeEventKind: Enumeration that specifies the different kind of change events triggered by - the user database. + the database. } TDatabaseChangeEventKind = ( evChangeBegin, // a change to the database is about to take place @@ -113,7 +113,7 @@ interface end; /// Interface to factory object that creates snippet and category - /// objects use by collection loader objects. + /// objects used by vault loader objects. IDBDataItemFactory = interface(IInterface) ['{C6DD85BD-E649-4A90-961C-4011D2714B3E}'] @@ -127,27 +127,27 @@ interface TCategory; /// Creates a new snippet object. - /// string [in] New snippet's key. Must not - /// exist in database - /// TVaultID [in] Vault containing the + /// string [in] New snippet's key. Must not exist + /// in the database + /// TVaultID [in] Vault containing the /// snippet. /// TSnippetData [in] Record describing /// snippet's properties. /// Instance of new snippet with no references. - function CreateSnippet(const Key: string; const ACollectionID: TVaultID; + function CreateSnippet(const Key: string; const AVaultID: TVaultID; const Props: TSnippetData): TSnippet; end; { IDatabase: - Interface to object that encapsulates the whole (main and user) databases - and provides access to all snippets and all categories. + Interface to object that encapsulates the whole database and provides access + to all snippets and all categories. } IDatabase = interface(IInterface) ['{A280DEEF-0336-4264-8BD0-7CDFBB207D2E}'] procedure Load; - {Loads data from main and user databases. + {Loads data into the database from all vaults. } procedure Clear; {Clears all data. @@ -161,32 +161,32 @@ interface @param Handler [in] Handler to remove from list. } function GetSnippets: TSnippetList; - {Gets list of snippets in main and user databases. + {Gets list of all snippets in the database. @return Required list. } function GetCategories: TCategoryList; - {Gets list of categories in main and user databases. + {Gets list of categories in the database. @return Required list. } property Categories: TCategoryList read GetCategories; - {List of categories in main and user databases} + {List of categories in the database} property Snippets: TSnippetList read GetSnippets; - {List of snippets in main and user databases} + {List of snippets in the database} end; { IDatabaseEdit: - Interface to object that can be used to edit the user database. + Interface to object that can be used to edit the database. } IDatabaseEdit = interface(IInterface) ['{CBF6FBB0-4C18-481F-A378-84BB09E5ECF4}'] /// Creates a new snippet key that is unique within the given - /// collection. - /// TVaultID ID of vault that the new - /// key must be unique within. + /// vault. + /// TVaultID ID of vault that the new key + /// must be unique within. /// string containing the key. - function GetUniqueSnippetKey(const ACollectionID: TVaultID): string; + function GetUniqueSnippetKey(const AVaultID: TVaultID): string; function GetEditableSnippetInfo(const Snippet: TSnippet = nil): TSnippetEditData; @@ -222,12 +222,12 @@ interface /// Adds a new snippet to the database. /// string [in] New snippet's key. - /// TVaultID [in] ID of vault that the - /// new snippet will belong to. + /// TVaultID [in] ID of vault that the new + /// snippet will belong to. /// TSnippetEditData [in] Record storing the new /// snippet's properties and references. /// TSnippet. Reference to the new snippet. - function AddSnippet(const AKey: string; const ACollectionID: TVaultID; + function AddSnippet(const AKey: string; const AVaultID: TVaultID; const AData: TSnippetEditData): TSnippet; /// Duplicates a snippet in the database. @@ -235,7 +235,7 @@ interface /// /// string [in] Key to be used for duplicated /// snippet. - /// TVaultID [in] ID of vault the + /// TVaultID [in] ID of vault the /// duplicated snippet belongs to. /// string [in] Display name of the /// duplicated snippet. @@ -244,22 +244,21 @@ interface /// TSnippet. Reference to the duplicated snippet. /// function DuplicateSnippet(const ASnippet: TSnippet; const ANewKey: string; - const ANewCollectionID: TVaultID; const ANewDisplayName: string; + const ANewVaultID: TVaultID; const ANewDisplayName: string; const ACatID: string): TSnippet; /// Creates a new temporary snippet without adding it to the /// database. /// string [in] The new nippet's key. - /// TVaultID [in] ID of the vault to - /// which the new snippet belongs. + /// TVaultID [in] ID of the vault to which + /// the new snippet belongs. /// TSnippetEditData [in] Record storing the new /// snippet's properties and references. /// TSnippet Reference to new snippet. /// The returned snippet must not be added to the database. /// - function CreateTempSnippet(const AKey: string; - const ACollectionID: TVaultID; const AData: TSnippetEditData): - TSnippet; overload; + function CreateTempSnippet(const AKey: string; const AVaultID: TVaultID; + const AData: TSnippetEditData): TSnippet; overload; function CreateTempSnippet(const Snippet: TSnippet): TSnippet; overload; {Creates a new temporary copy of a snippet without adding it to the @@ -269,7 +268,7 @@ interface @return Reference to new copied snippet. } procedure DeleteSnippet(const Snippet: TSnippet); - {Deletes a snippet from the user database. + {Deletes a snippet from the database. @param Snippet [in] Snippet to be deleted. } function GetEditableCategoryInfo( @@ -281,35 +280,34 @@ interface } function AddCategory(const CatID: string; const Data: TCategoryData): TCategory; - {Adds a new category to the user database. + {Adds a new category to the database. @param CatID [in] ID of new category. @param Data [in] Record storing new category's properties. @return Reference to new category. } function UpdateCategory(const Category: TCategory; const Data: TCategoryData): TCategory; - {Updates a user defined category's properties. - @param Category [in] Category to be updated. Must be user-defined. + {Updates a category's properties. + @param Category [in] Category to be updated. @param Data [in] Record containing revised data. @return Reference to updated category. Will have changed. } procedure DeleteCategory(const Category: TCategory); - {Deletes a category and all its snippets from the user database. + {Deletes a category and all its snippets from the database. @param Category [in] Category to be deleted. } function Updated: Boolean; - {Checks if user database has been updated since last save. + {Checks if the database has been updated since the last save. @return True if database has been updated, False otherwise. } procedure Save; - {Saves user database. + {Saves the database. } end; function Database: IDatabase; - {Returns singleton instance of object that encapsulates main and user - databases. + {Returns singleton instance of object that encapsulates the database. @return Singleton object. } @@ -354,28 +352,28 @@ TDBDataItemFactory = class(TInterfacedObject, IDBDataItemFactory) /// Creates a new snippet object. /// string [in] New snippet's key. Must not /// exist in database - /// TVaultID [in] Vault containing the + /// TVaultID [in] Vault containing the /// snippet. /// TSnippetData [in] Record describing /// snippet's properties. /// Instance of new snippet with no references. - function CreateSnippet(const Key: string; - const ACollectionID: TVaultID; const Props: TSnippetData): TSnippet; + function CreateSnippet(const Key: string; const AVaultID: TVaultID; + const Props: TSnippetData): TSnippet; end; { TDatabase: - Class that encapsulates the main and user databases. Provides access to all - snippets and all categories via the IDatabase interface. Also enables user - defined database to be modified via IDatabaseEdit interface. + Class that encapsulates the database. Provides access to all snippets and + all categories via the IDatabase interface. Also enables the database to be + modified via the IDatabaseEdit interface. } TDatabase = class(TInterfacedObject, IDatabase, IDatabaseEdit ) strict private - fUpdated: Boolean; // Flags if user database has been updated + fUpdated: Boolean; // Flags if database has been updated fCategories: TCategoryList; // List of categories fSnippets: TSnippetList; // List of snippets fChangeEvents: TMulticastEvents; // List of change event handlers @@ -417,31 +415,30 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// Adds a new snippet to the database. Assumes the snippet is /// not already in the database. /// string [in] New snippet's key. - /// TVaultID [in] ID of vault that the - /// new snippet will belong to. + /// TVaultID [in] ID of vault that the new + /// snippet will belong to. /// TSnippetEditData [in] Record storing the new /// snippet's properties and references. /// TSnippet. Reference to the new snippet. /// ECodeSnip raised if the snippet's category does not /// exist. - function InternalAddSnippet(const AKey: string; - const ACollectionID: TVaultID; const AData: TSnippetEditData): - TSnippet; + function InternalAddSnippet(const AKey: string; const AVaultID: TVaultID; + const AData: TSnippetEditData): TSnippet; procedure InternalDeleteSnippet(const Snippet: TSnippet); - {Deletes a snippet from the user database. + {Deletes a snippet from the database. @param Snippet [in] Snippet to delete from database. } function InternalAddCategory(const CatID: string; const Data: TCategoryData): TCategory; - {Adds a new category to the user database. Assumes category not already in - user database. + {Adds a new category to the database. Assumes the category is not already + in the database. @param CatID [in] ID of new category. @param Data [in] Properties of new category. @return Reference to new category object. } procedure InternalDeleteCategory(const Cat: TCategory); - {Deletes a category from the user database. + {Deletes a category from the database. @param Cat [in] Category to delete from database. } procedure GetDependentList(const ASnippet: TSnippet; @@ -473,7 +470,7 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) @return Required list. } - /// Load database from all available collections. + /// Load the database from all available vaults. procedure Load; procedure Clear; @@ -491,12 +488,12 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) { IDatabaseEdit methods } /// Creates a new snippet key that is unique within the given - /// collection. - /// TVaultID ID of vault that the new - /// key must be unique within. + /// vault. + /// TVaultID ID of vault that the new key + /// must be unique within. /// string containing the key. /// Method of IDatabaseEdit. - function GetUniqueSnippetKey(const ACollectionID: TVaultID): string; + function GetUniqueSnippetKey(const AVaultID: TVaultID): string; function GetEditableSnippetInfo(const Snippet: TSnippet = nil): TSnippetEditData; @@ -535,13 +532,13 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// Adds a new snippet to the database. /// string [in] New snippet's key. - /// TVaultID [in] ID of vault that the - /// new snippet will belong to. + /// TVaultID [in] ID of vault that the new + /// snippet will belong to. /// TSnippetEditData [in] Record storing the new /// snippet's properties and references. /// TSnippet. Reference to the new snippet. /// Method of IDatabaseEdit. - function AddSnippet(const AKey: string; const ACollectionID: TVaultID; + function AddSnippet(const AKey: string; const AVaultID: TVaultID; const AData: TSnippetEditData): TSnippet; /// Duplicates a snippet in the database. @@ -549,7 +546,7 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// /// string [in] Key to be used for duplicated /// snippet. - /// TVaultID [in] ID of the vault the + /// TVaultID [in] ID of the vault the /// duplicated snippet belongs to. /// string [in] Display name of the /// duplicated snippet. @@ -559,14 +556,14 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// /// Method of IDatabaseEdit. function DuplicateSnippet(const ASnippet: TSnippet; const ANewKey: string; - const ANewCollectionID: TVaultID; const ANewDisplayName: string; + const ANewVaultID: TVaultID; const ANewDisplayName: string; const ACatID: string): TSnippet; /// Creates a new temporary snippet without adding it to the /// database. /// string [in] The new nippet's key. - /// TVaultID [in] ID of the vault to - /// which the new snippet belongs. + /// TVaultID [in] ID of the vault to which + /// the new snippet belongs. /// TSnippetEditData [in] Record storing the new /// snippet's properties and references. /// TSnippet Reference to new snippet. @@ -574,9 +571,8 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// The returned snippet must not be added to the database. /// Method of IDatabaseEdit. /// - function CreateTempSnippet(const AKey: string; - const ACollectionID: TVaultID; const AData: TSnippetEditData): - TSnippet; overload; + function CreateTempSnippet(const AKey: string; const AVaultID: TVaultID; + const AData: TSnippetEditData): TSnippet; overload; function CreateTempSnippet(const Snippet: TSnippet): TSnippet; overload; {Creates a new temporary copy of a snippet without adding it to the @@ -586,7 +582,7 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) @return Reference to new snippet. } procedure DeleteSnippet(const Snippet: TSnippet); - {Deletes a snippet from the user database. + {Deletes a snippet from the database. @param Snippet [in] Snippet to be deleted. } function GetEditableCategoryInfo( @@ -598,51 +594,50 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) } function AddCategory(const CatID: string; const Data: TCategoryData): TCategory; - {Adds a new category to the user database. + {Adds a new category to the database. @param CatID [in] ID of new category. @param Data [in] Record storing new category's properties. @return Reference to new category. } function UpdateCategory(const Category: TCategory; const Data: TCategoryData): TCategory; - {Updates a user defined category's properties. - @param Category [in] Category to be updated. Must be user-defined. + {Updates a defined category's properties. + @param Category [in] Category to be updated. @param Data [in] Record containing revised data. @return Reference to updated category. Will have changed. } procedure DeleteCategory(const Category: TCategory); - {Deletes a category and all its snippets from the user database. + {Deletes a category and all its snippets from the database. @param Category [in] Category to be deleted. } function Updated: Boolean; - {Checks if user database has been updated since last save. + {Checks if the database has been updated since the last save. @return True if database has been updated, False otherwise. } - /// Saves snippets from database to their respective collections. + /// Saves snippets from database to their respective vaults. /// procedure Save; end; /// Class that provides data about the categories and snippets in - /// a given collection. - TCollectionDataProvider = class(TInterfacedObject, IDBDataProvider) + /// a given vault. + TVaultDataProvider = class(TInterfacedObject, IDBDataProvider) strict private var - fCollectionID: TVaultID; // Vault on which to operate + fVaultID: TVaultID; // Vault on which to operate fSnippets: TSnippetList; // All snippets in the whole database fCategories: TCategoryList; // All categories in the whole database public /// Object constructor. Sets up data provider. - /// TVaultID [in] Vault for which to - /// provide data. + /// TVaultID [in] Vault for which to provide + /// data. /// TSnippetList [in] List of all snippets /// in the database. /// TCategoryList [in] List of all /// categories in the database. - constructor Create(const ACollectionID: TVaultID; - const SnipList: TSnippetList; + constructor Create(const AVaultID: TVaultID; const SnipList: TSnippetList; const Categories: TCategoryList); /// Retrieves all the properties of a category. @@ -653,7 +648,7 @@ TCollectionDataProvider = class(TInterfacedObject, IDBDataProvider) /// Method of IDBDataProvider function GetCategoryProps(const Cat: TCategory): TCategoryData; - /// Retrieves keys of all snippets from the collection that belong + /// Retrieves keys of all snippets from the vault that belong /// to a category. /// Category [in] Category for which snippet keys /// are requested. @@ -681,8 +676,7 @@ TCollectionDataProvider = class(TInterfacedObject, IDBDataProvider) end; function Database: IDatabase; - {Returns singleton instance of object that encapsulates main and user - databases. + {Returns a singleton instance of the object that encapsulates the database. @return Singleton object. } begin @@ -695,19 +689,19 @@ function Database: IDatabase; function TDatabase.AddCategory(const CatID: string; const Data: TCategoryData): TCategory; - {Adds a new category to the user database. + {Adds a new category to the database. @param CatID [in] ID of new category. @param Data [in] Record storing new category's properties. @return Reference to new category. } resourcestring // Error message - sNameExists = 'Category %s already exists in user database'; + sNameExists = 'Category %s already exists in the database'; begin Result := nil; TriggerEvent(evChangeBegin); try - // Check if category with same id exists in user database: error if so + // Check if category with same id exists in the database: error if so if fCategories.Find(CatID) <> nil then raise ECodeSnip.CreateFmt(sNameExists, [CatID]); Result := InternalAddCategory(CatID, Data); @@ -727,19 +721,19 @@ procedure TDatabase.AddChangeEventHandler(const Handler: TNotifyEventInfo); fChangeEvents.AddHandler(Handler); end; -function TDatabase.AddSnippet(const AKey: string; const ACollectionID: TVaultID; +function TDatabase.AddSnippet(const AKey: string; const AVaultID: TVaultID; const AData: TSnippetEditData): TSnippet; resourcestring // Error message - sKeyExists = 'Snippet with key "%s" already exists in collection'; + sKeyExists = 'Snippet with key "%s" already exists in the vault'; begin Result := nil; // keeps compiler happy TriggerEvent(evChangeBegin); try - // Check if snippet with same key exists in user database: error if so - if fSnippets.Find(AKey, ACollectionID) <> nil then + // Check if snippet with same key exists in the database: error if so + if fSnippets.Find(AKey, AVaultID) <> nil then raise ECodeSnip.CreateFmt(sKeyExists, [AKey]); - Result := InternalAddSnippet(AKey, ACollectionID, AData); + Result := InternalAddSnippet(AKey, AVaultID, AData); Query.Update; TriggerEvent(evSnippetAdded, Result); finally @@ -788,14 +782,14 @@ function TDatabase.CreateTempSnippet(const Snippet: TSnippet): TSnippet; end; function TDatabase.CreateTempSnippet(const AKey: string; - const ACollectionID: TVaultID; const AData: TSnippetEditData): TSnippet; + const AVaultID: TVaultID; const AData: TSnippetEditData): TSnippet; begin - Result := TTempSnippet.Create(AKey, ACollectionID, AData.Props); + Result := TTempSnippet.Create(AKey, AVaultID, AData.Props); (Result as TTempSnippet).UpdateRefs(AData.Refs, fSnippets); end; procedure TDatabase.DeleteCategory(const Category: TCategory); - {Deletes a category and all its snippets from the user database. + {Deletes a category and all its snippets from the database. @param Category [in] Category to be deleted. } begin @@ -816,7 +810,7 @@ procedure TDatabase.DeleteCategory(const Category: TCategory); end; procedure TDatabase.DeleteSnippet(const Snippet: TSnippet); - {Deletes a snippet from the user database. + {Deletes a snippet from the database. @param Snippet [in] Snippet to be deleted. } var @@ -865,7 +859,7 @@ destructor TDatabase.Destroy; end; function TDatabase.DuplicateSnippet(const ASnippet: TSnippet; - const ANewKey: string; const ANewCollectionID: TVaultID; + const ANewKey: string; const ANewVaultID: TVaultID; const ANewDisplayName: string; const ACatID: string): TSnippet; var Data: TSnippetEditData; @@ -875,7 +869,7 @@ function TDatabase.DuplicateSnippet(const ASnippet: TSnippet; Data := (ASnippet as TSnippetEx).GetEditData; Data.Props.Cat := ACatID; Data.Props.DisplayName := ANewDisplayName; - Result := AddSnippet(ANewKey, ANewCollectionID, Data); + Result := AddSnippet(ANewKey, ANewVaultID, Data); end; function TDatabase.GetCategories: TCategoryList; @@ -988,32 +982,32 @@ function TDatabase.GetSnippets: TSnippetList; Result := fSnippets; end; -function TDatabase.GetUniqueSnippetKey(const ACollectionID: TVaultID): string; +function TDatabase.GetUniqueSnippetKey(const AVaultID: TVaultID): string; var - SnippetsInCollection: TSnippetList; + SnippetsInVault: TSnippetList; Snippet: TSnippet; begin // NOTE: It is probable that TUniqueID will always generate a key that is - // unique across the whole database, let alone within the collection. But it's + // unique across the whole database, let alone within the vault. But it's // safer to check and regenerate if necessary. - SnippetsInCollection := TSnippetList.Create; + SnippetsInVault := TSnippetList.Create; try - // Build list of all snippets in collection + // Build list of all snippets in vault for Snippet in fSnippets do - if Snippet.VaultID = ACollectionID then - SnippetsInCollection.Add(Snippet); + if Snippet.VaultID = AVaultID then + SnippetsInVault.Add(Snippet); repeat Result := TUniqueID.GenerateAlpha; - until SnippetsInCollection.Find(Result, ACollectionID) = nil; + until SnippetsInVault.Find(Result, AVaultID) = nil; finally - SnippetsInCollection.Free; + SnippetsInVault.Free; end; end; function TDatabase.InternalAddCategory(const CatID: string; const Data: TCategoryData): TCategory; - {Adds a new category to the user database. Assumes category not already in - user database. + {Adds a new category to the database. Assumes the category is not already in + the database. @param CatID [in] ID of new category. @param Data [in] Properties of new category. @return Reference to new category object. @@ -1024,7 +1018,7 @@ function TDatabase.InternalAddCategory(const CatID: string; end; function TDatabase.InternalAddSnippet(const AKey: string; - const ACollectionID: TVaultID; const AData: TSnippetEditData): TSnippet; + const AVaultID: TVaultID; const AData: TSnippetEditData): TSnippet; var Cat: TCategory; // category object containing new snippet resourcestring @@ -1032,7 +1026,7 @@ function TDatabase.InternalAddSnippet(const AKey: string; sCatNotFound = 'Category "%0:s" referenced by new snippet with key "%1:s" ' + 'does not exist'; begin - Result := TSnippetEx.Create(AKey, ACollectionID, AData.Props); + Result := TSnippetEx.Create(AKey, AVaultID, AData.Props); (Result as TSnippetEx).UpdateRefs(AData.Refs, fSnippets); Cat := fCategories.Find(Result.Category); if not Assigned(Cat) then @@ -1042,7 +1036,7 @@ function TDatabase.InternalAddSnippet(const AKey: string; end; procedure TDatabase.InternalDeleteCategory(const Cat: TCategory); - {Deletes a category from the user database. + {Deletes a category from the database. @param Cat [in] Category to delete from database. } begin @@ -1050,7 +1044,7 @@ procedure TDatabase.InternalDeleteCategory(const Cat: TCategory); end; procedure TDatabase.InternalDeleteSnippet(const Snippet: TSnippet); - {Deletes a snippet from the user database. + {Deletes a snippet from the database. @param Snippet [in] Snippet to delete from database. } var @@ -1065,12 +1059,12 @@ procedure TDatabase.InternalDeleteSnippet(const Snippet: TSnippet); end; procedure TDatabase.Load; - {Loads object's data from main and user defined databases. + {Loads data from the database. } var DataItemFactory: IDBDataItemFactory; - CollectionLoader: IDataFormatLoader; - Collection: TVault; + VaultLoader: IDataFormatLoader; + Vault: TVault; CatLoader: IGlobalCategoryLoader; begin // Clear the database @@ -1081,11 +1075,11 @@ procedure TDatabase.Load; DataItemFactory := TDBDataItemFactory.Create; try // Load all vaults - for Collection in TVaults.Instance do + for Vault in TVaults.Instance do begin - CollectionLoader := TDatabaseIOFactory.CreateDBLoader(Collection); - if Assigned(CollectionLoader) then - CollectionLoader.Load(fSnippets, fCategories, DataItemFactory); + VaultLoader := TDatabaseIOFactory.CreateDBLoader(Vault); + if Assigned(VaultLoader) then + VaultLoader.Load(fSnippets, fCategories, DataItemFactory); end; // Read categories from categories file to get any empty categories not // created by format loaders @@ -1111,26 +1105,26 @@ procedure TDatabase.RemoveChangeEventHandler(const Handler: TNotifyEventInfo); end; procedure TDatabase.Save; - {Saves user defined snippets and all categories to user database. + {Saves all snippets and categories to the database. } var Provider: IDBDataProvider; - CollectionSaver: IDataFormatSaver; - Collection: TVault; + VaultSaver: IDataFormatSaver; + Vault: TVault; CatSaver: IGlobalCategorySaver; begin // Save categories CatSaver := TDatabaseIOFactory.CreateGlobalCategorySaver; CatSaver.Save(fCategories); // Save all vaults - for Collection in TVaults.Instance do + for Vault in TVaults.Instance do begin - Provider := TCollectionDataProvider.Create( - Collection.UID, fSnippets, fCategories + Provider := TVaultDataProvider.Create( + Vault.UID, fSnippets, fCategories ); - CollectionSaver := TDatabaseIOFactory.CreateDBSaver(Collection); - if Assigned(CollectionSaver) then - CollectionSaver.Save(fSnippets, fCategories, Provider); + VaultSaver := TDatabaseIOFactory.CreateDBSaver(Vault); + if Assigned(VaultSaver) then + VaultSaver.Save(fSnippets, fCategories, Provider); end; fUpdated := False; end; @@ -1150,8 +1144,8 @@ procedure TDatabase.TriggerEvent(const Kind: TDatabaseChangeEventKind; function TDatabase.UpdateCategory(const Category: TCategory; const Data: TCategoryData): TCategory; - {Updates a user defined category's properties. - @param Category [in] Category to be updated. Must be user-defined. + {Updates a category's properties. + @param Category [in] Category to be updated. @param Data [in] Record containing revised data. @return Reference to updated category. Will have changed. } @@ -1184,7 +1178,7 @@ function TDatabase.UpdateCategory(const Category: TCategory; end; function TDatabase.Updated: Boolean; - {Checks if user database has been updated since last save. + {Checks if the database has been updated since the last save. @return True if database has been updated, False otherwise. } begin @@ -1221,13 +1215,12 @@ function TDatabase.UpdateSnippet(const ASnippet: TSnippet; for Dependent in Dependents do (Dependent.Depends as TSnippetListEx).Delete(ASnippet); - // record snippet's key and collection ID for use in re-created updated - // snippet + // record snippet's key and vault ID for use in re-created updated snippet PreservedSnippetID := ASnippet.ID; // delete the old, pre-update snippet InternalDeleteSnippet(ASnippet); - // add new, post-update snippet with same key & collection ID as old snippet + // add new, post-update snippet with same key & vault ID as old snippet Result := InternalAddSnippet( PreservedSnippetID.Key, PreservedSnippetID.VaultID, AData ); @@ -1290,46 +1283,46 @@ function TDBDataItemFactory.CreateCategory(const CatID: string; end; function TDBDataItemFactory.CreateSnippet(const Key: string; - const ACollectionID: TVaultID; const Props: TSnippetData): TSnippet; + const AVaultID: TVaultID; const Props: TSnippetData): TSnippet; begin - Result := TSnippetEx.Create(Key, ACollectionID, Props); + Result := TSnippetEx.Create(Key, AVaultID, Props); end; -{ TCollectionDataProvider } +{ TVaultDataProvider } -constructor TCollectionDataProvider.Create(const ACollectionID: TVaultID; +constructor TVaultDataProvider.Create(const AVaultID: TVaultID; const SnipList: TSnippetList; const Categories: TCategoryList); begin inherited Create; - fCollectionID := ACollectionID; + fVaultID := AVaultID; fSnippets := SnipList; fCategories := Categories; end; -function TCollectionDataProvider.GetCategoryProps( +function TVaultDataProvider.GetCategoryProps( const Cat: TCategory): TCategoryData; begin Result.Desc := Cat.Description; end; -function TCollectionDataProvider.GetCategorySnippets( +function TVaultDataProvider.GetCategorySnippets( const Cat: TCategory): IStringList; var Snippet: TSnippet; // references each snippet in category begin Result := TIStringList.Create; for Snippet in Cat.Snippets do - if Snippet.VaultID = fCollectionID then + if Snippet.VaultID = fVaultID then Result.Add(Snippet.Key); end; -function TCollectionDataProvider.GetSnippetProps( +function TVaultDataProvider.GetSnippetProps( const Snippet: TSnippet): TSnippetData; begin Result := (Snippet as TSnippetEx).GetProps; end; -function TCollectionDataProvider.GetSnippetRefs( +function TVaultDataProvider.GetSnippetRefs( const Snippet: TSnippet): TSnippetReferences; begin Result := (Snippet as TSnippetEx).GetReferences; From 6127337b22a8f5ee8c65a562baa2be38e62b67d8 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 17:19:38 +0000 Subject: [PATCH 160/222] Rename TCollectionListAdapter to TVaultListAdapter Also renamed public Collection method as Vault. Renamed other fields, variables and parameters to reference vaults rather than collections. Made minimal changes to calling code re the class and public method name changes. Updated comments accordingly. --- Src/FmAboutDlg.pas | 8 ++--- Src/FmCodeImportDlg.pas | 6 ++-- Src/FmCollectionBackup.pas | 6 ++-- Src/FmDeleteUserDBDlg.pas | 6 ++-- Src/FmDuplicateSnippetDlg.pas | 6 ++-- Src/FmSWAGImportDlg.pas | 6 ++-- Src/FmSnippetsEditorDlg.pas | 7 ++-- Src/FmUserDataPathDlg.pas | 8 ++--- Src/FrDisplayPrefs.pas | 6 ++-- Src/UCollectionListAdapter.pas | 62 +++++++++++++++++----------------- 10 files changed, 60 insertions(+), 61 deletions(-) diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index 1910624ea..1f90bf564 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -122,7 +122,7 @@ TAboutDlg = class(TGenericViewDlg) fPathInfoBoxes: TList; /// Provides a sorted list of collection names for display in /// the collections combo box. - fCollList: TCollectionListAdapter; + fCollList: TVaultListAdapter; /// Handles title frame's OnHTMLEvent event. Checks for mouse /// events relating to display of the easter egg and acts accordingly. /// @@ -277,7 +277,7 @@ procedure TAboutDlg.btnViewUserConfigClick(Sender: TObject); procedure TAboutDlg.cbCollectionChange(Sender: TObject); begin - DisplayCollectionInfo(fCollList.Collection(cbCollection.ItemIndex)); + DisplayCollectionInfo(fCollList.Vault(cbCollection.ItemIndex)); end; procedure TAboutDlg.ConfigForm; @@ -325,7 +325,7 @@ procedure TAboutDlg.ConfigForm; // Load collections into combo box & select default collection fCollList.ToStrings(cbCollection.Items); cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); - DisplayCollectionInfo(fCollList.Collection(cbCollection.ItemIndex)); + DisplayCollectionInfo(fCollList.Vault(cbCollection.ItemIndex)); // Set collections treeview and paths scrollbox background colours tvCollectionInfo.Color := ThemeServicesEx.GetTabBodyColour; sbPaths.Color := ThemeServicesEx.GetTabBodyColour; @@ -468,7 +468,7 @@ class procedure TAboutDlg.Execute(AOwner: TComponent); procedure TAboutDlg.FormCreate(Sender: TObject); begin inherited; - fCollList := TCollectionListAdapter.Create; + fCollList := TVaultListAdapter.Create; fPathInfoBoxes := TList.Create; frmTitle.OnBuildCSS := UpdateTitleCSS; frmProgram.OnBuildCSS := UpdateProgramTabCSS; diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index 7673dfc4f..ac77120a3 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -84,7 +84,7 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) /// Object that populates cbCollection with an /// alphabetical list of collection names and manages interaction with /// it. - fCollList: TCollectionListAdapter; + fCollList: TVaultListAdapter; /// Validates entries on wizard pages indetified by the page /// index. procedure ValidatePage(const PageIdx: Integer); @@ -291,7 +291,7 @@ class function TCodeImportDlg.Execute(AOwner: TComponent; procedure TCodeImportDlg.FormCreate(Sender: TObject); begin inherited; - fCollList := TCollectionListAdapter.Create; + fCollList := TVaultListAdapter.Create; end; procedure TCodeImportDlg.FormDestroy(Sender: TObject); @@ -309,7 +309,7 @@ function TCodeImportDlg.GetCollectionID: TVaultID; begin Assert(cbCollection.ItemIndex >= 0, ClassName + '.GetCollectionID: no collection selected'); - Result := fCollList.Collection(cbCollection.ItemIndex).UID; + Result := fCollList.Vault(cbCollection.ItemIndex).UID; end; function TCodeImportDlg.GetFileNameFromEditCtrl: string; diff --git a/Src/FmCollectionBackup.pas b/Src/FmCollectionBackup.pas index a762b28c0..955ae26c7 100644 --- a/Src/FmCollectionBackup.pas +++ b/Src/FmCollectionBackup.pas @@ -40,7 +40,7 @@ TCollectionBackupDlg = class(TGenericOKDlg) var fFileName: string; fCollection: TVault; - fCollList: TCollectionListAdapter; + fCollList: TVaultListAdapter; function GetFilePathFromEditCtrl: string; strict protected procedure ConfigForm; override; @@ -108,7 +108,7 @@ procedure TCollectionBackupDlg.btnBrowseClick(Sender: TObject); procedure TCollectionBackupDlg.btnOKClick(Sender: TObject); begin fFileName := GetFilePathFromEditCtrl; - fCollection := fCollList.Collection(cbCollection.ItemIndex); + fCollection := fCollList.Vault(cbCollection.ItemIndex); end; procedure TCollectionBackupDlg.ConfigForm; @@ -135,7 +135,7 @@ class function TCollectionBackupDlg.Execute(AOwner: TComponent; procedure TCollectionBackupDlg.FormCreate(Sender: TObject); begin inherited; - fCollList := TCollectionListAdapter.Create; + fCollList := TVaultListAdapter.Create; end; procedure TCollectionBackupDlg.FormDestroy(Sender: TObject); diff --git a/Src/FmDeleteUserDBDlg.pas b/Src/FmDeleteUserDBDlg.pas index 38ef21a36..b5ce15d46 100644 --- a/Src/FmDeleteUserDBDlg.pas +++ b/Src/FmDeleteUserDBDlg.pas @@ -46,7 +46,7 @@ TDeleteUserDBDlg = class(TGenericOKDlg, INoPublicConstruct) var fPermissionGranted: Boolean; fCollection: TVault; - fCollList: TCollectionListAdapter; + fCollList: TVaultListAdapter; function SelectedCollection: TVault; function IsValidPassword: Boolean; strict protected @@ -128,7 +128,7 @@ class function TDeleteUserDBDlg.Execute(AOwner: TComponent; procedure TDeleteUserDBDlg.FormCreate(Sender: TObject); begin inherited; - fCollList := TCollectionListAdapter.Create; + fCollList := TVaultListAdapter.Create; end; procedure TDeleteUserDBDlg.FormDestroy(Sender: TObject); @@ -151,7 +151,7 @@ function TDeleteUserDBDlg.IsValidPassword: Boolean; function TDeleteUserDBDlg.SelectedCollection: TVault; begin - Result := fCollList.Collection(cbCollection.ItemIndex); + Result := fCollList.Vault(cbCollection.ItemIndex); end; end. diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 9fa7265a4..fe8f5e284 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -60,7 +60,7 @@ TPersistentOptions = class(TObject) var fSnippet: TSnippet; fCatList: TCategoryListAdapter; - fCollList: TCollectionListAdapter; + fCollList: TVaultListAdapter; fOptions: TPersistentOptions; fSnippetKey: string; /// Returns the ID of the vault selected in the collections drop @@ -226,7 +226,7 @@ function TDuplicateSnippetDlg.SelectedCollectionID: TVaultID; begin Assert(cbCollection.ItemIndex >= 0, ClassName + '.SelectedCollectionID: no collection selected'); - Result := fCollList.Collection(cbCollection.ItemIndex).UID; + Result := fCollList.Vault(cbCollection.ItemIndex).UID; end; procedure TDuplicateSnippetDlg.UpdateDatabase; @@ -258,7 +258,7 @@ procedure TDuplicateSnippetDlg.FormCreate(Sender: TObject); begin inherited; fCatList := TCategoryListAdapter.Create(Database.Categories); - fCollList := TCollectionListAdapter.Create; + fCollList := TVaultListAdapter.Create; fOptions := TPersistentOptions.Create; end; diff --git a/Src/FmSWAGImportDlg.pas b/Src/FmSWAGImportDlg.pas index 977509f07..4a760c8d1 100644 --- a/Src/FmSWAGImportDlg.pas +++ b/Src/FmSWAGImportDlg.pas @@ -151,7 +151,7 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) /// Object that populates cbCollection with an /// alphabetical list of collection names and manages interaction with /// it. - fCollList: TCollectionListAdapter; + fCollList: TVaultListAdapter; /// Retrieves import directory name from edit control where it is /// entered. function GetDirNameFromEditCtrl: string; @@ -619,7 +619,7 @@ class function TSWAGImportDlg.Execute(const AOwner: TComponent): Boolean; procedure TSWAGImportDlg.FormCreate(Sender: TObject); begin inherited; - fCollList := TCollectionListAdapter.Create; + fCollList := TVaultListAdapter.Create; end; procedure TSWAGImportDlg.FormDestroy(Sender: TObject); @@ -875,7 +875,7 @@ function TSWAGImportDlg.SelectedCollectionID: TVaultID; begin Assert(cbCollection.ItemIndex >= 0, ClassName + '.SelectedCollectionID: no collection selected'); - Result := fCollList.Collection(cbCollection.ItemIndex).UID; + Result := fCollList.Vault(cbCollection.ItemIndex).UID; end; procedure TSWAGImportDlg.UpdateButtons(const PageIdx: Integer); diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index fcbe5ba39..669cd1727 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -185,8 +185,7 @@ TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) strict private fSnippet: TSnippet; // Snippet being edited: nil for new snippet fCatList: TCategoryListAdapter; // Accesses sorted list of categories - fCollList: - TCollectionListAdapter; // Accesses sorted list of collections + fCollList: TVaultListAdapter; // Accesses sorted list of collections fSnipKindList: TSnipKindListAdapter; // Accesses sorted list of snippet kinds fEditData: TSnippetEditData; // Record storing a snippet's editable data @@ -822,7 +821,7 @@ procedure TSnippetsEditorDlg.FormCreate(Sender: TObject); begin inherited; fCatList := TCategoryListAdapter.Create(Database.Categories); - fCollList := TCollectionListAdapter.Create; + fCollList := TVaultListAdapter.Create; fSnipKindList := TSnipKindListAdapter.Create; fCompileMgr := TCompileMgr.Create(Self); // auto-freed fMemoCaretPosDisplayMgr := TMemoCaretPosDisplayMgr.Create; @@ -1010,7 +1009,7 @@ function TSnippetsEditorDlg.SelectedCollectionID: TVaultID; Result := fSnippet.VaultID else // Editing new snippet: chosing collection is permitted - Result := fCollList.Collection(cbCollection.ItemIndex).UID; + Result := fCollList.Vault(cbCollection.ItemIndex).UID; end; procedure TSnippetsEditorDlg.SetAllCompilerResults( diff --git a/Src/FmUserDataPathDlg.pas b/Src/FmUserDataPathDlg.pas index 813521f01..e09433653 100644 --- a/Src/FmUserDataPathDlg.pas +++ b/Src/FmUserDataPathDlg.pas @@ -78,7 +78,7 @@ TUserDataPathDlg = class(TGenericViewDlg, INoPublicConstruct) fControlStateMgr: TControlStateMgr; /// Object used to provide and interogate a sorted list of /// collection names displated in cbCollection. - fCollList: TCollectionListAdapter; + fCollList: TVaultListAdapter; /// Sets visibility of all child controls of a parent control. /// /// TWinControl [in] Parent of affected controls. @@ -176,7 +176,7 @@ procedure TUserDataPathDlg.actMoveUpdate(Sender: TObject); actMove.Enabled := (NewDirFromEditCtrl <> '') and not StrSameText( NewDirFromEditCtrl, - fCollList.Collection(cbCollection.ItemIndex).Storage.Directory + fCollList.Vault(cbCollection.ItemIndex).Storage.Directory ) and Self.Enabled; end; @@ -279,7 +279,7 @@ procedure TUserDataPathDlg.DoMove(const NewDir: string; frmProgress.Show(ProgressHostCtrl); try fMover.MoveTo( - fCollList.Collection(cbCollection.ItemIndex), NewDir + fCollList.Vault(cbCollection.ItemIndex), NewDir ); except on E: Exception do @@ -319,7 +319,7 @@ procedure TUserDataPathDlg.FormCreate(Sender: TObject); fMover.OnCopyFile := CopyFileHandler; fMover.OnDeleteFile := DeleteFileHandler; fControlStateMgr := TControlStateMgr.Create(Self); - fCollList := TCollectionListAdapter.Create; + fCollList := TVaultListAdapter.Create; end; procedure TUserDataPathDlg.FormDestroy(Sender: TObject); diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index 7cf16ee85..2b11632bf 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -70,7 +70,7 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) fSourceBGColourBox: TColorBoxEx; fSourceBGColourDlg: TColorDialogEx; - fCollList: TCollectionListAdapter; + fCollList: TVaultListAdapter; procedure SelectOverviewTreeState(const State: TOverviewStartState); {Selects combo box item associated with a overview treeview startup state. @@ -358,7 +358,7 @@ constructor TDisplayPrefsFrame.Create(AOwner: TComponent); TVaultID.TComparer.Create ); - fCollList := TCollectionListAdapter.Create; + fCollList := TVaultListAdapter.Create; fCollList.ToStrings(cbCollection.Items); Assert(cbCollection.Items.Count > 0, ClassName + '.Create: no collections'); @@ -513,7 +513,7 @@ function TDisplayPrefsFrame.SelectedCollectionID: TVaultID; begin Assert(cbCollection.ItemIndex >= 0, ClassName + '.SelectedCollectionID: no collection selected'); - Result := fCollList.Collection(cbCollection.ItemIndex).UID; + Result := fCollList.Vault(cbCollection.ItemIndex).UID; end; procedure TDisplayPrefsFrame.SelectOverviewTreeState( diff --git a/Src/UCollectionListAdapter.pas b/Src/UCollectionListAdapter.pas index 87c0b099e..dcd69df7b 100644 --- a/Src/UCollectionListAdapter.pas +++ b/Src/UCollectionListAdapter.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a class that adapts a list of snippet collections by providing an + * Implements a class that adapts a list of snippet vaults by providing an * alternative interface to the list, sorted by description. Designed for use * with GUI controls. } @@ -23,34 +23,34 @@ interface type - /// Class that adapts a list of snippet collections by providing an + /// Class that adapts a list of snippet vaults by providing an /// alternative interface to the list, sorted by description. Designed for /// use with GUI controls. - TCollectionListAdapter = class(TObject) + TVaultListAdapter = class(TObject) strict private var - fCollectionList: TSortedList; + fVaultList: TSortedList; public - /// Object constructor. Sets up object with sorted list of - /// collections. + /// Object constructor. Sets up object with a sorted list of + /// vaults. constructor Create; /// Object destructor. Tears down object. destructor Destroy; override; - /// Copies collection descriptions to a string list. + /// Copies vault descriptions to a string list. /// TStrings [in] String list that receives - /// collection descriptions. + /// vault descriptions. procedure ToStrings(const AStrings: TStrings); - /// Gets the collection at a specified index in the sorted list. + /// Gets the vault at a specified index in the sorted list. /// - /// Integer [in] Index of required collection. + /// Integer [in] Index of required vault. /// /// TVault. Required vault. - function Collection(const AIndex: Integer): TVault; + function Vault(const AIndex: Integer): TVault; /// Gets list index of the vault with the specified UID. function IndexOfUID(const AUID: TVaultID): Integer; @@ -65,19 +65,14 @@ implementation // Project UStrUtils; -{ TCollectionListAdapter } +{ TVaultListAdapter } -function TCollectionListAdapter.Collection(const AIndex: Integer): TVault; -begin - Result := fCollectionList[AIndex]; -end; - -constructor TCollectionListAdapter.Create; +constructor TVaultListAdapter.Create; var - Collection: TVault; + Vault: TVault; begin inherited Create; - fCollectionList := TSortedList.Create( + fVaultList := TSortedList.Create( TDelegatedComparer.Create( function (const Left, Right: TVault): Integer begin @@ -85,32 +80,37 @@ constructor TCollectionListAdapter.Create; end ) ); - for Collection in TVaults.Instance do - fCollectionList.Add(Collection); + for Vault in TVaults.Instance do + fVaultList.Add(Vault); end; -destructor TCollectionListAdapter.Destroy; +destructor TVaultListAdapter.Destroy; begin - fCollectionList.Free; + fVaultList.Free; inherited; end; -function TCollectionListAdapter.IndexOfUID(const AUID: TVaultID): Integer; +function TVaultListAdapter.IndexOfUID(const AUID: TVaultID): Integer; var Idx: Integer; begin Result := -1; - for Idx := 0 to Pred(fCollectionList.Count) do - if fCollectionList[Idx].UID = AUID then + for Idx := 0 to Pred(fVaultList.Count) do + if fVaultList[Idx].UID = AUID then Exit(Idx); end; -procedure TCollectionListAdapter.ToStrings(const AStrings: TStrings); +procedure TVaultListAdapter.ToStrings(const AStrings: TStrings); var - Collection: TVault; + Vault: TVault; +begin + for Vault in fVaultList do + AStrings.Add(Vault.Name); +end; + +function TVaultListAdapter.Vault(const AIndex: Integer): TVault; begin - for Collection in fCollectionList do - AStrings.Add(Collection.Name); + Result := fVaultList[AIndex]; end; end. From 9c3010093adbf870cbe3dc0df04f2d84aa79f6ff Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 17:35:36 +0000 Subject: [PATCH 161/222] Rename list adapter units into UI.Adapters namespace Renamed UCollectionListAdapter as UI.Adapters.VaultList, USnipKindListAdapter as UI.Adapters.SnippetKindList and UCategoryListAdapter as UI.Adapters.CategoryList. Updated the changed unit names in all form and frame files that use the units. --- Src/CodeSnip.dpr | 6 +++--- Src/CodeSnip.dproj | 6 +++--- Src/FmAboutDlg.pas | 2 +- Src/FmCodeImportDlg.pas | 2 +- Src/FmCollectionBackup.pas | 2 +- Src/FmDeleteUserDBDlg.pas | 2 +- Src/FmDuplicateSnippetDlg.pas | 4 ++-- Src/FmSWAGImportDlg.pas | 4 ++-- Src/FmSnippetsEditorDlg.pas | 8 ++++---- Src/FmUserDataPathDlg.pas | 2 +- Src/FrCategoryList.pas | 8 ++++++-- Src/FrDisplayPrefs.pas | 2 +- ...tegoryListAdapter.pas => UI.Adapters.CategoryList.pas} | 2 +- ...indListAdapter.pas => UI.Adapters.SnippetKindList.pas} | 2 +- ...ollectionListAdapter.pas => UI.Adapters.VaultList.pas} | 3 +-- 15 files changed, 29 insertions(+), 26 deletions(-) rename Src/{UCategoryListAdapter.pas => UI.Adapters.CategoryList.pas} (99%) rename Src/{USnipKindListAdapter.pas => UI.Adapters.SnippetKindList.pas} (99%) rename Src/{UCollectionListAdapter.pas => UI.Adapters.VaultList.pas} (98%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 060086421..44eabe1f5 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -190,7 +190,7 @@ uses UBrowseForFolderDlg in 'UBrowseForFolderDlg.pas', UBrowseProtocol in 'UBrowseProtocol.pas', UCategoryAction in 'UCategoryAction.pas', - UCategoryListAdapter in 'UCategoryListAdapter.pas', + UI.Adapters.CategoryList in 'UI.Adapters.CategoryList.pas', ClassHelpers.UControls in 'ClassHelpers.UControls.pas', UClipboardHelper in 'UClipboardHelper.pas', UCodeImportExport in 'UCodeImportExport.pas', @@ -313,7 +313,7 @@ uses UShowCaseCtrl in 'UShowCaseCtrl.pas', USimpleDispatch in 'USimpleDispatch.pas', USingleton in 'USingleton.pas', - USnipKindListAdapter in 'USnipKindListAdapter.pas', + UI.Adapters.SnippetKindList in 'UI.Adapters.SnippetKindList.pas', USnippetAction in 'USnippetAction.pas', USnippetDoc in 'USnippetDoc.pas', USnippetExtraHelper in 'USnippetExtraHelper.pas', @@ -376,7 +376,7 @@ uses DB.Vaults in 'DB.Vaults.pas', UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas', DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas', - UCollectionListAdapter in 'UCollectionListAdapter.pas', + UI.Adapters.VaultList in 'UI.Adapters.VaultList.pas', FmCollectionBackup in 'FmCollectionBackup.pas' {CollectionBackupDlg}, DB.DataFormats in 'DB.DataFormats.pas', DB.IO.DataFormat.Native in 'DB.IO.DataFormat.Native.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 11e8bc08f..eff2436da 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -392,7 +392,7 @@ - + @@ -515,7 +515,7 @@ - + @@ -582,7 +582,7 @@ - +
CollectionBackupDlg
 diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index 1f90bf564..cde3258cd 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -33,8 +33,8 @@ interface FrBrowserBase, FrHTMLDlg, FrHTMLTpltDlg, - UCollectionListAdapter, UCSSBuilder, + UI.Adapters.VaultList, UIStringList; diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index ac77120a3..eecd47e5b 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -29,7 +29,7 @@ interface FmWizardDlg, UBaseObjects, UCodeImportMgr, - UCollectionListAdapter; + UI.Adapters.VaultList; type /// diff --git a/Src/FmCollectionBackup.pas b/Src/FmCollectionBackup.pas index 955ae26c7..643c00b76 100644 --- a/Src/FmCollectionBackup.pas +++ b/Src/FmCollectionBackup.pas @@ -23,7 +23,7 @@ interface // Project DB.Vaults, FmGenericOKDlg, - UCollectionListAdapter; + UI.Adapters.VaultList; type TCollectionBackupDlg = class(TGenericOKDlg) diff --git a/Src/FmDeleteUserDBDlg.pas b/Src/FmDeleteUserDBDlg.pas index b5ce15d46..05317a13e 100644 --- a/Src/FmDeleteUserDBDlg.pas +++ b/Src/FmDeleteUserDBDlg.pas @@ -28,7 +28,7 @@ interface FrHTMLDlg, FrFixedHTMLDlg, UBaseObjects, - UCollectionListAdapter; + UI.Adapters.VaultList; type TDeleteUserDBDlg = class(TGenericOKDlg, INoPublicConstruct) diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index fe8f5e284..25e53728b 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -27,8 +27,8 @@ interface DB.Vaults, FmGenericOKDlg, UBaseObjects, - UCategoryListAdapter, - UCollectionListAdapter, + UI.Adapters.CategoryList, + UI.Adapters.VaultList, UIStringList; diff --git a/Src/FmSWAGImportDlg.pas b/Src/FmSWAGImportDlg.pas index 4a760c8d1..5c28fcf20 100644 --- a/Src/FmSWAGImportDlg.pas +++ b/Src/FmSWAGImportDlg.pas @@ -35,12 +35,12 @@ interface FrHTMLDlg, FrHTMLTpltDlg, UBaseObjects, - UCollectionListAdapter, UContainers, UCSSBuilder, SWAG.UCommon, SWAG.UImporter, - SWAG.UReader; + SWAG.UReader, + UI.Adapters.VaultList; type diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 669cd1727..4b70297ac 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -41,17 +41,17 @@ interface FrFixedHTMLDlg, FrHTMLDlg, UBaseObjects, - UCategoryListAdapter, - UCollectionListAdapter, UCompileMgr, UCompileResultsLBMgr, UCSSBuilder, UMemoCaretPosDisplayMgr, UMemoHelper, - USnipKindListAdapter, USnippetsChkListMgr, UUnitsChkListMgr, - FmSnippetsEditorDlg.FrActiveTextEditor; + FmSnippetsEditorDlg.FrActiveTextEditor, + UI.Adapters.CategoryList, + UI.Adapters.SnippetKindList, + UI.Adapters.VaultList; type diff --git a/Src/FmUserDataPathDlg.pas b/Src/FmUserDataPathDlg.pas index e09433653..d31951c34 100644 --- a/Src/FmUserDataPathDlg.pas +++ b/Src/FmUserDataPathDlg.pas @@ -29,8 +29,8 @@ interface FmGenericViewDlg, FrProgress, UBaseObjects, - UCollectionListAdapter, UControlStateMgr, + UI.Adapters.VaultList, UUserDBMove; type diff --git a/Src/FrCategoryList.pas b/Src/FrCategoryList.pas index b1b225c97..c2068de05 100644 --- a/Src/FrCategoryList.pas +++ b/Src/FrCategoryList.pas @@ -18,9 +18,13 @@ interface uses // Delphi - Forms, Controls, StdCtrls, Classes, + Forms, + Controls, + StdCtrls, + Classes, // Project - DB.UCategory, UCategoryListAdapter; + DB.UCategory, + UI.Adapters.CategoryList; type diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index 2b11632bf..6a1746148 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -27,9 +27,9 @@ interface // Project DB.Vaults, FrPrefsBase, - UCollectionListAdapter, UColorBoxEx, UColorDialogEx, + UI.Adapters.VaultList, UPreferences; diff --git a/Src/UCategoryListAdapter.pas b/Src/UI.Adapters.CategoryList.pas similarity index 99% rename from Src/UCategoryListAdapter.pas rename to Src/UI.Adapters.CategoryList.pas index 8f27e6d15..d1b197b86 100644 --- a/Src/UCategoryListAdapter.pas +++ b/Src/UI.Adapters.CategoryList.pas @@ -11,7 +11,7 @@ } -unit UCategoryListAdapter; +unit UI.Adapters.CategoryList; interface diff --git a/Src/USnipKindListAdapter.pas b/Src/UI.Adapters.SnippetKindList.pas similarity index 99% rename from Src/USnipKindListAdapter.pas rename to Src/UI.Adapters.SnippetKindList.pas index 745e819e1..d6e4386d1 100644 --- a/Src/USnipKindListAdapter.pas +++ b/Src/UI.Adapters.SnippetKindList.pas @@ -11,7 +11,7 @@ } -unit USnipKindListAdapter; +unit UI.Adapters.SnippetKindList; interface diff --git a/Src/UCollectionListAdapter.pas b/Src/UI.Adapters.VaultList.pas similarity index 98% rename from Src/UCollectionListAdapter.pas rename to Src/UI.Adapters.VaultList.pas index dcd69df7b..a17a76ded 100644 --- a/Src/UCollectionListAdapter.pas +++ b/Src/UI.Adapters.VaultList.pas @@ -10,7 +10,7 @@ * with GUI controls. } -unit UCollectionListAdapter; +unit UI.Adapters.VaultList; interface @@ -60,7 +60,6 @@ implementation uses // Delphi -// Windows {for inlining}, Generics.Defaults, // Project UStrUtils; From 09ba858262d950081d4e0f1ac6bdb6671f952ea7 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 19:36:01 +0000 Subject: [PATCH 162/222] Change name of settings sections storing vault info The [Collections] and [Collection] sections where renamed as [Vaults] and [Vault] --- Src/DB.Vaults.pas | 8 ++++---- Src/USettings.pas | 15 +++++++-------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/Src/DB.Vaults.pas b/Src/DB.Vaults.pas index b9645d617..44654bd98 100644 --- a/Src/DB.Vaults.pas +++ b/Src/DB.Vaults.pas @@ -495,7 +495,7 @@ class procedure TVaultsPersist.Load(const AVaults: TVaults); Count: Integer; Idx: Integer; begin - ConfigSection := Settings.ReadSection(ssCollections); + ConfigSection := Settings.ReadSection(ssVaults); Count := ConfigSection.GetInteger(CountKey, 0); for Idx := 0 to Pred(Count) do LoadVault(Idx, AVaults); @@ -510,7 +510,7 @@ class procedure TVaultsPersist.LoadVault(const AOrdinal: Cardinal; Vault: TVault; StorageDetails: TDataStorageDetails; begin - ConfigSection := Settings.ReadSection(ssCollection, IntToStr(AOrdinal)); + ConfigSection := Settings.ReadSection(ssVault, IntToStr(AOrdinal)); UID := TVaultID.Create(ConfigSection.GetBytes(UIDKey)); if AVaults.ContainsID(UID) then // Don't load a duplicate vault @@ -533,7 +533,7 @@ class procedure TVaultsPersist.Save(const AVaults: TVaults); Idx: Integer; begin // Save number of vaults - ConfigSection := Settings.EmptySection(ssCollections); + ConfigSection := Settings.EmptySection(ssVaults); ConfigSection.SetInteger(CountKey, AVaults.Count); ConfigSection.Save; // Save each vault's properties in its own section @@ -547,7 +547,7 @@ class procedure TVaultsPersist.SaveVault(const AOrdinal: Cardinal; ConfigSection: ISettingsSection; begin // Save info about vault format in its own section - ConfigSection := Settings.EmptySection(ssCollection, IntToStr(AOrdinal)); + ConfigSection := Settings.EmptySection(ssVault, IntToStr(AOrdinal)); ConfigSection.SetBytes(UIDKey, AVault.UID.ToArray); ConfigSection.SetString(NameKey, AVault.Name); ConfigSection.SetInteger(StorageFormatKey, Ord(AVault.Storage.Format)); diff --git a/Src/USettings.pas b/Src/USettings.pas index fe963bffc..f3f4427fd 100644 --- a/Src/USettings.pas +++ b/Src/USettings.pas @@ -178,14 +178,13 @@ interface /// -ssWindowState - info about the size and state of various /// windows /// -ssCompilers - info about all compilers - /// -ssCollections - info about all snippet collections - /// -ssCollection - info about a specific snippet collection + /// -ssVaults - info about all snippet vaults + /// -ssVault - info about a specific snippet vault /// TSettingsSectionId = ( - ssFindText, ssFindCompiler, ssFindXRefs, ssCompilerInfo, - ssPreferences, ssUnits, ssDuplicateSnippet, - ssFavourites, ssWindowState, ssCompilers, ssCollections, - ssCollection + ssFindText, ssFindCompiler, ssFindXRefs, ssCompilerInfo, ssPreferences, + ssUnits, ssDuplicateSnippet, ssFavourites, ssWindowState, ssCompilers, + ssVaults, ssVault ); type @@ -579,8 +578,8 @@ function TIniSettings.SectionName(const Id: TSettingsSectionId; 'Favourites', // ssFavourites 'WindowState', // ssWindowState 'Compilers', // ssCompilers - 'Collections', // ssCollections - 'Collection' // ssCollection + 'Vaults', // ssVaults + 'Vault' // ssVault ); begin Result := cSectionNames[Id]; From 621c0e3275c6add162873cc0b92ece3badc4ecdb Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 19:58:25 +0000 Subject: [PATCH 163/222] Renaming in FmAboutDlg unit Update About Box re renaming of collections to vaults Controls and identifiers that referred to collections were changed to refer to vaults. Updated comments in line with renaming. --- Src/FmAboutDlg.dfm | 24 ++++++------- Src/FmAboutDlg.pas | 84 +++++++++++++++++++++++----------------------- 2 files changed, 52 insertions(+), 56 deletions(-) diff --git a/Src/FmAboutDlg.dfm b/Src/FmAboutDlg.dfm index 478fb6456..ea3d25d6b 100644 --- a/Src/FmAboutDlg.dfm +++ b/Src/FmAboutDlg.dfm @@ -27,7 +27,7 @@ inherited AboutDlg: TAboutDlg Top = 47 Width = 409 Height = 218 - ActivePage = tsPaths + ActivePage = tsVaults Align = alTop TabOrder = 0 OnMouseDown = pcDetailMouseDown @@ -67,25 +67,21 @@ inherited AboutDlg: TAboutDlg end end end - object tsCollections: TTabSheet - Caption = 'About Collections' + object tsVaults: TTabSheet + Caption = 'About Vaults' ImageIndex = 1 - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 DesignSize = ( 401 190) - object lblCollection: TLabel + object lblVaults: TLabel Left = 3 Top = 3 - Width = 80 + Width = 60 Height = 13 - Caption = '&Select collection:' - FocusControl = cbCollection + Caption = '&Select vault:' + FocusControl = cbVaults end - object cbCollection: TComboBox + object cbVaults: TComboBox Left = 112 Top = 0 Width = 286 @@ -93,9 +89,9 @@ inherited AboutDlg: TAboutDlg Style = csDropDownList Anchors = [akLeft, akTop, akRight] TabOrder = 0 - OnChange = cbCollectionChange + OnChange = cbVaultsChange end - object tvCollectionInfo: TTreeView + object tvVaultInfo: TTreeView Left = 0 Top = 27 Width = 401 diff --git a/Src/FmAboutDlg.pas b/Src/FmAboutDlg.pas index cde3258cd..3bb532d14 100644 --- a/Src/FmAboutDlg.pas +++ b/Src/FmAboutDlg.pas @@ -79,23 +79,23 @@ TPathInfoBox = class(TCustomGroupBox) end; /// Implements program's about dialogue box. - /// Displays information about the program, the collections in use - /// and the program's user and application folders and config files. Also + /// Displays information about the program, the vautls in use and + /// the program's user and application folders and config files. Also /// provides access to the program's easter egg. TAboutDlg = class(TGenericViewDlg) bvlSeparator: TBevel; frmProgram: THTMLTpltDlgFrame; pcDetail: TPageControl; - tsCollections: TTabSheet; + tsVaults: TTabSheet; tsProgram: TTabSheet; pnlTitle: TPanel; frmTitle: THTMLTpltDlgFrame; tsPaths: TTabSheet; btnViewAppConfig: TButton; btnViewUserConfig: TButton; - cbCollection: TComboBox; - lblCollection: TLabel; - tvCollectionInfo: TTreeView; + cbVaults: TComboBox; + lblVaults: TLabel; + tvVaultInfo: TTreeView; sbPaths: TScrollBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); @@ -112,17 +112,17 @@ TAboutDlg = class(TGenericViewDlg) /// procedure btnViewUserConfigClick(Sender: TObject); /// Handles the change event triggered when the user selects a - /// collection in the collections combo box. Updates the display of - /// information about the selected collection. - procedure cbCollectionChange(Sender: TObject); + /// vault in the vaults combo box. Updates the display of information about + /// the selected vault. + procedure cbVaultsChange(Sender: TObject); strict private var /// List of dynamically created path information group boxes. /// fPathInfoBoxes: TList; - /// Provides a sorted list of collection names for display in - /// the collections combo box. - fCollList: TVaultListAdapter; + /// Provides a sorted list of vault names for display in the + /// vault combo box. + fVaultList: TVaultListAdapter; /// Handles title frame's OnHTMLEvent event. Checks for mouse /// events relating to display of the easter egg and acts accordingly. /// @@ -132,9 +132,9 @@ TAboutDlg = class(TGenericViewDlg) procedure HTMLEventHandler(Sender: TObject; const EventInfo: THTMLEventInfo); /// Displays any meta data associated with a vault. - /// TVault [in] Vault for which meta data + /// TVault [in] Vault for which meta data /// is to be displayed. - procedure DisplayCollectionInfo(ACollection: TVault); + procedure DisplayVaultInfo(AVault: TVault); /// Displays content of a config file in a dialogue box or an /// error message if the file does not exist. /// string [in] Name of config file to display. @@ -223,10 +223,10 @@ procedure TAboutDlg.ArrangeForm; PathInfoBox: TPathInfoBox; NextPathInfoBoxTop: Integer; begin - // Collections tab - TCtrlArranger.AlignVCentres(8, [lblCollection, cbCollection]); - TCtrlArranger.MoveToRightOf(lblCollection, cbCollection, 12); - TCtrlArranger.MoveBelow([lblCollection, cbCollection], tvCollectionInfo, 8); + // Vaults tab + TCtrlArranger.AlignVCentres(8, [lblVaults, cbVaults]); + TCtrlArranger.MoveToRightOf(lblVaults, cbVaults, 12); + TCtrlArranger.MoveBelow([lblVaults, cbVaults], tvVaultInfo, 8); // Paths tab TCtrlArranger.AlignTops([btnViewAppConfig, btnViewUserConfig], 8); @@ -275,9 +275,9 @@ procedure TAboutDlg.btnViewUserConfigClick(Sender: TObject); ViewConfigFile(TAppInfo.UserConfigFileName, sTitle); end; -procedure TAboutDlg.cbCollectionChange(Sender: TObject); +procedure TAboutDlg.cbVaultsChange(Sender: TObject); begin - DisplayCollectionInfo(fCollList.Vault(cbCollection.ItemIndex)); + DisplayVaultInfo(fVaultList.Vault(cbVaults.ItemIndex)); end; procedure TAboutDlg.ConfigForm; @@ -298,12 +298,12 @@ procedure TAboutDlg.ConfigForm; end; var - Collection: TVault; + Vault: TVault; TabIdx: Integer; resourcestring // Captions for custom controls sInstallPathGpCaption = 'Install Directory'; - sCollectionPathGpCaption = '%s Collection Directory'; + sVaultPathGpCaption = '%s Vault Directory'; begin inherited; // Creates required custom controls @@ -311,36 +311,36 @@ procedure TAboutDlg.ConfigForm; fPathInfoBoxes.Add( CreatePathInfoBox(sInstallPathGpCaption, TAppInfo.AppExeDir, 1) ); - for Collection in TVaults.Instance do + for Vault in TVaults.Instance do begin Inc(TabIdx); fPathInfoBoxes.Add( CreatePathInfoBox( - Format(sCollectionPathGpCaption, [Collection.Name]), - Collection.Storage.Directory, + Format(sVaultPathGpCaption, [Vault.Name]), + Vault.Storage.Directory, TabIdx ) ); end; - // Load collections into combo box & select default collection - fCollList.ToStrings(cbCollection.Items); - cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); - DisplayCollectionInfo(fCollList.Vault(cbCollection.ItemIndex)); - // Set collections treeview and paths scrollbox background colours - tvCollectionInfo.Color := ThemeServicesEx.GetTabBodyColour; + // Load vaults into combo box & select default vault + fVaultList.ToStrings(cbVaults.Items); + cbVaults.ItemIndex := fVaultList.IndexOfUID(TVaultID.Default); + DisplayVaultInfo(fVaultList.Vault(cbVaults.ItemIndex)); + // Set vaults treeview and paths scrollbox background colours + tvVaultInfo.Color := ThemeServicesEx.GetTabBodyColour; sbPaths.Color := ThemeServicesEx.GetTabBodyColour; // Load content into HTML frames InitHTMLFrames; end; -procedure TAboutDlg.DisplayCollectionInfo(ACollection: TVault); +procedure TAboutDlg.DisplayVaultInfo(AVault: TVault); var HasEntries: Boolean; function AddChild(const AParentNode: TTreeNode; const AData: string): TTreeNode; begin - Result := tvCollectionInfo.Items.AddChild(AParentNode, AData); + Result := tvVaultInfo.Items.AddChild(AParentNode, AData); HasEntries := True; end; @@ -363,15 +363,15 @@ procedure TAboutDlg.DisplayCollectionInfo(ACollection: TVault); sCopyrightHeading = 'Copyright'; sContributorsHeading = 'Contributors'; sAcknowledgementsHeading = 'Acknowledgements'; - sNoMetaData = 'No information available for this collection.'; + sNoMetaData = 'No information available for this vault.'; sNotAvailable = 'Not specified'; sNone = 'None'; begin - tvCollectionInfo.Items.BeginUpdate; + tvVaultInfo.Items.BeginUpdate; try - tvCollectionInfo.Items.Clear; + tvVaultInfo.Items.Clear; HasEntries := False; - MetaData := ACollection.MetaData; + MetaData := AVault.MetaData; Capabilities := MetaData.Capabilities; if Capabilities <> [] then @@ -444,12 +444,12 @@ procedure TAboutDlg.DisplayCollectionInfo(ACollection: TVault); if HasEntries then begin - tvCollectionInfo.FullExpand; - tvCollectionInfo.Items[0].MakeVisible; + tvVaultInfo.FullExpand; + tvVaultInfo.Items[0].MakeVisible; end; finally - tvCollectionInfo.Items.EndUpdate; + tvVaultInfo.Items.EndUpdate; end; end; @@ -468,7 +468,7 @@ class procedure TAboutDlg.Execute(AOwner: TComponent); procedure TAboutDlg.FormCreate(Sender: TObject); begin inherited; - fCollList := TVaultListAdapter.Create; + fVaultList := TVaultListAdapter.Create; fPathInfoBoxes := TList.Create; frmTitle.OnBuildCSS := UpdateTitleCSS; frmProgram.OnBuildCSS := UpdateProgramTabCSS; @@ -478,7 +478,7 @@ procedure TAboutDlg.FormDestroy(Sender: TObject); begin inherited; fPathInfoBoxes.Free; - fCollList.Free; + fVaultList.Free; end; procedure TAboutDlg.HTMLEventHandler(Sender: TObject; From 578035a446f829e1a08fd46d38625e280c66db31 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 20:21:42 +0000 Subject: [PATCH 164/222] Renaming in FmCollectionBackup unit Form name & class, controls and identifiers that referred to collections were changed to refer to vaults. Minimal changes were made to calling code in UUserDBMgr unit re the renamed form class in FmCollectionBackup. Updated comments in line with renaming. --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/FmCollectionBackup.dfm | 14 ++++----- Src/FmCollectionBackup.pas | 58 +++++++++++++++++++------------------- Src/UUserDBMgr.pas | 4 +-- 5 files changed, 40 insertions(+), 40 deletions(-) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 44eabe1f5..b5c663cd5 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -377,7 +377,7 @@ uses UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas', DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas', UI.Adapters.VaultList in 'UI.Adapters.VaultList.pas', - FmCollectionBackup in 'FmCollectionBackup.pas' {CollectionBackupDlg}, + FmCollectionBackup in 'FmCollectionBackup.pas' {VaultBackupDlg}, DB.DataFormats in 'DB.DataFormats.pas', DB.IO.DataFormat.Native in 'DB.IO.DataFormat.Native.pas', DB.MetaData in 'DB.MetaData.pas'; diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index eff2436da..3f42e0b61 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -584,7 +584,7 @@ -
CollectionBackupDlg
+
VaultBackupDlg
 diff --git a/Src/FmCollectionBackup.dfm b/Src/FmCollectionBackup.dfm index 86282bbfa..9c0d7fbf9 100644 --- a/Src/FmCollectionBackup.dfm +++ b/Src/FmCollectionBackup.dfm @@ -1,17 +1,17 @@ -inherited CollectionBackupDlg: TCollectionBackupDlg - Caption = 'Choose Collection & Backup File' +inherited VaultBackupDlg: TVaultBackupDlg + Caption = 'Choose Vault & Backup File' ExplicitWidth = 474 ExplicitHeight = 375 PixelsPerInch = 96 TextHeight = 13 inherited pnlBody: TPanel - object lblCollection: TLabel + object lblVaults: TLabel Left = 0 Top = 7 - Width = 80 + Width = 60 Height = 13 - Caption = 'Select &collection:' - FocusControl = cbCollection + Caption = 'Select &vault:' + FocusControl = cbVaults end object lblPath: TLabel Left = 0 @@ -27,7 +27,7 @@ inherited CollectionBackupDlg: TCollectionBackupDlg Font.Style = [] ParentFont = False end - object cbCollection: TComboBox + object cbVaults: TComboBox Left = 0 Top = 24 Width = 358 diff --git a/Src/FmCollectionBackup.pas b/Src/FmCollectionBackup.pas index 643c00b76..b46681a2c 100644 --- a/Src/FmCollectionBackup.pas +++ b/Src/FmCollectionBackup.pas @@ -5,8 +5,8 @@ * * Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a dialogue box that enables the user to choose a collection to - * backup or restore along with the directory to backup to or restore from. + * Implements a dialogue box that enables the user to choose a vault to backup + * or restore along with the directory to backup to or restore from. } @@ -26,9 +26,9 @@ interface UI.Adapters.VaultList; type - TCollectionBackupDlg = class(TGenericOKDlg) - lblCollection: TLabel; - cbCollection: TComboBox; + TVaultBackupDlg = class(TGenericOKDlg) + lblVaults: TLabel; + cbVaults: TComboBox; lblPath: TLabel; edPath: TEdit; btnBrowse: TButton; @@ -39,15 +39,15 @@ TCollectionBackupDlg = class(TGenericOKDlg) strict private var fFileName: string; - fCollection: TVault; - fCollList: TVaultListAdapter; + fVault: TVault; + fVaultList: TVaultListAdapter; function GetFilePathFromEditCtrl: string; strict protected procedure ConfigForm; override; procedure ArrangeForm; override; public class function Execute(AOwner: TComponent; - out AFileName: string; out ACollection: TVault): Boolean; + out AFileName: string; out AVault: TVault): Boolean; end; implementation @@ -65,15 +65,15 @@ implementation USaveDialogEx, UStrUtils; -procedure TCollectionBackupDlg.ArrangeForm; +procedure TVaultBackupDlg.ArrangeForm; begin - TCtrlArranger.AlignLefts([lblCollection, cbCollection, lblPath, edPath], 0); + TCtrlArranger.AlignLefts([lblVaults, cbVaults, lblPath, edPath], 0); // row 1 - lblCollection.Top := 0; + lblVaults.Top := 0; // row 2 - TCtrlArranger.MoveBelow(lblCollection, cbCollection, 6); + TCtrlArranger.MoveBelow(lblVaults, cbVaults, 6); // row 3 - TCtrlArranger.MoveBelow(cbCollection, lblPath, 12); + TCtrlArranger.MoveBelow(cbVaults, lblPath, 12); // row 4 TCtrlArranger.MoveToRightOf(edPath, btnBrowse, 6); TCtrlArranger.AlignVCentres( @@ -84,7 +84,7 @@ procedure TCollectionBackupDlg.ArrangeForm; inherited; end; -procedure TCollectionBackupDlg.btnBrowseClick(Sender: TObject); +procedure TVaultBackupDlg.btnBrowseClick(Sender: TObject); var SaveDlg: TSaveDialogEx; // save dialog box used to name backup file resourcestring @@ -105,46 +105,46 @@ procedure TCollectionBackupDlg.btnBrowseClick(Sender: TObject); end; end; -procedure TCollectionBackupDlg.btnOKClick(Sender: TObject); +procedure TVaultBackupDlg.btnOKClick(Sender: TObject); begin fFileName := GetFilePathFromEditCtrl; - fCollection := fCollList.Vault(cbCollection.ItemIndex); + fVault := fVaultList.Vault(cbVaults.ItemIndex); end; -procedure TCollectionBackupDlg.ConfigForm; +procedure TVaultBackupDlg.ConfigForm; begin inherited; - fCollList.ToStrings(cbCollection.Items); - cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); + fVaultList.ToStrings(cbVaults.Items); + cbVaults.ItemIndex := fVaultList.IndexOfUID(TVaultID.Default); end; -class function TCollectionBackupDlg.Execute(AOwner: TComponent; - out AFileName: string; out ACollection: TVault): Boolean; +class function TVaultBackupDlg.Execute(AOwner: TComponent; + out AFileName: string; out AVault: TVault): Boolean; var - Dlg: TCollectionBackupDlg; + Dlg: TVaultBackupDlg; begin - Dlg := TCollectionBackupDlg.Create(AOwner); + Dlg := TVaultBackupDlg.Create(AOwner); Result := Dlg.ShowModal = mrOK; if Result then begin AFileName := Dlg.fFileName; - ACollection := Dlg.fCollection; + AVault := Dlg.fVault; end; end; -procedure TCollectionBackupDlg.FormCreate(Sender: TObject); +procedure TVaultBackupDlg.FormCreate(Sender: TObject); begin inherited; - fCollList := TVaultListAdapter.Create; + fVaultList := TVaultListAdapter.Create; end; -procedure TCollectionBackupDlg.FormDestroy(Sender: TObject); +procedure TVaultBackupDlg.FormDestroy(Sender: TObject); begin - fCollList.Free; + fVaultList.Free; inherited; end; -function TCollectionBackupDlg.GetFilePathFromEditCtrl: string; +function TVaultBackupDlg.GetFilePathFromEditCtrl: string; begin Result := StrTrim(edPath.Text); end; diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index d03644d52..cd72204ce 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -261,7 +261,7 @@ class procedure TUserDBMgr.BackupDatabase(ParentCtrl: TComponent); resourcestring sOverwritePrompt = '"%s" already exists. OK to overwrite?'; begin - if TCollectionBackupDlg.Execute(ParentCtrl, FileName, Collection) then + if TVaultBackupDlg.Execute(ParentCtrl, FileName, Collection) then begin if TFile.Exists(FileName) and not TMessageBox.Confirm( @@ -445,7 +445,7 @@ class function TUserDBMgr.RestoreDatabase(ParentCtrl: TComponent): Boolean; resourcestring sFileDoesNotExist = '"%s" does not exist.'; begin - Result := TCollectionBackupDlg.Execute(ParentCtrl, FileName, Collection); + Result := TVaultBackupDlg.Execute(ParentCtrl, FileName, Collection); if Result then begin if not TFile.Exists(FileName) then From f72e8b677b8d0b0e05ba8e98ca08b406cf9f8a3b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 09:30:08 +0000 Subject: [PATCH 165/222] Rename FmCollectionBackup unit The unit source code and form files were renamed to UI.Forms.BackupVault.pas/.dfm Calling code receivee in affected units. --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/{FmCollectionBackup.dfm => UI.Forms.BackupVaultDlg.dfm} | 0 Src/{FmCollectionBackup.pas => UI.Forms.BackupVaultDlg.pas} | 2 +- Src/UUserDBMgr.pas | 2 +- 5 files changed, 4 insertions(+), 4 deletions(-) rename Src/{FmCollectionBackup.dfm => UI.Forms.BackupVaultDlg.dfm} (100%) rename Src/{FmCollectionBackup.pas => UI.Forms.BackupVaultDlg.pas} (99%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index b5c663cd5..08fa5bd66 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -377,7 +377,7 @@ uses UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas', DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas', UI.Adapters.VaultList in 'UI.Adapters.VaultList.pas', - FmCollectionBackup in 'FmCollectionBackup.pas' {VaultBackupDlg}, + UI.Forms.BackupVaultDlg in 'UI.Forms.BackupVaultDlg.pas' {VaultBackupDlg}, DB.DataFormats in 'DB.DataFormats.pas', DB.IO.DataFormat.Native in 'DB.IO.DataFormat.Native.pas', DB.MetaData in 'DB.MetaData.pas'; diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 3f42e0b61..7af39bed6 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -583,7 +583,7 @@ - +
VaultBackupDlg
 diff --git a/Src/FmCollectionBackup.dfm b/Src/UI.Forms.BackupVaultDlg.dfm similarity index 100% rename from Src/FmCollectionBackup.dfm rename to Src/UI.Forms.BackupVaultDlg.dfm diff --git a/Src/FmCollectionBackup.pas b/Src/UI.Forms.BackupVaultDlg.pas similarity index 99% rename from Src/FmCollectionBackup.pas rename to Src/UI.Forms.BackupVaultDlg.pas index b46681a2c..9d5fe83c8 100644 --- a/Src/FmCollectionBackup.pas +++ b/Src/UI.Forms.BackupVaultDlg.pas @@ -10,7 +10,7 @@ } -unit FmCollectionBackup; +unit UI.Forms.BackupVaultDlg; interface diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index cd72204ce..9bc176edd 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -100,7 +100,7 @@ implementation DB.USnippet, DB.Vaults, FmAddCategoryDlg, - FmCollectionBackup, + UI.Forms.BackupVaultDlg, FmDeleteCategoryDlg, FmDeleteUserDBDlg, FmDuplicateSnippetDlg, From 6b95cc12a9d730ab4db82fb652a39397dbb4a229 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 21:01:04 +0000 Subject: [PATCH 166/222] Renaming in FmDeleteUserDBDlg unit Form name & class, controls and identifiers that referred to collections were changed to refer to vaults. Also revised dlg-dbdelete.html that contains the HTML displayed in the dialogue box. Renamed "collection" as "vault" in dlg-dbdelete.html page displayed in the dialogue box. Minimal changes were made to calling code in UUserDBMgr unit re the renamed form class in FmCollectionBackup. Updated comments in line with renaming. --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/FmDeleteUserDBDlg.dfm | 14 ++++---- Src/FmDeleteUserDBDlg.pas | 62 +++++++++++++++++----------------- Src/Res/HTML/dlg-dbdelete.html | 10 +++--- Src/UUserDBMgr.pas | 2 +- 6 files changed, 46 insertions(+), 46 deletions(-) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 08fa5bd66..f24a3fd64 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -367,7 +367,7 @@ uses UXMLDocConsts in 'UXMLDocConsts.pas', UXMLDocHelper in 'UXMLDocHelper.pas', UXMLDocumentEx in 'UXMLDocumentEx.pas', - FmDeleteUserDBDlg in 'FmDeleteUserDBDlg.pas' {DeleteUserDBDlg}, + FmDeleteUserDBDlg in 'FmDeleteUserDBDlg.pas' {DeleteVaultDlg}, Compilers.UAutoDetect in 'Compilers.UAutoDetect.pas', Compilers.USettings in 'Compilers.USettings.pas', FmRegisterCompilersDlg in 'FmRegisterCompilersDlg.pas' {RegisterCompilersDlg}, diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 7af39bed6..82ea61515 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -570,7 +570,7 @@ -
DeleteUserDBDlg
+
DeleteVaultDlg
 diff --git a/Src/FmDeleteUserDBDlg.dfm b/Src/FmDeleteUserDBDlg.dfm index d1e181c91..3552eeeb0 100644 --- a/Src/FmDeleteUserDBDlg.dfm +++ b/Src/FmDeleteUserDBDlg.dfm @@ -1,5 +1,5 @@ -inherited DeleteUserDBDlg: TDeleteUserDBDlg - Caption = 'Delete All Snippets From Collection' +inherited DeleteVaultDlg: TDeleteVaultDlg + Caption = 'Delete All Snippets From A Vault' ExplicitWidth = 474 ExplicitHeight = 375 PixelsPerInch = 96 @@ -13,13 +13,13 @@ inherited DeleteUserDBDlg: TDeleteUserDBDlg Caption = 'Confirm &deletion:' FocusControl = edConfirm end - object lblCollection: TLabel + object lblVaults: TLabel Left = 0 Top = 224 - Width = 87 + Width = 67 Height = 13 - Caption = 'Choose &collection:' - FocusControl = cbCollection + Caption = 'Choose &vault:' + FocusControl = cbVaults end object edConfirm: TEdit Left = 120 @@ -57,7 +57,7 @@ inherited DeleteUserDBDlg: TDeleteUserDBDlg end end end - object cbCollection: TComboBox + object cbVaults: TComboBox Left = 120 Top = 221 Width = 249 diff --git a/Src/FmDeleteUserDBDlg.pas b/Src/FmDeleteUserDBDlg.pas index 05317a13e..7bcd2cdf5 100644 --- a/Src/FmDeleteUserDBDlg.pas +++ b/Src/FmDeleteUserDBDlg.pas @@ -5,8 +5,8 @@ * * Copyright (C) 2022-2023, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a dialogue box that enables the user to choose a collection from - * which to delete all snippets. + * Implements a dialogue box that enables the user to choose a vault from which + * to delete all snippets. } @@ -31,12 +31,12 @@ interface UI.Adapters.VaultList; type - TDeleteUserDBDlg = class(TGenericOKDlg, INoPublicConstruct) + TDeleteVaultDlg = class(TGenericOKDlg, INoPublicConstruct) edConfirm: TEdit; frmWarning: TFixedHTMLDlgFrame; lblConfirm: TLabel; - lblCollection: TLabel; - cbCollection: TComboBox; + lblVaults: TLabel; + cbVaults: TComboBox; procedure btnOKClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); @@ -45,9 +45,9 @@ TDeleteUserDBDlg = class(TGenericOKDlg, INoPublicConstruct) cConfirmText = 'DELETE MY SNIPPETS'; var fPermissionGranted: Boolean; - fCollection: TVault; - fCollList: TVaultListAdapter; - function SelectedCollection: TVault; + fVault: TVault; + fVaultList: TVaultListAdapter; + function SelectedVault: TVault; function IsValidPassword: Boolean; strict protected /// Protected constructor that sets up form. @@ -55,7 +55,7 @@ TDeleteUserDBDlg = class(TGenericOKDlg, INoPublicConstruct) procedure ConfigForm; override; procedure ArrangeForm; override; public - class function Execute(AOwner: TComponent; out ACollection: TVault): Boolean; + class function Execute(AOwner: TComponent; out AVault: TVault): Boolean; end; implementation @@ -69,30 +69,30 @@ implementation {$R *.dfm} -procedure TDeleteUserDBDlg.ArrangeForm; +procedure TDeleteVaultDlg.ArrangeForm; begin frmWarning.Height := frmWarning.DocHeight; - TCtrlArranger.AlignLefts([frmWarning, lblConfirm, lblCollection], 0); - TCtrlArranger.AlignRights([frmWarning, cbCollection, edConfirm]); + TCtrlArranger.AlignLefts([frmWarning, lblConfirm, lblVaults], 0); + TCtrlArranger.AlignRights([frmWarning, cbVaults, edConfirm]); TCtrlArranger.AlignVCentres( TCtrlArranger.BottomOf(frmWarning, 12), - [lblCollection, cbCollection] + [lblVaults, cbVaults] ); TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf([lblCollection, cbCollection], 12), + TCtrlArranger.BottomOf([lblVaults, cbVaults], 12), [lblConfirm, edConfirm] ); pnlBody.ClientHeight := TCtrlArranger.TotalControlHeight(pnlBody) + 8; inherited; end; -procedure TDeleteUserDBDlg.btnOKClick(Sender: TObject); +procedure TDeleteVaultDlg.btnOKClick(Sender: TObject); resourcestring sBadPassword = 'Invalid confirmation text entered'; begin inherited; fPermissionGranted := IsValidPassword; - fCollection := SelectedCollection; + fVault := SelectedVault; if not fPermissionGranted then begin TMessageBox.Error(Self, sBadPassword); @@ -101,57 +101,57 @@ procedure TDeleteUserDBDlg.btnOKClick(Sender: TObject); end; end; -procedure TDeleteUserDBDlg.ConfigForm; +procedure TDeleteVaultDlg.ConfigForm; begin inherited; frmWarning.Initialise('dlg-dbdelete.html'); - fCollList.ToStrings(cbCollection.Items); - cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); + fVaultList.ToStrings(cbVaults.Items); + cbVaults.ItemIndex := fVaultList.IndexOfUID(TVaultID.Default); end; -class function TDeleteUserDBDlg.Execute(AOwner: TComponent; - out ACollection: TVault): Boolean; +class function TDeleteVaultDlg.Execute(AOwner: TComponent; out AVault: TVault): + Boolean; var - Dlg: TDeleteUserDBDlg; + Dlg: TDeleteVaultDlg; begin Dlg := InternalCreate(AOwner); try Dlg.ShowModal; Result := Dlg.fPermissionGranted; if Result then - ACollection := Dlg.fCollection; + AVault := Dlg.fVault; finally Dlg.Free; end; end; -procedure TDeleteUserDBDlg.FormCreate(Sender: TObject); +procedure TDeleteVaultDlg.FormCreate(Sender: TObject); begin inherited; - fCollList := TVaultListAdapter.Create; + fVaultList := TVaultListAdapter.Create; end; -procedure TDeleteUserDBDlg.FormDestroy(Sender: TObject); +procedure TDeleteVaultDlg.FormDestroy(Sender: TObject); begin - fCollList.Free; + fVaultList.Free; inherited; end; -constructor TDeleteUserDBDlg.InternalCreate(AOwner: TComponent); +constructor TDeleteVaultDlg.InternalCreate(AOwner: TComponent); begin Assert(Supports(Self, INoPublicConstruct), ClassName + '.InternalCreate: ' + 'Form''s protected constructor can''t be called'); inherited InternalCreate(AOwner); end; -function TDeleteUserDBDlg.IsValidPassword: Boolean; +function TDeleteVaultDlg.IsValidPassword: Boolean; begin Result := edConfirm.Text = cConfirmText; end; -function TDeleteUserDBDlg.SelectedCollection: TVault; +function TDeleteVaultDlg.SelectedVault: TVault; begin - Result := fCollList.Vault(cbCollection.ItemIndex); + Result := fVaultList.Vault(cbVaults.ItemIndex); end; end. diff --git a/Src/Res/HTML/dlg-dbdelete.html b/Src/Res/HTML/dlg-dbdelete.html index 4272c61ef..f8a32d30c 100644 --- a/Src/Res/HTML/dlg-dbdelete.html +++ b/Src/Res/HTML/dlg-dbdelete.html @@ -11,8 +11,8 @@ * * Copyright (C) 2022, Peter Johnson (gravatar.com/delphidabbler). * - * Warning information displayed in dialogue box used to confirm deletion on the - * user database. + * Warning information displayed in dialogue box used to confirm deletion of a + * selected vault. --> @@ -28,15 +28,15 @@

- This action cannot be undone. You will loose all the snippets in the collection. The collection itself will remain but will be empty. + This action cannot be undone. You will loose all the snippets in the chosen vault. The vault itself will remain but will be empty.

- Before going any further you are strongly advised to take a backup of the collection you are planning to delete. Use the Database | Backup Collection Data menu option to do this. + Before going any further you are strongly advised to take a backup of the vault you are planning to delete. Use the Database | Backup Vault menu option to do this.

- To proceed, first choose the collection you want to delete from the Choose collection drop down list. Then confirm the action by entering DELETE MY SNIPPETS (in capital letters) in the Confirm deletion edit box. + To proceed, first choose the vault you want to delete from the Choose vault drop down list. Then confirm the action by entering DELETE MY SNIPPETS (in capital letters) in the Confirm deletion edit box.

diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 9bc176edd..38304a044 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -325,7 +325,7 @@ class function TUserDBMgr.DeleteDatabase: Boolean; var CollectionToDelete: TVault; begin - if not TDeleteUserDBDlg.Execute(nil, CollectionToDelete) then + if not TDeleteVaultDlg.Execute(nil, CollectionToDelete) then Exit(False); if not TDirectory.Exists(CollectionToDelete.Storage.Directory) then Exit(False); From 639c570e104006c5686d5bd14d7a90b1cb139bb7 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 21:11:30 +0000 Subject: [PATCH 167/222] Rename & edit some Database menu items / actions Updated some actions & menu items on Database menu that relate to vaults. Actions had captions & hints updated as necessary to mention vaults. Both actions and menu items had names changed to include a reference to vaults --- Src/FmMain.dfm | 60 +++++++++++++++++++++++--------------------------- Src/FmMain.pas | 32 +++++++++++++-------------- 2 files changed, 43 insertions(+), 49 deletions(-) diff --git a/Src/FmMain.dfm b/Src/FmMain.dfm index 319c83542..5324e7086 100644 --- a/Src/FmMain.dfm +++ b/Src/FmMain.dfm @@ -613,29 +613,25 @@ inherited MainForm: TMainForm OnExecute = actPrintExecute OnUpdate = actPrintUpdate end - object actBackupDatabase: TAction + object actBackupVault: TAction Category = 'Database' - Caption = 'Backup Collection Data...' - Hint = 'Backup a collection|Backup a collection'#39's data files' + Caption = 'Backup Vault...' + Hint = 'Backup a vault|Backup a vault'#39's data files' ImageIndex = 33 - OnExecute = actBackupDatabaseExecute + OnExecute = actBackupVaultExecute OnUpdate = ActNonEmptyDBUpdate end - object actRestoreDatabase: TAction + object actRestoreVault: TAction Category = 'Database' - Caption = 'Restore Collection Data...' - Hint = - 'Restore a collection|Restore a collection'#39's data files from a ba' + - 'ckup' + Caption = 'Restore Vault...' + Hint = 'Restore a vault|Restore a vaults'#39's data files from a backup' ImageIndex = 32 - OnExecute = actRestoreDatabaseExecute + OnExecute = actRestoreVaultExecute end object actSaveDatabase: TAction Category = 'Database' - Caption = 'Save User Database' - Hint = - 'Save user database|Save all changes to the user-defined snippet ' + - 'database' + Caption = 'Save Database' + Hint = 'Save database|Save all vaults to the database' ImageIndex = 25 ShortCut = 16467 OnExecute = actSaveDatabaseExecute @@ -843,13 +839,11 @@ inherited MainForm: TMainForm OnExecute = actAddFavouriteExecute OnUpdate = actAddFavouriteUpdate end - object actMoveUserDatabase: TAction + object actMoveVault: TAction Category = 'Database' - Caption = 'Move Collection Data Files...' - Hint = - 'Move a collection|Move a collection'#39's data files to a new direct' + - 'ory' - OnExecute = actMoveUserDatabaseExecute + Caption = 'Move Vault Data Files...' + Hint = 'Move a vault|Move a vault'#39's data files to a new directory' + OnExecute = actMoveVaultExecute OnUpdate = ActNonEmptyDBUpdate end object actSWAGImport: TAction @@ -868,13 +862,13 @@ inherited MainForm: TMainForm ' default web browser' ImageIndex = 6 end - object actDeleteUserDatabase: TAction + object actDeleteVault: TAction Category = 'Database' - Caption = 'Delete All Snippets From Collection' + Caption = 'Delete All Snippets From Vault' Hint = - 'Delete All Snippets From A Collection|Deletes all the snippets f' + - 'rom a selected collection - USE WITH CAUTION' - OnExecute = actDeleteUserDatabaseExecute + 'Delete All Snippets From A Vault|Deletes all the snippets from a' + + ' chosen vault - USE WITH CAUTION' + OnExecute = actDeleteVaultExecute OnUpdate = ActNonEmptyDBUpdate end end @@ -1086,11 +1080,11 @@ inherited MainForm: TMainForm object miSpacer11: TMenuItem Caption = '-' end - object miBackupDatabase: TMenuItem - Action = actBackupDatabase + object miBackupVault: TMenuItem + Action = actBackupVault end - object miRestoreDatabase: TMenuItem - Action = actRestoreDatabase + object miRestoreVault: TMenuItem + Action = actRestoreVault end object miSpacer13: TMenuItem Caption = '-' @@ -1101,14 +1095,14 @@ inherited MainForm: TMainForm object miSpacer20: TMenuItem Caption = '-' end - object miMoveUserDatabase: TMenuItem - Action = actMoveUserDatabase + object miMoveVault: TMenuItem + Action = actMoveVault end object miSpacer21: TMenuItem Caption = '-' end - object miDeleteUserDatabase: TMenuItem - Action = actDeleteUserDatabase + object miDeleteVault: TMenuItem + Action = actDeleteVault end end object miCompile: TMenuItem diff --git a/Src/FmMain.pas b/Src/FmMain.pas index e7ddd3948..fd00d5be0 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -55,7 +55,7 @@ TMainForm = class(THelpAwareForm) actAddCategory: TAction; actAddFavourite: TAction; actAddSnippet: TAction; - actBackupDatabase: TAction; + actBackupVault: TAction; actBlog: TBrowseURL; actBugReport: TAction; actCloseAllDetailsTabs: TAction; @@ -70,7 +70,7 @@ TMainForm = class(THelpAwareForm) actCopySource: TAction; actDeleteCategory: TAction; actDeleteSnippet: TAction; - actDeleteUserDatabase: TAction; + actDeleteVault: TAction; actDuplicateSnippet: TAction; actEditSnippet: TAction; actExit: TFileExit; @@ -92,14 +92,14 @@ TMainForm = class(THelpAwareForm) actImportCode: TAction; actLicense: TAction; actLoadSelection: TAction; - actMoveUserDatabase: TAction; + actMoveVault: TAction; actNextTab: TAction; actNewDetailsTab: TAction; actPreferences: TAction; actPreviousTab: TAction; actPrint: TAction; actRenameCategory: TAction; - actRestoreDatabase: TAction; + actRestoreVault: TAction; actSaveDatabase: TAction; actSaveSelection: TAction; actSaveSnippet: TAction; @@ -126,7 +126,7 @@ TMainForm = class(THelpAwareForm) miAddCategory: TMenuItem; miAddFavourite: TMenuItem; miAddSnippet: TMenuItem; - miBackupDatabase: TMenuItem; + miBackupVault: TMenuItem; miBlog: TMenuItem; miCategories: TMenuItem; miCloseAllDetailsTabs: TMenuItem; @@ -141,7 +141,7 @@ TMainForm = class(THelpAwareForm) miDatabase: TMenuItem; miDeleteCategory: TMenuItem; miDeleteSnippet: TMenuItem; - miDeleteUserDatabase: TMenuItem; + miDeleteVault: TMenuItem; miDuplicateSnippet: TMenuItem; miEdit: TMenuItem; miEditSnippet: TMenuItem; @@ -166,13 +166,13 @@ TMainForm = class(THelpAwareForm) miImportCode: TMenuItem; miLicense: TMenuItem; miLoadSelection: TMenuItem; - miMoveUserDatabase: TMenuItem; + miMoveVault: TMenuItem; miNewDetailsTab: TMenuItem; miPreferences: TMenuItem; miPrint: TMenuItem; miRenameCategory: TMenuItem; miReportBug: TMenuItem; - miRestoreDatabase: TMenuItem; + miRestoreVault: TMenuItem; miSaveDatabase: TMenuItem; miSaveSelection: TMenuItem; miSaveSnippet: TMenuItem; @@ -254,7 +254,7 @@ TMainForm = class(THelpAwareForm) /// database.

 procedure actAddSnippetExecute(Sender: TObject); /// Makes a backup of the user database. - procedure actBackupDatabaseExecute(Sender: TObject); + procedure actBackupVaultExecute(Sender: TObject); /// Displays Bug Report dialogue box. procedure actBugReportExecute(Sender: TObject); /// Closes all open tabs in details pane. @@ -299,7 +299,7 @@ TMainForm = class(THelpAwareForm) procedure actDeleteSnippetExecute(Sender: TObject); /// Requests permission then attempts to delete the user defined /// snippets database. - procedure actDeleteUserDatabaseExecute(Sender: TObject); + procedure actDeleteVaultExecute(Sender: TObject); /// Displays a dialogue box that can be used to duplicate the /// selected snippet. procedure actDuplicateSnippetExecute(Sender: TObject); @@ -359,7 +359,7 @@ TMainForm = class(THelpAwareForm) /// Displays a dialogue box that can be used to move the user /// database to a user defined directory. /// This action must be hidden in the portable edition. - procedure actMoveUserDatabaseExecute(Sender: TObject); + procedure actMoveVaultExecute(Sender: TObject); /// Creates a new empty tab in details pane. procedure actNewDetailsTabExecute(Sender: TObject); /// Displays next tab in either overview or details pane depending @@ -395,7 +395,7 @@ TMainForm = class(THelpAwareForm) procedure actRenameCategoryUpdate(Sender: TObject); /// Displays a dialogue box from which a backup file can be /// selected and used to restore the user defined database. - procedure actRestoreDatabaseExecute(Sender: TObject); + procedure actRestoreVaultExecute(Sender: TObject); /// Save any changes in the user defined database to disk. /// procedure actSaveDatabaseExecute(Sender: TObject); @@ -655,7 +655,7 @@ procedure TMainForm.actAddSnippetExecute(Sender: TObject); TUserDBMgr.AddSnippet; end; -procedure TMainForm.actBackupDatabaseExecute(Sender: TObject); +procedure TMainForm.actBackupVaultExecute(Sender: TObject); begin if (Database as IDatabaseEdit).Updated then TUserDBMgr.Save(Self); @@ -758,7 +758,7 @@ procedure TMainForm.actDeleteSnippetExecute(Sender: TObject); // display update is handled by snippets change event handler end; -procedure TMainForm.actDeleteUserDatabaseExecute(Sender: TObject); +procedure TMainForm.actDeleteVaultExecute(Sender: TObject); begin if (Database as IDatabaseEdit).Updated then TUserDBMgr.Save(Self); @@ -945,7 +945,7 @@ procedure TMainForm.actLoadSelectionExecute(Sender: TObject); DoSearchFilter(Search); end; -procedure TMainForm.actMoveUserDatabaseExecute(Sender: TObject); +procedure TMainForm.actMoveVaultExecute(Sender: TObject); begin if (Database as IDatabaseEdit).Updated then TUserDBMgr.Save(Self); @@ -1023,7 +1023,7 @@ procedure TMainForm.actRenameCategoryUpdate(Sender: TObject); (Sender as TAction).Enabled := TUserDBMgr.CanRenameACategory; end; -procedure TMainForm.actRestoreDatabaseExecute(Sender: TObject); +procedure TMainForm.actRestoreVaultExecute(Sender: TObject); begin if TUserDBMgr.RestoreDatabase(Self) then begin From f1deb83079ca201881e45509b3d0feae971a5c53 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Mon, 3 Mar 2025 21:22:22 +0000 Subject: [PATCH 168/222] Rename FmDeleteUserDBDlg unit The unit source code and form files were renamed to UI.Forms.DeleteVaultDlg.pas/.dfm Calling code received minimal changes re the change of unit name. --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/{FmDeleteUserDBDlg.dfm => UI.Forms.DeleteVaultDlg.dfm} | 0 Src/{FmDeleteUserDBDlg.pas => UI.Forms.DeleteVaultDlg.pas} | 2 +- Src/UUserDBMgr.pas | 2 +- 5 files changed, 4 insertions(+), 4 deletions(-) rename Src/{FmDeleteUserDBDlg.dfm => UI.Forms.DeleteVaultDlg.dfm} (100%) rename Src/{FmDeleteUserDBDlg.pas => UI.Forms.DeleteVaultDlg.pas} (99%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index f24a3fd64..61cdc228a 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -367,7 +367,7 @@ uses UXMLDocConsts in 'UXMLDocConsts.pas', UXMLDocHelper in 'UXMLDocHelper.pas', UXMLDocumentEx in 'UXMLDocumentEx.pas', - FmDeleteUserDBDlg in 'FmDeleteUserDBDlg.pas' {DeleteVaultDlg}, + UI.Forms.DeleteVaultDlg in 'UI.Forms.DeleteVaultDlg.pas' {DeleteVaultDlg}, Compilers.UAutoDetect in 'Compilers.UAutoDetect.pas', Compilers.USettings in 'Compilers.USettings.pas', FmRegisterCompilersDlg in 'FmRegisterCompilersDlg.pas' {RegisterCompilersDlg}, diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 82ea61515..cbed79aff 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -569,7 +569,7 @@ - +
DeleteVaultDlg
 diff --git a/Src/FmDeleteUserDBDlg.dfm b/Src/UI.Forms.DeleteVaultDlg.dfm similarity index 100% rename from Src/FmDeleteUserDBDlg.dfm rename to Src/UI.Forms.DeleteVaultDlg.dfm diff --git a/Src/FmDeleteUserDBDlg.pas b/Src/UI.Forms.DeleteVaultDlg.pas similarity index 99% rename from Src/FmDeleteUserDBDlg.pas rename to Src/UI.Forms.DeleteVaultDlg.pas index 7bcd2cdf5..5533d7b6c 100644 --- a/Src/FmDeleteUserDBDlg.pas +++ b/Src/UI.Forms.DeleteVaultDlg.pas @@ -10,7 +10,7 @@ } -unit FmDeleteUserDBDlg; +unit UI.Forms.DeleteVaultDlg; interface diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 38304a044..c4c2193da 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -102,7 +102,7 @@ implementation FmAddCategoryDlg, UI.Forms.BackupVaultDlg, FmDeleteCategoryDlg, - FmDeleteUserDBDlg, + UI.Forms.DeleteVaultDlg, FmDuplicateSnippetDlg, FmRenameCategoryDlg, FmSnippetsEditorDlg, From fcba24bf92c7edbdcfe0dd5c8a1f606344c067d8 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 08:53:56 +0000 Subject: [PATCH 169/222] Renaming in FmUserDataPathDlg unit Form name & class, controls and identifiers that referred to collections were changed to refer to vaults. Minimal changes were made to calling code in UUserDBMgr unit re the renamed form class in FmUserDataPathDlg. Updated comments in line with renaming. --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/FmUserDataPathDlg.dfm | 30 ++++++------- Src/FmUserDataPathDlg.pas | 92 +++++++++++++++++++-------------------- Src/UUserDBMgr.pas | 4 +- 5 files changed, 64 insertions(+), 66 deletions(-) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 61cdc228a..22dd026ad 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -130,7 +130,7 @@ uses FmTestCompileDlg in 'FmTestCompileDlg.pas' {TestCompileDlg}, FmTrappedBugReportDlg in 'FmTrappedBugReportDlg.pas' {TrappedBugReportDlg}, FmUserBugReportDlg in 'FmUserBugReportDlg.pas' {UserBugReportDlg}, - FmUserDataPathDlg in 'FmUserDataPathDlg.pas' {UserDataPathDlg}, + FmUserDataPathDlg in 'FmUserDataPathDlg.pas' {MoveVaultDlg}, FrProgress in 'FrProgress.pas' {ProgressFrame: TFrame}, FmUserHiliterMgrDlg in 'FmUserHiliterMgrDlg.pas' {UserHiliterMgrDlg}, FmWaitDlg in 'FmWaitDlg.pas' {WaitDlg}, diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index cbed79aff..0dd081f93 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -238,7 +238,7 @@
UserBugReportDlg
 -
UserDataPathDlg
+
MoveVaultDlg
ProgressFrame
diff --git a/Src/FmUserDataPathDlg.dfm b/Src/FmUserDataPathDlg.dfm index 450a69321..0fe753ee0 100644 --- a/Src/FmUserDataPathDlg.dfm +++ b/Src/FmUserDataPathDlg.dfm @@ -1,5 +1,5 @@ -inherited UserDataPathDlg: TUserDataPathDlg - Caption = 'Move Collection Data' +inherited MoveVaultDlg: TMoveVaultDlg + Caption = 'Move Vault' ExplicitWidth = 474 ExplicitHeight = 375 PixelsPerInch = 96 @@ -16,9 +16,9 @@ inherited UserDataPathDlg: TUserDataPathDlg Height = 25 AutoSize = False Caption = - 'Use this dialogue box to move a collection'#39's data to a new direc' + - 'tory.'#13#10'Choose the collection whose data you wish to move then en' + - 'ter the directory you wish to move the data to.' + 'Use this dialogue box to move a vault to a new directory.'#13#10'Choos' + + 'e the vault you wish to move then enter the directory you wish t' + + 'o move it to.' WordWrap = True end object lblWarning: TLabel @@ -28,8 +28,8 @@ inherited UserDataPathDlg: TUserDataPathDlg Height = 34 AutoSize = False Caption = - 'You are strongly advised to make a backup of the collection befo' + - 're continuing.' + 'You are strongly advised to make a backup of the vault before co' + + 'ntinuing.' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 @@ -60,8 +60,8 @@ inherited UserDataPathDlg: TUserDataPathDlg AutoSize = False Caption = 'The directory must be empty and must not be a sub-directory of t' + - 'he current collection'#39's data directory. If the directory does no' + - 't exist a new one will be created.' + 'he current vault'#39's data directory. If the directory does not exi' + + 'st a new one will be created.' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 @@ -70,13 +70,13 @@ inherited UserDataPathDlg: TUserDataPathDlg ParentFont = False WordWrap = True end - object lblCollection: TLabel + object lblVaults: TLabel Left = 0 Top = 71 - Width = 122 + Width = 102 Height = 13 - Caption = 'Select &collection to move:' - FocusControl = cbCollection + Caption = 'Select &vault to move:' + FocusControl = cbVaults end inline frmProgress: TProgressFrame Left = 57 @@ -90,8 +90,6 @@ inherited UserDataPathDlg: TUserDataPathDlg ExplicitHeight = 82 inherited pnlBody: TPanel Height = 82 - ExplicitLeft = 55 - ExplicitTop = 72 ExplicitHeight = 82 end end @@ -136,7 +134,7 @@ inherited UserDataPathDlg: TUserDataPathDlg ParentFont = False TabOrder = 2 end - object cbCollection: TComboBox + object cbVaults: TComboBox Left = 0 Top = 88 Width = 358 diff --git a/Src/FmUserDataPathDlg.pas b/Src/FmUserDataPathDlg.pas index d31951c34..1c1828a89 100644 --- a/Src/FmUserDataPathDlg.pas +++ b/Src/FmUserDataPathDlg.pas @@ -5,8 +5,8 @@ * * Copyright (C) 2013-2023, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a dialogue box that can be used to move collection data to a - * different directory. + * Implements a dialogue box that can be used to move vaults to a different + * directory. } @@ -34,12 +34,12 @@ interface UUserDBMove; type - /// Dialogue box that is used to move the collection data to a new - /// directory. + /// Dialogue box that is used to move vault data to a new directory. + /// /// IMPORTANT: This dialogue box is for use only with the standard /// edition of CodeSnip. It MUST NOT be displayed from the portable edition. /// - TUserDataPathDlg = class(TGenericViewDlg, INoPublicConstruct) + TMoveVaultDlg = class(TGenericViewDlg, INoPublicConstruct) actBrowse: TAction; actMove: TAction; alDlg: TActionList; @@ -51,15 +51,15 @@ TUserDataPathDlg = class(TGenericViewDlg, INoPublicConstruct) btnMove: TButton; edPath: TEdit; btnBrowse: TButton; - lblCollection: TLabel; - cbCollection: TComboBox; + lblVaults: TLabel; + cbVaults: TComboBox; /// Dispays Browse For Folder dialogue box and copies any chosen /// folder to the edPath edit control. procedure actBrowseExecute(Sender: TObject); - /// Moves the chosen collection to the path entered by the user - /// and records the changed path. + /// Moves the chosen vault to the path entered by the user and + /// records the changed path. /// Raises exception if the given path can't be used for any - /// reason or if there was an error copying the collection. + /// reason or if there was an error copying the vault. procedure actMoveExecute(Sender: TObject); /// Enables / disables Move action according to whether a suitable /// path has been entered by user. @@ -70,15 +70,15 @@ TUserDataPathDlg = class(TGenericViewDlg, INoPublicConstruct) procedure FormDestroy(Sender: TObject); strict private var - /// Object that moves a collection's data to a new location. + /// Object that moves a vault's data to a new location. /// fMover: TUserDBMove; /// Object used to disable and enable all controls on the form. /// fControlStateMgr: TControlStateMgr; /// Object used to provide and interogate a sorted list of - /// collection names displated in cbCollection. - fCollList: TVaultListAdapter; + /// vault names displayed in cbVault. + fVaultList: TVaultListAdapter; /// Sets visibility of all child controls of a parent control. /// /// TWinControl [in] Parent of affected controls. @@ -86,16 +86,16 @@ TUserDataPathDlg = class(TGenericViewDlg, INoPublicConstruct) /// Boolean [in] Flag indicating required visibility. /// Pass True to show the controls and False to hide them. procedure SetVisibility(const ParentCtrl: TWinControl; const Show: Boolean); - /// Move the chosen collection data to the directory given by + /// Move the chosen vault data to the directory given by /// NewDir, displaying a progress base located over the given host /// window. /// The new directory is checked to be empty and the user is asked /// for confirmation. procedure DoMove(const NewDir: string; const ProgressHostCtrl: TWinControl); - /// Handles the collection data mover object's OnCopyFile - /// event by updating the progress frame. + /// Handles the vault data mover object's OnCopyFile event + /// by updating the progress frame. procedure CopyFileHandler(Sender: TObject; const Percent: Byte); - /// Handles the collectio data mover object's OnDeleteFile + /// Handles the vault data mover object's OnDeleteFile /// event by updating the progress frame. procedure DeleteFileHandler(Sender: TObject; const Percent: Byte); /// Gets the directory entered in the edPath edit control. @@ -108,7 +108,7 @@ TUserDataPathDlg = class(TGenericViewDlg, INoPublicConstruct) /// exceptions unchanged. /// Always raises a new exception. /// This method is designed to handle exceptions raised when the - /// collection data is moved. + /// vault data is moved. procedure HandleException(const E: Exception); strict protected /// Initialises the form's controls and associated objects. @@ -147,11 +147,11 @@ implementation { TUserDataPathDlg } -procedure TUserDataPathDlg.actBrowseExecute(Sender: TObject); +procedure TMoveVaultDlg.actBrowseExecute(Sender: TObject); var Dlg: TBrowseForFolderDlg; // browse for folder standard dialogue box resourcestring - sDlgTitle = 'Choose Collection Data Directory'; + sDlgTitle = 'Choose Vault Data Directory'; sDlgHeading = 'Choose an empty directory or create a new one'; begin Dlg := TBrowseForFolderDlg.Create(nil); @@ -166,22 +166,22 @@ procedure TUserDataPathDlg.actBrowseExecute(Sender: TObject); end; end; -procedure TUserDataPathDlg.actMoveExecute(Sender: TObject); +procedure TMoveVaultDlg.actMoveExecute(Sender: TObject); begin DoMove(NewDirFromEditCtrl, Self); end; -procedure TUserDataPathDlg.actMoveUpdate(Sender: TObject); +procedure TMoveVaultDlg.actMoveUpdate(Sender: TObject); begin actMove.Enabled := (NewDirFromEditCtrl <> '') and not StrSameText( NewDirFromEditCtrl, - fCollList.Vault(cbCollection.ItemIndex).Storage.Directory + fVaultList.Vault(cbVaults.ItemIndex).Storage.Directory ) and Self.Enabled; end; -procedure TUserDataPathDlg.ArrangeForm; +procedure TMoveVaultDlg.ArrangeForm; begin TCtrlArranger.SetLabelHeights(Self); @@ -189,7 +189,7 @@ procedure TUserDataPathDlg.ArrangeForm; TCtrlArranger.AlignLefts( [ - lblInstructions, lblWarning, lblCollection, cbCollection, lblPath, edPath, + lblInstructions, lblWarning, lblVaults, cbVaults, lblPath, edPath, lblExplainMove ], 0 @@ -201,12 +201,12 @@ procedure TUserDataPathDlg.ArrangeForm; TCtrlArranger.MoveBelow(lblInstructions, lblWarning, 8); lblWarning.Width := pnlBody.ClientWidth; // Row 3 - TCtrlArranger.MoveBelow(lblWarning, lblCollection, 12); + TCtrlArranger.MoveBelow(lblWarning, lblVaults, 12); // Row 4 - TCtrlArranger.MoveBelow(lblCollection, cbCollection, 6); - cbCollection.Width := pnlBody.ClientWidth; + TCtrlArranger.MoveBelow(lblVaults, cbVaults, 6); + cbVaults.Width := pnlBody.ClientWidth; // Row 5 - TCtrlArranger.MoveBelow(cbCollection, lblPath, 12); + TCtrlArranger.MoveBelow(cbVaults, lblPath, 12); // Row 6 TCtrlArranger.AlignRights([btnBrowse], pnlBody.ClientWidth); edPath.Width := btnBrowse.Left - 6 - edPath.Left; @@ -225,7 +225,7 @@ procedure TUserDataPathDlg.ArrangeForm; inherited; end; -procedure TUserDataPathDlg.ConfigForm; +procedure TMoveVaultDlg.ConfigForm; begin inherited; TFontHelper.SetDefaultBaseFonts([lblWarning.Font]); @@ -235,11 +235,11 @@ procedure TUserDataPathDlg.ConfigForm; ]); frmProgress.Visible := False; frmProgress.Range := TRange.Create(0, 100); - fCollList.ToStrings(cbCollection.Items); - cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); + fVaultList.ToStrings(cbVaults.Items); + cbVaults.ItemIndex := fVaultList.IndexOfUID(TVaultID.Default); end; -procedure TUserDataPathDlg.CopyFileHandler(Sender: TObject; +procedure TMoveVaultDlg.CopyFileHandler(Sender: TObject; const Percent: Byte); resourcestring sCopying = 'Copying files...'; @@ -250,7 +250,7 @@ procedure TUserDataPathDlg.CopyFileHandler(Sender: TObject; Application.ProcessMessages; end; -procedure TUserDataPathDlg.DeleteFileHandler(Sender: TObject; +procedure TMoveVaultDlg.DeleteFileHandler(Sender: TObject; const Percent: Byte); resourcestring sDeleting = 'Deleting files...'; @@ -261,11 +261,11 @@ procedure TUserDataPathDlg.DeleteFileHandler(Sender: TObject; Application.ProcessMessages; end; -procedure TUserDataPathDlg.DoMove(const NewDir: string; +procedure TMoveVaultDlg.DoMove(const NewDir: string; const ProgressHostCtrl: TWinControl); resourcestring sNonEmptyDir = 'The specified directory is not empty.'; - sConfirmMsg = 'Are you sure you want to move the collection data?'; + sConfirmMsg = 'Are you sure you want to move the vault data?'; begin if TDirectory.Exists(NewDir) and not TDirectory.IsEmpty(NewDir) then @@ -279,7 +279,7 @@ procedure TUserDataPathDlg.DoMove(const NewDir: string; frmProgress.Show(ProgressHostCtrl); try fMover.MoveTo( - fCollList.Vault(cbCollection.ItemIndex), NewDir + fVaultList.Vault(cbVaults.ItemIndex), NewDir ); except on E: Exception do @@ -293,10 +293,10 @@ procedure TUserDataPathDlg.DoMove(const NewDir: string; end; end; -class procedure TUserDataPathDlg.Execute(AOwner: TComponent); +class procedure TMoveVaultDlg.Execute(AOwner: TComponent); {$IFNDEF PORTABLE} var - Dlg: TUserDataPathDlg; + Dlg: TMoveVaultDlg; {$ENDIF} begin {$IFDEF PORTABLE} @@ -312,25 +312,25 @@ class procedure TUserDataPathDlg.Execute(AOwner: TComponent); {$ENDIF} end; -procedure TUserDataPathDlg.FormCreate(Sender: TObject); +procedure TMoveVaultDlg.FormCreate(Sender: TObject); begin inherited; fMover := TUserDBMove.Create; fMover.OnCopyFile := CopyFileHandler; fMover.OnDeleteFile := DeleteFileHandler; fControlStateMgr := TControlStateMgr.Create(Self); - fCollList := TVaultListAdapter.Create; + fVaultList := TVaultListAdapter.Create; end; -procedure TUserDataPathDlg.FormDestroy(Sender: TObject); +procedure TMoveVaultDlg.FormDestroy(Sender: TObject); begin - fCollList.Free; + fVaultList.Free; fControlStateMgr.Free; fMover.Free; inherited; end; -procedure TUserDataPathDlg.HandleException(const E: Exception); +procedure TMoveVaultDlg.HandleException(const E: Exception); begin if (E is EInOutError) or (E is ENotSupportedException) or (E is EDirectoryNotFoundException) or (E is EPathTooLongException) @@ -339,12 +339,12 @@ procedure TUserDataPathDlg.HandleException(const E: Exception); raise E; end; -function TUserDataPathDlg.NewDirFromEditCtrl: string; +function TMoveVaultDlg.NewDirFromEditCtrl: string; begin Result := ExcludeTrailingPathDelimiter(StrTrim(edPath.Text)); end; -procedure TUserDataPathDlg.SetVisibility(const ParentCtrl: TWinControl; +procedure TMoveVaultDlg.SetVisibility(const ParentCtrl: TWinControl; const Show: Boolean); var I: Integer; diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index c4c2193da..98ea448f1 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -15,7 +15,7 @@ interface {TODO -cRefactoring: Rename this unit/classes/methods: the names refer to the - CodeSnip 4 database structure but the code now works with collections} + CodeSnip 4 database structure but the code now works with vaults} uses // Delphi @@ -418,7 +418,7 @@ class procedure TUserDBMgr.MoveDatabase; begin // This dialogue box not available in portable edition {$IFNDEF PORTABLE} - TUserDataPathDlg.Execute(nil); + TMoveVaultDlg.Execute(nil); {$ENDIF} end; From f330e1fedfe120ba9ae551808a5b7462abc2a443 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 09:28:06 +0000 Subject: [PATCH 170/222] Rename FmUserDataPathDlg unit The unit source code and form files were renamed to UI.Forms.MoveVaultDlg.pas/.dfm Calling code received minimal changes re the change of unit name. --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/{FmUserDataPathDlg.dfm => UI.Forms.MoveVaultDlg.dfm} | 0 Src/{FmUserDataPathDlg.pas => UI.Forms.MoveVaultDlg.pas} | 2 +- Src/UUserDBMgr.pas | 2 +- 5 files changed, 4 insertions(+), 4 deletions(-) rename Src/{FmUserDataPathDlg.dfm => UI.Forms.MoveVaultDlg.dfm} (100%) rename Src/{FmUserDataPathDlg.pas => UI.Forms.MoveVaultDlg.pas} (99%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 22dd026ad..3709dfa76 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -130,7 +130,7 @@ uses FmTestCompileDlg in 'FmTestCompileDlg.pas' {TestCompileDlg}, FmTrappedBugReportDlg in 'FmTrappedBugReportDlg.pas' {TrappedBugReportDlg}, FmUserBugReportDlg in 'FmUserBugReportDlg.pas' {UserBugReportDlg}, - FmUserDataPathDlg in 'FmUserDataPathDlg.pas' {MoveVaultDlg}, + UI.Forms.MoveVaultDlg in 'UI.Forms.MoveVaultDlg.pas' {MoveVaultDlg}, FrProgress in 'FrProgress.pas' {ProgressFrame: TFrame}, FmUserHiliterMgrDlg in 'FmUserHiliterMgrDlg.pas' {UserHiliterMgrDlg}, FmWaitDlg in 'FmWaitDlg.pas' {WaitDlg}, diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 0dd081f93..ba13e631e 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -237,7 +237,7 @@
UserBugReportDlg
 - +
MoveVaultDlg
 diff --git a/Src/FmUserDataPathDlg.dfm b/Src/UI.Forms.MoveVaultDlg.dfm similarity index 100% rename from Src/FmUserDataPathDlg.dfm rename to Src/UI.Forms.MoveVaultDlg.dfm diff --git a/Src/FmUserDataPathDlg.pas b/Src/UI.Forms.MoveVaultDlg.pas similarity index 99% rename from Src/FmUserDataPathDlg.pas rename to Src/UI.Forms.MoveVaultDlg.pas index 1c1828a89..b3a717361 100644 --- a/Src/FmUserDataPathDlg.pas +++ b/Src/UI.Forms.MoveVaultDlg.pas @@ -10,7 +10,7 @@ } -unit FmUserDataPathDlg; +unit UI.Forms.MoveVaultDlg; interface diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 98ea448f1..7fc29a5c8 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -107,7 +107,7 @@ implementation FmRenameCategoryDlg, FmSnippetsEditorDlg, {$IFNDEF PORTABLE} - FmUserDataPathDlg, + UI.Forms.MoveVaultDlg, {$ENDIF} FmWaitDlg, UAppInfo, From afa3b55e4be6b25d80c769f361eecfba419d9919 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 09:53:42 +0000 Subject: [PATCH 171/222] Renaming in UAppInfo unit Renamed TAppInfo.UserCollectionsDir to UserVaultsDir and TAppInfo.UserDefaultCollectionDir to UserDefaultVaultDir. Made minimal changes to calling code. Updated comments re change from collections to vaults. --- Src/DB.Vaults.pas | 2 +- Src/UAppInfo.pas | 37 ++++++++++++++++++------------------- 2 files changed, 19 insertions(+), 20 deletions(-) diff --git a/Src/DB.Vaults.pas b/Src/DB.Vaults.pas index 44654bd98..7c58dd145 100644 --- a/Src/DB.Vaults.pas +++ b/Src/DB.Vaults.pas @@ -345,7 +345,7 @@ procedure TVaults.Initialize; 'Default', TDataStorageDetails.Create( TDataFormatInfo.DefaultFormat, - TAppInfo.UserDefaultCollectionDir + TAppInfo.UserDefaultVaultDir ) ) ); diff --git a/Src/UAppInfo.pas b/Src/UAppInfo.pas index a8559f650..9993d7941 100644 --- a/Src/UAppInfo.pas +++ b/Src/UAppInfo.pas @@ -53,30 +53,29 @@ TAppInfo = class(TNoConstructObject) @return Full path to common application data directory. } class function AppDataDir: string; - {TODO -cCollections: Remove AppDataDir method: used for "main" database} + {TODO -cVault: Remove AppDataDir method: used for "main" database} {Returns the directory where CodeSnip stores the "database" files. @return Full path to database sub directory. } - /// Returns the path where collections are recommended to be - /// stored for the current user. + /// Returns the path where vaults are recommended to be stored for + /// the current user. /// - /// Collections each have their own sub-directory of this directory. + /// Vaults each have their own sub-directory of this directory. /// - /// The user may ignore this recommendation and install collections + /// The user may ignore this recommendation and install vaults /// anywhere they choose. /// - class function UserCollectionsDir: string; + class function UserVaultsDir: string; - /// Returns the path where the Default collection is recommended - /// to be stored for the current user. + /// Returns the path where the Default vault is recommended to be + /// stored for the current user. /// - /// If the Default collection is not present then CodeSnip will + /// If the Default vault is not present then CodeSnip will /// automatically create it in this directory. - /// The user may move the Default collection anywhere they choose. - /// + /// The user may move the Default vault anywhere they choose. /// - class function UserDefaultCollectionDir: string; + class function UserDefaultVaultDir: string; class function AppExeFilePath: string; {Returns fully specified name of program's executable file. @@ -253,19 +252,14 @@ class function TAppInfo.UserCategoriesFileName: string; Result := UserAppDir + '\Categories'; end; -class function TAppInfo.UserCollectionsDir: string; -begin - Result := UserAppDir + '\Collections'; -end; - class function TAppInfo.UserConfigFileName: string; begin Result := UserAppDir + '\User.config'; end; -class function TAppInfo.UserDefaultCollectionDir: string; +class function TAppInfo.UserDefaultVaultDir: string; begin - Result := UserCollectionsDir + '\Default'; + Result := UserVaultsDir + '\Default'; end; class function TAppInfo.UserFavouritesFileName: string; @@ -273,5 +267,10 @@ class function TAppInfo.UserFavouritesFileName: string; Result := UserAppDir + '\Favourites'; end; +class function TAppInfo.UserVaultsDir: string; +begin + Result := UserAppDir + '\Vaults'; +end; + end. From b72e7dba6919eb3aeff24ee8cb2e72704404add9 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 10:07:56 +0000 Subject: [PATCH 172/222] Renaming method parameter names in external object Renamed CollectionIDAsHex parameters to VaultIDAsHex for relevant methods defined in ExternalObj.ridl and the associated UWBExternal unit. Changed equivalent JavaScript method parameters from external.js from collectionId to vaultId. Comments were also updated re the change from collections to vaults. --- Src/ExternalObj.ridl | 12 +++++------- Src/Res/Scripts/external.js | 15 ++++++++------- Src/UWBExternal.pas | 33 +++++++++++++-------------------- 3 files changed, 26 insertions(+), 34 deletions(-) diff --git a/Src/ExternalObj.ridl b/Src/ExternalObj.ridl index b4f29f734..5c1572b87 100644 --- a/Src/ExternalObj.ridl +++ b/Src/ExternalObj.ridl @@ -40,14 +40,13 @@ library ExternalObj { /* - * Display snippet identified by key and collection ID. + * Display snippet identified by key and vault ID. * @param Key [in] Snippet's key. - * @param CollectionIDAsHex [in] Hex representation of snippet's - * collection ID. + * @param VaultIDAsHex [in] Hex representation of snippet's vault ID. */ [id(0x00000080)] HRESULT _stdcall DisplaySnippet([in] BSTR Key, - [in] BSTR CollectionIDAsHex, [in] VARIANT_BOOL NewTab); + [in] BSTR VaultIDAsHex, [in] VARIANT_BOOL NewTab); /* * Displays configure compilers dialog box. @@ -58,11 +57,10 @@ library ExternalObj /* * Edits the snippet identified by its key. * @param Key [in] Key of snippet to edit. Must be user defined. - * @param CollectionIDAsHex [in] Hex representation of snippet's - * collection ID. + * @param VaultIDAsHex [in] Hex representation of snippet's vault ID. */ [id(0x0000006C)] - HRESULT _stdcall EditSnippet([in] BSTR Key, [in] BSTR CollectionIDAsHex); + HRESULT _stdcall EditSnippet([in] BSTR Key, [in] BSTR VaultIDAsHex); /* * Display identified category. diff --git a/Src/Res/Scripts/external.js b/Src/Res/Scripts/external.js index 09a050cf6..8c79d9bb6 100644 --- a/Src/Res/Scripts/external.js +++ b/Src/Res/Scripts/external.js @@ -24,13 +24,13 @@ function configCompilers() { /* * Calls external object to get host application to display a named snippet. * @param string snippet [in] Key of snippet to be displayed. - * @param string collectionId [in] Hex string representation of collection - * to which the snippet belongs. + * @param string vaultId [in] Hex string representation of the vault to which + * the snippet belongs. * @return False. */ -function displaySnippet(snippet, collectionId) { +function displaySnippet(snippet, vaultId) { var e = window.event; - external.DisplaySnippet(snippet, collectionId, e.ctrlKey); + external.DisplaySnippet(snippet, vaultId, e.ctrlKey); return false; } @@ -49,11 +49,12 @@ function displayCategory(catid) { * Calls external object to get host application to edit a named snippet. * @param string snippet [in] Key of snippet to be edited. Must be user * defined. - * @param string collectionId [in] Hex string representation of collection + * @param string vaultId [in] Hex string representation of the vault to which + * the snippet belongs. * @return False. */ -function editSnippet(snippet, collectionId) { - external.EditSnippet(snippet, collectionId); +function editSnippet(snippet, vaultId) { + external.EditSnippet(snippet, vaultId); return false; } diff --git a/Src/UWBExternal.pas b/Src/UWBExternal.pas index 8753749c7..735fb75a9 100644 --- a/Src/UWBExternal.pas +++ b/Src/UWBExternal.pas @@ -53,31 +53,28 @@ TWBExternal = class(TAutoIntfObject, IWBExternal15, ISetNotifier) /// library. constructor Create; - /// Display snippet identified by key and collection ID. + /// Display snippet identified by key and vault ID. /// WideString [in] Snippet's key. - /// WideString [in] Hex representation of - /// snippet's collection ID. + /// WideString [in] Hex representation of + /// snippet's vault ID. /// WordBool [in] Whether to display snippet in a new /// tab. /// Method of IWBExternal15. procedure DisplaySnippet(const Key: WideString; - const CollectionIDAsHex: WideString; NewTab: WordBool); safecall; + const VaultIDAsHex: WideString; NewTab: WordBool); safecall; /// Displays the Configure Compilers dialogue box. /// Method of IWBExternal15. procedure ConfigCompilers; safecall; - /// Edits the snippet identified by its key and collection ID. + /// Edits the snippet identified by its key and vault ID. /// /// WideString [in] Snippet's key. - /// WideString [in] Hex representation of - /// snippet's collection ID. - /// - /// The snippet must be user defined. - /// Method of IWBExternal15. - /// + /// WideString [in] Hex representation of + /// snippet's vault ID. + /// Method of IWBExternal15. procedure EditSnippet(const Key: WideString; - const CollectionIDAsHex: WideString); safecall; + const VaultIDAsHex: WideString); safecall; /// Displays a named category. /// WideString [in] ID of category to be displayed. @@ -151,13 +148,13 @@ procedure TWBExternal.DisplayCategory(const CatID: WideString; end; end; -procedure TWBExternal.DisplaySnippet(const Key, CollectionIDAsHex: WideString; +procedure TWBExternal.DisplaySnippet(const Key, VaultIDAsHex: WideString; NewTab: WordBool); begin try if Assigned(fNotifier) then fNotifier.DisplaySnippet( - Key, TVaultID.CreateFromHexString(CollectionIDAsHex), NewTab + Key, TVaultID.CreateFromHexString(VaultIDAsHex), NewTab ); except HandleException; @@ -165,15 +162,11 @@ procedure TWBExternal.DisplaySnippet(const Key, CollectionIDAsHex: WideString; end; procedure TWBExternal.EditSnippet(const Key: WideString; - const CollectionIDAsHex: WideString); - {TODO -cVault: change to take a collection ID as hex string as 2nd param & - lift restriction on having to be user defined.} + const VaultIDAsHex: WideString); begin try if Assigned(fNotifier) then - fNotifier.EditSnippet( - Key, TVaultID.CreateFromHexString(CollectionIDAsHex) - ); + fNotifier.EditSnippet(Key, TVaultID.CreateFromHexString(VaultIDAsHex)); except HandleException; end; From 0a1875f767e9ceb39d63b8a9a38a93e1dc71d67a Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 10:11:43 +0000 Subject: [PATCH 173/222] Renaming in UUserDBMove unit The TUserDBMove class was renamed as TVaultMover. Identifiers referring to collections were changed to refer to vaults. Comments were changed similarly. Calling code was updated to use the new class name. --- Src/UI.Forms.MoveVaultDlg.pas | 4 +- Src/UUserDBMove.pas | 77 ++++++++++++++++------------------- 2 files changed, 38 insertions(+), 43 deletions(-) diff --git a/Src/UI.Forms.MoveVaultDlg.pas b/Src/UI.Forms.MoveVaultDlg.pas index b3a717361..dc14efe21 100644 --- a/Src/UI.Forms.MoveVaultDlg.pas +++ b/Src/UI.Forms.MoveVaultDlg.pas @@ -72,7 +72,7 @@ TMoveVaultDlg = class(TGenericViewDlg, INoPublicConstruct) var /// Object that moves a vault's data to a new location. /// - fMover: TUserDBMove; + fMover: TVaultMover; /// Object used to disable and enable all controls on the form. /// fControlStateMgr: TControlStateMgr; @@ -315,7 +315,7 @@ class procedure TMoveVaultDlg.Execute(AOwner: TComponent); procedure TMoveVaultDlg.FormCreate(Sender: TObject); begin inherited; - fMover := TUserDBMove.Create; + fMover := TVaultMover.Create; fMover.OnCopyFile := CopyFileHandler; fMover.OnDeleteFile := DeleteFileHandler; fControlStateMgr := TControlStateMgr.Create(Self); diff --git a/Src/UUserDBMove.pas b/Src/UUserDBMove.pas index 81a3d983a..2f4a74a97 100644 --- a/Src/UUserDBMove.pas +++ b/Src/UUserDBMove.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2013-2021, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a class that moves a collection's data to a new location. + * Implements a class that moves a vault to a new location. } @@ -22,14 +22,13 @@ interface type - /// Class that moves a collection's data to a new location. - /// - TUserDBMove = class(TObject) + /// Class that moves a vault to a new location. + TVaultMover = class(TObject) public type /// Type of event triggered to report progress when moving a - /// collection's data files. - /// TObject [in] TUserDBMove instance that triggered + /// vault's data files. + /// TObject [in] TVaultMover instance that triggered /// the event. /// Byte [in] Percentage of operation that has been /// completed. @@ -41,12 +40,12 @@ TUserDBMove = class(TObject) fOnCopyFile: TProgress; /// Reference to event handler for OnDeleteFile event. fOnDeleteFile: TProgress; - /// Directory containg existing collection data. + /// Directory containg existing vault data. fSourceDir: string; - /// Required new collection data directory. + /// Required new vault data directory. fDestDir: string; /// Vault to be moved. - fCollection: TVault; + fVault: TVault; /// Instance of class used to perform directory move. fDirCopier: TDirectoryCopier; /// Validates source and destination directories. @@ -54,10 +53,9 @@ TUserDBMove = class(TObject) /// valid. procedure ValidateDirectories; /// Handles TDirectoryCopier.OnAfterCopyDir event to update the - /// collection data directory. - /// Collection data location is updated once the collection's data - /// has been copied but before the old collection data directory is - /// deleted. + /// vault data directory. + /// Vault data location is updated once the vault's data has been + /// copied but before the old vault data directory is deleted. procedure SetNewDBDirectory(Sender: TObject); /// Handles TDirectoryCopier.OnCopyFileProgress event and passes /// the given progress percentage on to this class' similar OnCopyFile @@ -76,7 +74,7 @@ TUserDBMove = class(TObject) /// directory. /// Raises EInOutError exceptions if an error occurs. /// - procedure MoveTo(const ACollection: TVault; const ADirectory: string); + procedure MoveTo(const AVault: TVault; const ADirectory: string); /// Event triggered just before file copying begins and once for /// each file copied. Reports progress towards completion of copy /// operation. @@ -99,9 +97,9 @@ implementation UStrUtils; -{ TUserDBMove } +{ TVaultMover } -constructor TUserDBMove.Create; +constructor TVaultMover.Create; begin inherited Create; fDirCopier := TDirectoryCopier.Create; @@ -110,59 +108,56 @@ constructor TUserDBMove.Create; fDirCopier.OnDeleteFileProgress := ReportDeleteProgress; end; -destructor TUserDBMove.Destroy; +destructor TVaultMover.Destroy; begin fDirCopier.Free; inherited; end; -procedure TUserDBMove.MoveTo(const ACollection: TVault; - const ADirectory: string); +procedure TVaultMover.MoveTo(const AVault: TVault; const ADirectory: string); begin - fCollection := ACollection; - fSourceDir := ExcludeTrailingPathDelimiter(ACollection.Storage.Directory); + fVault := AVault; + fSourceDir := ExcludeTrailingPathDelimiter(AVault.Storage.Directory); fDestDir := ExcludeTrailingPathDelimiter(ADirectory); ValidateDirectories; fDirCopier.Move(fSourceDir, fDestDir); end; -procedure TUserDBMove.ReportCopyProgress(Sender: TObject; +procedure TVaultMover.ReportCopyProgress(Sender: TObject; const Percent: Single); begin if Assigned(fOnCopyFile) then fOnCopyFile(Self, Round(Percent)); end; -procedure TUserDBMove.ReportDeleteProgress(Sender: TObject; +procedure TVaultMover.ReportDeleteProgress(Sender: TObject; const Percent: Single); begin if Assigned(fOnDeleteFile) then fOnDeleteFile(Self, Round(Percent)); end; -procedure TUserDBMove.SetNewDBDirectory(Sender: TObject); +procedure TVaultMover.SetNewDBDirectory(Sender: TObject); var - Collections: TVaults; + Vaults: TVaults; begin - Collections := TVaults.Instance; + Vaults := TVaults.Instance; // record new location BEFORE deleting old directory - fCollection.Storage.Directory := fDestDir; - Collections.Update(fCollection); - // Persist collections immediately to save new directory ASAP to prevent - // directory change being lost following a program crash. - Collections.Save; + fVault.Storage.Directory := fDestDir; + Vaults.Update(fVault); + // Persist vaults immediately to save new directory ASAP to prevent directory + // change being lost following a program crash. + Vaults.Save; end; -procedure TUserDBMove.ValidateDirectories; +procedure TVaultMover.ValidateDirectories; resourcestring - sSameNames = 'The new collection data directory is the same as the current ' - + 'directory.'; - sSourceMissing = 'No collection data found'; - sCantMoveToSubDir = 'Can''t move the collection into a sub-directory of the ' - + 'its existing data directory'; - sDestMustBeRooted = 'A full path to the new collectio data directory must be ' - + 'provided.'; - sDestMustBeEmpty = 'The new collection data directory must be empty'; + sSameNames = 'The new directory is the same as the current directory.'; + sSourceMissing = 'No vault data found'; + sCantMoveToSubDir = 'Can''t move the vault into a sub-directory of its ' + + 'existing data directory'; + sDestMustBeRooted = 'A full path to the new directory must be provided.'; + sDestMustBeEmpty = 'The new data directory must be empty'; begin if not TPath.IsPathRooted(fDestDir) then raise EInOutError.Create(sDestMustBeRooted); @@ -177,7 +172,7 @@ procedure TUserDBMove.ValidateDirectories; raise EInOutError.Create(sSameNames); if StrStartsText( - IncludeTrailingPathDelimiter(fCollection.Storage.Directory), fDestDir + IncludeTrailingPathDelimiter(fVault.Storage.Directory), fDestDir ) then raise EInOutError.Create(sCantMoveToSubDir); end; From b3dcc7df2c75f71bfbd92e942e7624e355fbb1a0 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 10:17:29 +0000 Subject: [PATCH 174/222] Rename UUserDBMove unit as VaultMover Updated calling code re the unit name change --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/UI.Forms.MoveVaultDlg.pas | 2 +- Src/{UUserDBMove.pas => VaultMover.pas} | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) rename Src/{UUserDBMove.pas => VaultMover.pas} (99%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 3709dfa76..c2ce74a42 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -352,7 +352,7 @@ uses UUrlMonEx in 'UUrlMonEx.pas', UUserDBBackup in 'UUserDBBackup.pas', UUserDBMgr in 'UUserDBMgr.pas', - UUserDBMove in 'UUserDBMove.pas', + VaultMover in 'VaultMover.pas', UUtils in 'UUtils.pas', UVersionInfo in 'UVersionInfo.pas', UView in 'UView.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index ba13e631e..f1269273c 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -554,7 +554,7 @@ - + diff --git a/Src/UI.Forms.MoveVaultDlg.pas b/Src/UI.Forms.MoveVaultDlg.pas index dc14efe21..30616aba2 100644 --- a/Src/UI.Forms.MoveVaultDlg.pas +++ b/Src/UI.Forms.MoveVaultDlg.pas @@ -31,7 +31,7 @@ interface UBaseObjects, UControlStateMgr, UI.Adapters.VaultList, - UUserDBMove; + VaultMover; type /// Dialogue box that is used to move vault data to a new directory. diff --git a/Src/UUserDBMove.pas b/Src/VaultMover.pas similarity index 99% rename from Src/UUserDBMove.pas rename to Src/VaultMover.pas index 2f4a74a97..5665e087e 100644 --- a/Src/UUserDBMove.pas +++ b/Src/VaultMover.pas @@ -9,7 +9,7 @@ } -unit UUserDBMove; +unit VaultMover; interface From c465399b192b4093e9debf8d877a80f372f6a94b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 10:28:38 +0000 Subject: [PATCH 175/222] Renaming in UUserDBBackup unit The TUserDBBackup class was renamed as TVaultBackup. Identifiers referring to collections were changed to refer to vaults. Comments were changed similarly. Calling code was updated to use the new class name. --- Src/DB.UDatabaseIO.pas | 8 ++++---- Src/UUserDBBackup.pas | 28 +++++++++++----------------- Src/UUserDBMgr.pas | 8 ++++---- 3 files changed, 19 insertions(+), 25 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index c98e39a30..70e51b1e0 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -841,9 +841,9 @@ procedure TFormatSaver.WriteSnippets; procedure TDCSCV2FormatSaver.Backup; var - FB: TUserDBBackup; // TODO -cRefactoring: this is correct class (will change) + FB: TVaultBackup; begin - FB := TUserDBBackup.Create(fBakFile, Vault); + FB := TVaultBackup.Create(fBakFile, Vault); try FB.Backup; finally @@ -869,9 +869,9 @@ function TDCSCV2FormatSaver.CreateWriter: IDataWriter; procedure TDCSCV2FormatSaver.Restore; var - FB: TUserDBBackup; + FB: TVaultBackup; begin - FB := TUserDBBackup.Create(fBakFile, Vault); + FB := TVaultBackup.Create(fBakFile, Vault); try FB.Restore; finally diff --git a/Src/UUserDBBackup.pas b/Src/UUserDBBackup.pas index 9e3b8e8e9..41f1e3bb4 100644 --- a/Src/UUserDBBackup.pas +++ b/Src/UUserDBBackup.pas @@ -5,16 +5,13 @@ * * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a class that can create and restore backups of the user database. + * Implements a class that can create and restore backups of vaults. } unit UUserDBBackup; -{TODO -cRefactoring: Rename this unit/classes/methods: the names refer to the - CodeSnip 4 database structure but the code now works with collections} - interface @@ -32,13 +29,13 @@ interface /// Backups are single files. /// See UFolderBackup for details of the file format. /// - TUserDBBackup = class sealed(TFolderBackup) + TVaultBackup = class sealed(TFolderBackup) strict private - class function MakeFileID(const ACollection: TVault): SmallInt; + class function MakeFileID(const AVault: TVault): SmallInt; public /// Object constructor. Sets up the object to backup the given /// vault to the given backup file. - constructor Create(const BackupFile: string; const ACollection: TVault); + constructor Create(const BackupFile: string; const AVault: TVault); end; @@ -52,25 +49,22 @@ implementation UAppInfo; -{ TUserDBBackup } +{ TVaultBackup } -constructor TUserDBBackup.Create(const BackupFile: string; - const ACollection: TVault); +constructor TVaultBackup.Create(const BackupFile: string; + const AVault: TVault); begin inherited Create( - ACollection.Storage.Directory, - BackupFile, - MakeFileID(ACollection), - ACollection.UID.ToArray + AVault.Storage.Directory, BackupFile, MakeFileID(AVault), AVault.UID.ToArray ); end; -class function TUserDBBackup.MakeFileID(const ACollection: TVault): +class function TVaultBackup.MakeFileID(const AVault: TVault): SmallInt; begin // Backup file ID is $Fxxx where xxx is ordinal value of format kind. - // The $F indicates that the file is a backup of a collection data format. - Result := SmallInt($F000 or UInt16(Ord(ACollection.Storage.Format))); + // The $F indicates that the file is a backup of a vault data format. + Result := SmallInt($F000 or UInt16(Ord(AVault.Storage.Format))); end; end. diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 7fc29a5c8..54835849d 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -541,9 +541,9 @@ constructor TUserDBRestoreUI.TRestoreThread.Create(const BakFileName: string; procedure TUserDBRestoreUI.TRestoreThread.Execute; var - UserDBBackup: TUserDBBackup; + UserDBBackup: TVaultBackup; begin - UserDBBackup := TUserDBBackup.Create(fBakFileName, fCollection); + UserDBBackup := TVaultBackup.Create(fBakFileName, fCollection); try UserDBBackup.Restore; finally @@ -581,12 +581,12 @@ constructor TUserDBBackupUI.TBackupThread.Create(const BakFileName: string; procedure TUserDBBackupUI.TBackupThread.Execute; var - UserDBBackup: TUserDBBackup; // object used to perform backup + UserDBBackup: TVaultBackup; resourcestring // Dialog box caption sCaption = 'Save Backup'; begin - UserDBBackup := TUserDBBackup.Create(fBakFileName, fCollection); + UserDBBackup := TVaultBackup.Create(fBakFileName, fCollection); try UserDBBackup.Backup; finally From 8f2b2efcf9b23cd0e83e461e0d4d1787eba90b49 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 10:34:05 +0000 Subject: [PATCH 176/222] Rename UUserDBBackup unit as VaultBackup Updated calling code re the unit name change --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/DB.UDatabaseIO.pas | 2 +- Src/UUserDBMgr.pas | 2 +- Src/{UUserDBBackup.pas => VaultBackup.pas} | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) rename Src/{UUserDBBackup.pas => VaultBackup.pas} (98%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index c2ce74a42..7c0be4143 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -350,7 +350,7 @@ uses UURIEncode in 'UURIEncode.pas', UUrl in 'UUrl.pas', UUrlMonEx in 'UUrlMonEx.pas', - UUserDBBackup in 'UUserDBBackup.pas', + VaultBackup in 'VaultBackup.pas', UUserDBMgr in 'UUserDBMgr.pas', VaultMover in 'VaultMover.pas', UUtils in 'UUtils.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index f1269273c..c165faa45 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -552,7 +552,7 @@ - + diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 70e51b1e0..2c2084dc9 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -140,7 +140,7 @@ implementation UConsts, UIStringList, USnippetIDs, - UUserDBBackup; + VaultBackup; type diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index 54835849d..f5d0da6de 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -115,7 +115,7 @@ implementation UExceptions, UIStringList, UMessageBox, - UUserDBBackup, + VaultBackup, UWaitForThreadUI; type diff --git a/Src/UUserDBBackup.pas b/Src/VaultBackup.pas similarity index 98% rename from Src/UUserDBBackup.pas rename to Src/VaultBackup.pas index 41f1e3bb4..e32f0fc98 100644 --- a/Src/UUserDBBackup.pas +++ b/Src/VaultBackup.pas @@ -9,7 +9,7 @@ } -unit UUserDBBackup; +unit VaultBackup; interface From b9ead40db69781d7ead152d122a9e8ee79676595 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 10:50:35 +0000 Subject: [PATCH 177/222] Renaming in TSnippetDoc & descendants Renamed private TSnippetDoc.CollectionInfo method as VaultInfo and abstract protected TSnippetDoc.RenderCollectionInfo as RenderVaultInfo. Updated descendant classes re change of inherited abstract method. Renamed some parameters in all classes that referred to collections to refer to vaults. Updated comments re change from collections to vaults. --- Src/URTFSnippetDoc.pas | 40 ++++++++++++++++---------------- Src/USnippetDoc.pas | 51 +++++++++++++++++++++-------------------- Src/UTextSnippetDoc.pas | 26 ++++++++++----------- 3 files changed, 59 insertions(+), 58 deletions(-) diff --git a/Src/URTFSnippetDoc.pas b/Src/URTFSnippetDoc.pas index f557c45fe..f8d3bda86 100644 --- a/Src/URTFSnippetDoc.pas +++ b/Src/URTFSnippetDoc.pas @@ -86,8 +86,8 @@ TRTFSnippetDoc = class(TSnippetDoc) /// given vault. /// Heading is coloured according the the snippet's vault. /// - procedure RenderHeading(const Heading: string; - const ACollectionID: TVaultID); override; + procedure RenderHeading(const Heading: string; const AVaultID: TVaultID); + override; /// Adds given snippet description to document. /// Active text formatting is observed and styled to suit /// document. @@ -113,8 +113,8 @@ TRTFSnippetDoc = class(TSnippetDoc) /// Active text formatting is observed and styled to suit /// document. procedure RenderExtra(const ExtraText: IActiveText); override; - /// Output given information about a collection. - procedure RenderCollectionInfo(const Text: string); override; + /// Output given information about a vault. + procedure RenderVaultInfo(const Text: string); override; /// Finalises document and returns content as encoded data. /// function FinaliseDoc: TEncodedData; override; @@ -169,7 +169,7 @@ function TRTFSnippetDoc.FinaliseDoc: TEncodedData; procedure TRTFSnippetDoc.InitialiseDoc; var - Collection: TVault; + Vault: TVault; begin // Create object used to build main rich text document fBuilder := TRTFBuilder.Create(0); // Use default code page @@ -180,9 +180,9 @@ procedure TRTFSnippetDoc.InitialiseDoc; fBuilder.ColourTable.Add(clWarningText); fBuilder.ColourTable.Add(clVarText); fBuilder.ColourTable.Add(clExternalLink); - for Collection in TVaults.Instance do + for Vault in TVaults.Instance do fBuilder.ColourTable.Add( - Preferences.GetSnippetHeadingColour(Collection.UID) + Preferences.GetSnippetHeadingColour(Vault.UID) ); end; @@ -326,17 +326,6 @@ procedure TRTFSnippetDoc.InitStyles; end; end; -procedure TRTFSnippetDoc.RenderCollectionInfo(const Text: string); -begin - fBuilder.SetParaSpacing(TRTFParaSpacing.Create(ParaSpacing, 0.0)); - fBuilder.SetFontSize(DBInfoFontSize); - fBuilder.SetFontStyle([fsItalic]); - fBuilder.AddText(Text); - fBuilder.EndPara; - fBuilder.ClearParaFormatting; - fBuilder.ResetCharStyle; -end; - procedure TRTFSnippetDoc.RenderCompilerInfo(const Heading: string; const Info: TCompileDocInfoArray); @@ -427,12 +416,12 @@ procedure TRTFSnippetDoc.RenderExtra(const ExtraText: IActiveText); end; procedure TRTFSnippetDoc.RenderHeading(const Heading: string; - const ACollectionID: TVaultID); + const AVaultID: TVaultID); begin fBuilder.SetFontStyle([fsBold]); fBuilder.SetFontSize(HeadingFontSize); if fUseColour then - fBuilder.SetColour(Preferences.GetSnippetHeadingColour(ACollectionID)); + fBuilder.SetColour(Preferences.GetSnippetHeadingColour(AVaultID)); fBuilder.SetParaSpacing(TRTFParaSpacing.Create(0.0, ParaSpacing)); fBuilder.AddText(Heading); fBuilder.EndPara; @@ -496,5 +485,16 @@ procedure TRTFSnippetDoc.RenderTitledText(const Title, Text: string); fBuilder.EndPara; end; +procedure TRTFSnippetDoc.RenderVaultInfo(const Text: string); +begin + fBuilder.SetParaSpacing(TRTFParaSpacing.Create(ParaSpacing, 0.0)); + fBuilder.SetFontSize(DBInfoFontSize); + fBuilder.SetFontStyle([fsItalic]); + fBuilder.AddText(Text); + fBuilder.EndPara; + fBuilder.ClearParaFormatting; + fBuilder.ResetCharStyle; +end; + end. diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index 646c986a6..559f712dc 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -61,7 +61,7 @@ TSnippetDoc = class(TObject) /// the given vault. /// Information includes license and copyright information if /// the vault's data format supports it. - function CollectionInfo(const ACollectionID: TVaultID): string; + function VaultInfo(const AVaultID: TVaultID): string; strict protected /// Initialise document. /// Does nothing. Descendant classes should perform any required @@ -73,7 +73,7 @@ TSnippetDoc = class(TObject) /// Heading may be rendered differently depending on the snippet's /// vault. procedure RenderHeading(const Heading: string; - const ACollectionID: TVaultID); virtual; abstract; + const AVaultID: TVaultID); virtual; abstract; /// Output given snippet description. procedure RenderDescription(const Desc: IActiveText); virtual; abstract; /// Output given source code. @@ -96,8 +96,8 @@ TSnippetDoc = class(TObject) /// Active text must be interpreted in a manner that makes sense /// for document format. procedure RenderExtra(const ExtraText: IActiveText); virtual; abstract; - /// Output given information about a collection. - procedure RenderCollectionInfo(const Text: string); virtual; abstract; + /// Output given information about a vault. + procedure RenderVaultInfo(const Text: string); virtual; abstract; /// Finalise document and return content as encoded data. /// /// Descendant classes should perform any required finalisation @@ -133,26 +133,6 @@ implementation { TSnippetDoc } -function TSnippetDoc.CollectionInfo(const ACollectionID: TVaultID): string; -resourcestring - sCollectionInfo = 'A snippet from the "%s" collection.'; -var - MetaData: TMetaData; - Collection: TVault; -begin - Collection := TVaults.Instance.GetVault(ACollectionID); - MetaData := Collection.MetaData; - Result := ''; - if TMetaDataCap.License in MetaData.Capabilities then - Result := Result + StrMakeSentence(MetaData.LicenseInfo.NameWithURL); - if TMetaDataCap.Copyright in MetaData.Capabilities then - begin - if not StrIsEmpty(Result) then - Result := Result + ' '; - Result := Result + StrMakeSentence(MetaData.CopyrightInfo.ToString); - end; -end; - function TSnippetDoc.CommaList(const List: IStringList): string; resourcestring sNone = 'None.'; // string output for empty lists @@ -228,7 +208,7 @@ function TSnippetDoc.Generate(const Snippet: TSnippet): TEncodedData; end; if Snippet.Extra.HasContent then RenderExtra(Snippet.Extra); - RenderCollectionInfo(CollectionInfo(Snippet.VaultID)); + RenderVaultInfo(VaultInfo(Snippet.VaultID)); Result := FinaliseDoc; end; @@ -247,6 +227,27 @@ function TSnippetDoc.SnippetsToStrings(const SnippetList: TSnippetList): Result.Add(Snippet.DisplayName); end; +function TSnippetDoc.VaultInfo(const AVaultID: TVaultID): string; +resourcestring + {TODO -cBug: the following information is not included in output} + sVaultInfo = 'A snippet from the "%s" vault.'; +var + MetaData: TMetaData; + Vault: TVault; +begin + Vault := TVaults.Instance.GetVault(AVaultID); + MetaData := Vault.MetaData; + Result := ''; + if TMetaDataCap.License in MetaData.Capabilities then + Result := Result + StrMakeSentence(MetaData.LicenseInfo.NameWithURL); + if TMetaDataCap.Copyright in MetaData.Capabilities then + begin + if not StrIsEmpty(Result) then + Result := Result + ' '; + Result := Result + StrMakeSentence(MetaData.CopyrightInfo.ToString); + end; +end; + { TCompileDocInfo } constructor TCompileDocInfo.Create(const ACompiler: string; diff --git a/Src/UTextSnippetDoc.pas b/Src/UTextSnippetDoc.pas index 55e24ca47..13a21459d 100644 --- a/Src/UTextSnippetDoc.pas +++ b/Src/UTextSnippetDoc.pas @@ -51,10 +51,10 @@ TTextSnippetDoc = class(TSnippetDoc) /// Output given heading, i.e. snippet name for snippet from a /// given vault. - /// Heading is output the same regardless of the snippet's - /// collection. - procedure RenderHeading(const Heading: string; - const ACollectionID: TVaultID); override; + /// Heading is output the same regardless of the snippet's vault. + /// + procedure RenderHeading(const Heading: string; const AVaultID: TVaultID); + override; /// Interprets and adds given snippet description to document. /// /// Active text is converted to word-wrapped plain text @@ -81,8 +81,8 @@ TTextSnippetDoc = class(TSnippetDoc) /// Active text is converted to word-wrapped plain text /// paragraphs. procedure RenderExtra(const ExtraText: IActiveText); override; - /// Output given information about a collection. - procedure RenderCollectionInfo(const Text: string); override; + /// Output given information about a vault. + procedure RenderVaultInfo(const Text: string); override; /// Finalises document and returns content as encoded data. /// function FinaliseDoc: TEncodedData; override; @@ -128,12 +128,6 @@ procedure TTextSnippetDoc.RenderActiveText(ActiveText: IActiveText); end; end; -procedure TTextSnippetDoc.RenderCollectionInfo(const Text: string); -begin - fWriter.WriteLine; - fWriter.WriteLine(StrWrap(Text, cPageWidth, 0)); -end; - procedure TTextSnippetDoc.RenderCompilerInfo(const Heading: string; const Info: TCompileDocInfoArray); var @@ -169,7 +163,7 @@ procedure TTextSnippetDoc.RenderExtra(const ExtraText: IActiveText); end; procedure TTextSnippetDoc.RenderHeading(const Heading: string; - const ACollectionID: TVaultID); + const AVaultID: TVaultID); begin fWriter.WriteLine(Heading); end; @@ -202,5 +196,11 @@ procedure TTextSnippetDoc.RenderTitledText(const Title, Text: string); fWriter.WriteLine(StrWrap(Text, cPageWidth - cIndent, cIndent)); end; +procedure TTextSnippetDoc.RenderVaultInfo(const Text: string); +begin + fWriter.WriteLine; + fWriter.WriteLine(StrWrap(Text, cPageWidth, 0)); +end; + end. From 883db7e0bf24a629c237792175b7da83342867c4 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 11:06:04 +0000 Subject: [PATCH 178/222] Renaming in FmCodeImportDlg unit Renamed various methods, parameters, fields & consts that referred to collections to refer to vaults instead. Updated comments re change from collections to vaults. --- Src/FmCodeImportDlg.dfm | 40 +++++++++------------------- Src/FmCodeImportDlg.pas | 58 ++++++++++++++++++++--------------------- 2 files changed, 40 insertions(+), 58 deletions(-) diff --git a/Src/FmCodeImportDlg.dfm b/Src/FmCodeImportDlg.dfm index 7b30eb0c7..ff4408c08 100644 --- a/Src/FmCodeImportDlg.dfm +++ b/Src/FmCodeImportDlg.dfm @@ -9,15 +9,11 @@ inherited CodeImportDlg: TCodeImportDlg ExplicitHeight = 321 inherited pcWizard: TPageControl Height = 288 - ActivePage = tsInfo + ActivePage = tsFinish ExplicitHeight = 288 object tsInfo: TTabSheet Caption = 'tsInfo' TabVisible = False - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblIntro: TLabel Left = 0 Top = 8 @@ -25,8 +21,8 @@ inherited CodeImportDlg: TCodeImportDlg Height = 227 AutoSize = False Caption = - 'This wizard helps you import snippets from a file into your user' + - ' database.'#13#10#13#10'Click the Next button below to begin.' + 'This wizard helps you import snippets from a file into a vault.'#13 + + #10#13#10'Click the Next button below to begin.' WordWrap = True end end @@ -34,10 +30,6 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'tsFile' ImageIndex = 1 TabVisible = False - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblFile: TLabel Left = 0 Top = 8 @@ -75,22 +67,22 @@ inherited CodeImportDlg: TCodeImportDlg TabOrder = 1 end end - object tsCollection: TTabSheet - Caption = 'tsCollection' + object tsVault: TTabSheet + Caption = 'tsVault' ImageIndex = 4 TabVisible = False DesignSize = ( 369 278) - object lblCollection: TLabel + object lblVaults: TLabel Left = 0 Top = 8 - Width = 254 + Width = 234 Height = 13 - Caption = 'Choose a &collection to receive the imported snippets:' - FocusControl = cbCollection + Caption = 'Choose a &vault to receive the imported snippets:' + FocusControl = cbVaults end - object cbCollection: TComboBox + object cbVaults: TComboBox Left = 0 Top = 38 Width = 369 @@ -104,10 +96,6 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'tsUpdate' ImageIndex = 3 TabVisible = False - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblImportList: TLabel Left = 0 Top = 53 @@ -159,10 +147,6 @@ inherited CodeImportDlg: TCodeImportDlg Caption = 'tsFinish' ImageIndex = 5 TabVisible = False - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblFinish: TLabel Left = 0 Top = 8 @@ -170,8 +154,8 @@ inherited CodeImportDlg: TCodeImportDlg Height = 33 AutoSize = False Caption = - 'The database has now been updated. The following snippets were i' + - 'mported:' + 'The chosen vault has now been updated. The following snippets we' + + 're imported:' WordWrap = True end object sbFinish: TScrollBox diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index eecd47e5b..8f9ecc38c 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -54,9 +54,9 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) lblModifyInstructions: TLabel; lblFinish: TLabel; sbFinish: TScrollBox; - tsCollection: TTabSheet; - lblCollection: TLabel; - cbCollection: TComboBox; + tsVault: TTabSheet; + lblVaults: TLabel; + cbVaults: TComboBox; /// Handles clicks on list view check boxes. procedure lvImportsItemChecked(Sender: TObject; Item: TListItem); /// Handles request to display open file dialog box to get import @@ -72,7 +72,7 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) // Indices of wizard pages cIntroPage = 0; cFilePage = 1; - cCollectionPage = 2; + cVaultPage = 2; cUpdatePage = 3; cFinishPage = 4; // Index of subitems in list view @@ -81,10 +81,9 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) /// Reference to import manager object used to perform import /// operations. fImportMgr: TCodeImportMgr; - /// Object that populates cbCollection with an - /// alphabetical list of collection names and manages interaction with - /// it. - fCollList: TVaultListAdapter; + /// Object that populates cbVaults with an alphabetical + /// list of vault names and manages interaction with it. + fVaultList: TVaultListAdapter; /// Validates entries on wizard pages indetified by the page /// index. procedure ValidatePage(const PageIdx: Integer); @@ -119,7 +118,7 @@ TCodeImportDlg = class(TWizardDlg, INoPublicConstruct) procedure PresentResults; /// Gets the ID of the vault into which all snippets are to be /// imported. - function GetCollectionID: TVaultID; + function GetVaultID: TVaultID; strict protected /// Protected constructor that sets up object to use given import /// manager object. @@ -221,9 +220,9 @@ procedure TCodeImportDlg.ArrangeForm; ); lblLoadFile.Top := TCtrlArranger.BottomOf([edFile, btnBrowse], 12); - // tsCollection - cbCollection.Top := TCtrlArranger.BottomOf(lblCollection, 6); - cbCollection.Width := tsCollection.Width; + // tsVault + cbVaults.Top := TCtrlArranger.BottomOf(lblVaults, 6); + cbVaults.Width := tsVault.Width; // tsUpdate lblImportList.Top := TCtrlArranger.BottomOf(lblModifyInstructions, 8); @@ -291,7 +290,7 @@ class function TCodeImportDlg.Execute(AOwner: TComponent; procedure TCodeImportDlg.FormCreate(Sender: TObject); begin inherited; - fCollList := TVaultListAdapter.Create; + fVaultList := TVaultListAdapter.Create; end; procedure TCodeImportDlg.FormDestroy(Sender: TObject); @@ -299,22 +298,22 @@ procedure TCodeImportDlg.FormDestroy(Sender: TObject); Idx: Integer; begin inherited; - fCollList.Free; + fVaultList.Free; // Free the TBox<> objects stored in list item data pointer for Idx := Pred(lvImports.Items.Count) downto 0 do TObject(lvImports.Items[Idx].Data).Free; end; -function TCodeImportDlg.GetCollectionID: TVaultID; +function TCodeImportDlg.GetFileNameFromEditCtrl: string; begin - Assert(cbCollection.ItemIndex >= 0, - ClassName + '.GetCollectionID: no collection selected'); - Result := fCollList.Vault(cbCollection.ItemIndex).UID; + Result := StrTrim(edFile.Text); end; -function TCodeImportDlg.GetFileNameFromEditCtrl: string; +function TCodeImportDlg.GetVaultID: TVaultID; begin - Result := StrTrim(edFile.Text); + Assert(cbVaults.ItemIndex >= 0, + ClassName + '.GetVaultID: no vault selected'); + Result := fVaultList.Vault(cbVaults.ItemIndex).UID; end; function TCodeImportDlg.HeadingText(const PageIdx: Integer): string; @@ -322,14 +321,14 @@ function TCodeImportDlg.HeadingText(const PageIdx: Integer): string; // Page headings sIntroPageheading = 'Import snippets from a file'; sFilePage = 'Choose import file'; - sCollectionPage = 'Choose a collection'; + sVaultPage = 'Choose a vault'; sUpdatePage = 'Edit import and update database'; sFinishPage = 'Import complete'; begin case PageIdx of cIntroPage: Result := sIntroPageheading; cFilePage: Result := sFilePage; - cCollectionPage: Result := sCollectionPage; + cVaultPage: Result := sVaultPage; cUpdatePage: Result := sUpdatePage; cFinishPage: Result := sFinishPage; end; @@ -337,14 +336,13 @@ function TCodeImportDlg.HeadingText(const PageIdx: Integer): string; procedure TCodeImportDlg.InitForm; begin - fCollList.ToStrings(cbCollection.Items); - Assert(cbCollection.Items.Count > 0, ClassName + '.InitForm: no collections'); + fVaultList.ToStrings(cbVaults.Items); + Assert(cbVaults.Items.Count > 0, ClassName + '.InitForm: no vaults'); Assert(TVaults.Instance.ContainsID(TVaultID.Default), - ClassName + '.InitForm: default collection not found'); - cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); - Assert(cbCollection.ItemIndex >= 0, - ClassName + '.InitForm: default collection name not in cbCollection'); - + ClassName + '.InitForm: default vault not found'); + cbVaults.ItemIndex := fVaultList.IndexOfUID(TVaultID.Default); + Assert(cbVaults.ItemIndex >= 0, + ClassName + '.InitForm: default vault name not in cbVaults'); inherited; end; @@ -385,7 +383,7 @@ constructor TCodeImportDlg.InternalCreate(AOwner: TComponent; begin inherited InternalCreate(AOwner); fImportMgr := ImportMgr; - fImportMgr.RequestCollectionCallback := GetCollectionID; + fImportMgr.RequestCollectionCallback := GetVaultID; end; procedure TCodeImportDlg.lvImportsItemChecked(Sender: TObject; Item: TListItem); From 0400396685b3634d709168e399ee57285054a29a Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 11:19:53 +0000 Subject: [PATCH 179/222] Renaming in UCodeImportMgr unit Renamed TCodeImportMgr.RequestCollectionCallback property to RequestVaultCallback & renamed related field similarly. Changed name of a local variable to refer to vault instead of collection. Updated calling code re change of callback property name. Updated comments re renamings & change from collections to vaults. --- Src/FmCodeImportDlg.pas | 2 +- Src/UCodeImportMgr.pas | 24 +++++++++++------------- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/Src/FmCodeImportDlg.pas b/Src/FmCodeImportDlg.pas index 8f9ecc38c..ae050f0ca 100644 --- a/Src/FmCodeImportDlg.pas +++ b/Src/FmCodeImportDlg.pas @@ -383,7 +383,7 @@ constructor TCodeImportDlg.InternalCreate(AOwner: TComponent; begin inherited InternalCreate(AOwner); fImportMgr := ImportMgr; - fImportMgr.RequestCollectionCallback := GetVaultID; + fImportMgr.RequestVaultCallback := GetVaultID; end; procedure TCodeImportDlg.lvImportsItemChecked(Sender: TObject; Item: TListItem); diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index b4a9af248..ae63eb4f1 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -108,8 +108,8 @@ TCodeImportMgr = class sealed(TObject) fSnippetInfoList: TSnippetInfoList; /// Value of ImportInfo property. fImportInfoList: TImportInfoList; - /// Value of RequestCollectionCallback property. - fRequestCollectionCallback: TFunc; + /// Value of RequestVaultCallback property. + fRequestVaultCallback: TFunc; /// Initialises import information list with details of snippets /// read from import file. procedure InitImportInfoList; @@ -124,8 +124,8 @@ TCodeImportMgr = class sealed(TObject) /// customisation. procedure Import(const FileName: string); /// Updates database based on imported snippets and customisation - /// described by ImportInfo property, using collection specified in - /// RequestCollectionCallback. + /// described by ImportInfo property, using the vault specified in + /// RequestVaultCallback. /// Any snippets referenced in the an imported snippet's /// Depends or XRefs property must also be included in the /// import otherwise the snippet is stripped from the dependency list. @@ -137,8 +137,8 @@ TCodeImportMgr = class sealed(TObject) /// Callback that gets the ID of the vault that will receive the /// imported snippets. /// Defaults to the default vault ID if not assigned. - property RequestCollectionCallback: TFunc - read fRequestCollectionCallback write fRequestCollectionCallback; + property RequestVaultCallback: TFunc + read fRequestVaultCallback write fRequestVaultCallback; end; type @@ -173,7 +173,7 @@ constructor TCodeImportMgr.Create; SetLength(fSnippetInfoList, 0); fImportInfoList := TImportInfoList.Create; // set default event handler - fRequestCollectionCallback := function: TVaultID + fRequestVaultCallback := function: TVaultID begin Result := TVaultID.Default; end; @@ -214,9 +214,7 @@ procedure TCodeImportMgr.InitImportInfoList; fImportInfoList.Add( TImportInfo.Create( SnippetInfo.Key, - (Database as IDatabaseEdit).GetUniqueSnippetKey( - RequestCollectionCallback - ), + (Database as IDatabaseEdit).GetUniqueSnippetKey(RequestVaultCallback), StrIf( SnippetInfo.Data.Props.DisplayName = '', SnippetInfo.Key, @@ -256,7 +254,7 @@ TSavedReferences = record Editor: IDatabaseEdit; // object used to update user database SnippetInfo: TSnippetInfo; // info about each snippet from import file ImportInfo: TImportInfo; // info about how / whether to import a snippet - CollectionID: TVaultID; // collection into which we're importing + VaultID: TVaultID; // vault into which we're importing SavedRefs: TList; // preserved references for each snippet SavedRef: TSavedReferences; // each record in Refs list SnippetDataNoRefs: TSnippetEditData; // snippet data with references cleared @@ -269,7 +267,7 @@ TSavedReferences = record } Editor := Database as IDatabaseEdit; - CollectionID := RequestCollectionCallback(); + VaultID := RequestVaultCallback(); SavedRefs := TList.Create( TDelegatedComparer.Create( @@ -306,7 +304,7 @@ TSavedReferences = record // add snippet without any dependency SavedRef.Snippet := Editor.AddSnippet( - ImportInfo.NewKey, CollectionID, SnippetDataNoRefs + ImportInfo.NewKey, VaultID, SnippetDataNoRefs ); // save snippet with its dependencies From fd3c1e756b21c2d33c8fce20bf5c1a644c2d0e21 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 11:38:44 +0000 Subject: [PATCH 180/222] Renaming in TSnippetsTVDraw class and descendants The protected, abstract GetCollectionID method of TSnippetsTVDraw was renamed to GetVaultID. The call to the renamed method in TSnippetsTVDraw.CustomDrawItem was renamed accordingly. The overridden methods were renamed to suit in descendant classes. Some comments were updated re the change to vaults from collections. --- Src/FmDependenciesDlg.pas | 5 ++--- Src/FrOverview.pas | 9 ++++----- Src/FrSelectSnippetsBase.pas | 8 ++++---- Src/USnippetsTVDraw.pas | 4 ++-- 4 files changed, 12 insertions(+), 14 deletions(-) diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index 15f5a10a6..6fcd47818 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -83,7 +83,7 @@ TTVDraw = class(TSnippetsTVDraw) /// /// TVaultID. Associated vault ID. If Node has /// no associated vault then a null vault ID is returned. - function GetCollectionID(const Node: TTreeNode): TVaultID; + function GetVaultID(const Node: TTreeNode): TVaultID; override; function IsErrorNode(const Node: TTreeNode): Boolean; @@ -517,8 +517,7 @@ constructor TDependenciesDlg.TTVDraw.Create( fRootID := RootID; end; -function TDependenciesDlg.TTVDraw.GetCollectionID( - const Node: TTreeNode): TVaultID; +function TDependenciesDlg.TTVDraw.GetVaultID(const Node: TTreeNode): TVaultID; begin if not Assigned(Node.Data) then Result := TVaultID.CreateNull diff --git a/Src/FrOverview.pas b/Src/FrOverview.pas index 7a86b80cf..09dd79dea 100644 --- a/Src/FrOverview.pas +++ b/Src/FrOverview.pas @@ -89,13 +89,13 @@ TOverviewFrame = class(TTitledFrame, } TTVDraw = class(TSnippetsTVDraw) strict protected - /// Gets the collection ID, if any, associated with a tree - /// node. + /// Gets the vault ID, if any, associated with a tree node. + /// /// TTreeNode [in] Node to be checked. /// /// TVaultID. Associated vault ID. If Node has /// no associated vault then a null vault ID is returned. - function GetCollectionID(const Node: TTreeNode): TVaultID; + function GetVaultID(const Node: TTreeNode): TVaultID; override; function IsSectionHeadNode(const Node: TTreeNode): Boolean; @@ -977,8 +977,7 @@ procedure TOverviewFrame.UpdateTreeState(const State: TTreeNodeAction); { TOverviewFrame.TTVDraw } -function TOverviewFrame.TTVDraw.GetCollectionID(const Node: TTreeNode): - TVaultID; +function TOverviewFrame.TTVDraw.GetVaultID(const Node: TTreeNode): TVaultID; var ViewItem: IView; // view item represented by node SnippetView: ISnippetView; // view item if node represents a snippet diff --git a/Src/FrSelectSnippetsBase.pas b/Src/FrSelectSnippetsBase.pas index fbacfe843..09278872f 100644 --- a/Src/FrSelectSnippetsBase.pas +++ b/Src/FrSelectSnippetsBase.pas @@ -50,13 +50,13 @@ TSelectSnippetsBaseFrame = class(TCheckedTVFrame) TTVDraw = class(TSnippetsTVDraw) strict protected - /// Gets the collection ID, if any, associated with a tree - /// node. + /// Gets the vault ID, if any, associated with a tree node. + /// /// TTreeNode [in] Node to be checked. /// /// TVaultID. Associated vault ID. If Node has /// no associated vault then a null vault ID is returned. - function GetCollectionID(const Node: TTreeNode): TVaultID; + function GetVaultID(const Node: TTreeNode): TVaultID; override; function IsSectionHeadNode(const Node: TTreeNode): Boolean; @@ -274,7 +274,7 @@ function TSelectSnippetsBaseFrame.SnippetFromNode( { TSelectSnippetsBaseFrame.TTVDraw } -function TSelectSnippetsBaseFrame.TTVDraw.GetCollectionID( +function TSelectSnippetsBaseFrame.TTVDraw.GetVaultID( const Node: TTreeNode): TVaultID; var SnipObj: TObject; // object referenced in Node.Data diff --git a/Src/USnippetsTVDraw.pas b/Src/USnippetsTVDraw.pas index 2f3c7036a..abdb15fc7 100644 --- a/Src/USnippetsTVDraw.pas +++ b/Src/USnippetsTVDraw.pas @@ -37,7 +37,7 @@ TSnippetsTVDraw = class abstract(TObject) /// TTreeNode [in] Node to be checked. /// TVaultID. Associated vault ID. If Node has no /// associated vault then a null vault ID is returned. - function GetCollectionID(const Node: TTreeNode): TVaultID; + function GetVaultID(const Node: TTreeNode): TVaultID; virtual; abstract; function IsSectionHeadNode(const Node: TTreeNode): Boolean; @@ -125,7 +125,7 @@ procedure TSnippetsTVDraw.CustomDrawItem(Sender: TCustomTreeView; TV.Canvas.Font.Color := Preferences.GroupHeadingColour else TV.Canvas.Font.Color := - Preferences.GetSnippetHeadingColour(GetCollectionID(Node)); + Preferences.GetSnippetHeadingColour(GetVaultID(Node)); TV.Canvas.Brush.Color := TV.Color; end; if IsSectionHeadNode(Node) then From 7ba369c6c6cc28674702a104fdee4f0826e4245c Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 13:00:13 +0000 Subject: [PATCH 181/222] Renaming in FmDuplicateSnippetDlg unit Renamed various indetifiers and controls that referred to collections to refer to vaults instead. Updated captions etc. similarly. Updated comments re change from collections to vaults. --- Src/FmDuplicateSnippetDlg.dfm | 10 +++--- Src/FmDuplicateSnippetDlg.pas | 58 +++++++++++++++++------------------ 2 files changed, 33 insertions(+), 35 deletions(-) diff --git a/Src/FmDuplicateSnippetDlg.dfm b/Src/FmDuplicateSnippetDlg.dfm index f1d4bc692..08dce8e37 100644 --- a/Src/FmDuplicateSnippetDlg.dfm +++ b/Src/FmDuplicateSnippetDlg.dfm @@ -25,13 +25,13 @@ inherited DuplicateSnippetDlg: TDuplicateSnippetDlg Caption = '&Snippet' FocusControl = edDisplayName end - object lblCollection: TLabel + object lblVaults: TLabel Left = 0 Top = 116 - Width = 50 + Width = 28 Height = 13 - Caption = '&Collection:' - FocusControl = cbCollection + Caption = '&Vault:' + FocusControl = cbVaults end object cbCategory: TComboBox Left = 0 @@ -59,7 +59,7 @@ inherited DuplicateSnippetDlg: TDuplicateSnippetDlg Caption = '&Edit in Snippets Editor' TabOrder = 2 end - object cbCollection: TComboBox + object cbVaults: TComboBox Left = 0 Top = 135 Width = 222 diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 25e53728b..613d69346 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2012-2023, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a dialogue box which can create a duplicate copy of asnippet. + * Implements a dialogue box which can create a duplicate copy of a snippet. } @@ -39,8 +39,8 @@ TDuplicateSnippetDlg = class(TGenericOKDlg, INoPublicConstruct) edDisplayName: TEdit; lblCategory: TLabel; lblDisplayName: TLabel; - lblCollection: TLabel; - cbCollection: TComboBox; + lblVaults: TLabel; + cbVaults: TComboBox; procedure btnOKClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); @@ -60,12 +60,12 @@ TPersistentOptions = class(TObject) var fSnippet: TSnippet; fCatList: TCategoryListAdapter; - fCollList: TVaultListAdapter; + fVaultList: TVaultListAdapter; fOptions: TPersistentOptions; fSnippetKey: string; - /// Returns the ID of the vault selected in the collections drop - /// down list, or the null vault ID if no vault is selected. - function SelectedCollectionID: TVaultID; + /// Returns the ID of the vault selected in the vaults drop down + /// list, or the null vault ID if no vault is selected. + function SelectedVaultID: TVaultID; function SelectedCategoryID: string; procedure ValidateData; procedure HandleException(const E: Exception); @@ -117,7 +117,7 @@ procedure TDuplicateSnippetDlg.ArrangeForm; [ lblDisplayName, edDisplayName, lblCategory, cbCategory, - lblCollection, cbCollection, + lblVaults, cbVaults, chkEdit ], 0 @@ -127,9 +127,9 @@ procedure TDuplicateSnippetDlg.ArrangeForm; TCtrlArranger.MoveBelow(lblDisplayName, edDisplayName, 4); TCtrlArranger.MoveBelow(edDisplayName, lblCategory, 8); TCtrlArranger.MoveBelow(lblCategory, cbCategory, 4); - TCtrlArranger.MoveBelow(cbCategory, lblCollection, 8); - TCtrlArranger.MoveBelow(lblCollection, cbCollection, 4); - TCtrlArranger.MoveBelow(cbCollection, chkEdit, 20); + TCtrlArranger.MoveBelow(cbCategory, lblVaults, 8); + TCtrlArranger.MoveBelow(lblVaults, cbVaults, 4); + TCtrlArranger.MoveBelow(cbVaults, chkEdit, 20); pnlBody.ClientWidth := Max( TCtrlArranger.TotalControlWidth(pnlBody) + 8, @@ -145,7 +145,7 @@ procedure TDuplicateSnippetDlg.btnOKClick(Sender: TObject); try ValidateData; fSnippetKey := (Database as IDatabaseEdit).GetUniqueSnippetKey( - SelectedCollectionID + SelectedVaultID ); UpdateDatabase; except @@ -195,22 +195,22 @@ procedure TDuplicateSnippetDlg.HandleException(const E: Exception); procedure TDuplicateSnippetDlg.InitForm; var SnippetCat: TCategory; - SnippetColl: TVault; + SnippetVault: TVault; begin inherited; edDisplayName.Text := fSnippet.DisplayName; fCatList.ToStrings(cbCategory.Items); - fCollList.ToStrings(cbCollection.Items); + fVaultList.ToStrings(cbVaults.Items); Assert(cbCategory.Items.Count > 0, ClassName + '.InitForm: no categories'); - Assert(cbCollection.Items.Count > 0, ClassName + '.InitForm: no collections'); + Assert(cbVaults.Items.Count > 0, ClassName + '.InitForm: no vaults'); SnippetCat := Database.Categories.Find(fSnippet.Category); Assert(Assigned(SnippetCat), ClassName + '.InitForm: invalid category'); cbCategory.ItemIndex := cbCategory.Items.IndexOf(SnippetCat.Description); - SnippetColl := TVaults.Instance.GetVault(fSnippet.VaultID); - cbCollection.ItemIndex := cbCollection.Items.IndexOf(SnippetColl.Name); + SnippetVault := TVaults.Instance.GetVault(fSnippet.VaultID); + cbVaults.ItemIndex := cbVaults.Items.IndexOf(SnippetVault.Name); chkEdit.Checked := fOptions.EditSnippetOnClose; end; @@ -222,11 +222,11 @@ function TDuplicateSnippetDlg.SelectedCategoryID: string; Result := fCatList.CatID(cbCategory.ItemIndex); end; -function TDuplicateSnippetDlg.SelectedCollectionID: TVaultID; +function TDuplicateSnippetDlg.SelectedVaultID: TVaultID; begin - Assert(cbCollection.ItemIndex >= 0, - ClassName + '.SelectedCollectionID: no collection selected'); - Result := fCollList.Vault(cbCollection.ItemIndex).UID; + Assert(cbVaults.ItemIndex >= 0, + ClassName + '.SelectedVaultID: no vault selected'); + Result := fVaultList.Vault(cbVaults.ItemIndex).UID; end; procedure TDuplicateSnippetDlg.UpdateDatabase; @@ -234,7 +234,7 @@ procedure TDuplicateSnippetDlg.UpdateDatabase; (Database as IDatabaseEdit).DuplicateSnippet( fSnippet, fSnippetKey, - SelectedCollectionID, + SelectedVaultID, StrTrim(edDisplayName.Text), SelectedCategoryID ); @@ -243,35 +243,33 @@ procedure TDuplicateSnippetDlg.UpdateDatabase; procedure TDuplicateSnippetDlg.ValidateData; resourcestring sNoCategory = 'You must choose a category'; - sNoCollection = 'You must choose a collection'; + sNoVault = 'You must choose a vault'; sNoDisplayName = 'You must provide a display name'; begin if StrTrim(edDisplayName.Text) = '' then raise EDataEntry.Create(sNoDisplayName, edDisplayName); if cbCategory.ItemIndex = -1 then raise EDataEntry.Create(sNoCategory, cbCategory); - if cbCollection.ItemIndex = -1 then - raise EDataEntry.Create(sNoCollection, cbCollection); + if cbVaults.ItemIndex = -1 then + raise EDataEntry.Create(sNoVault, cbVaults); end; procedure TDuplicateSnippetDlg.FormCreate(Sender: TObject); begin inherited; fCatList := TCategoryListAdapter.Create(Database.Categories); - fCollList := TVaultListAdapter.Create; + fVaultList := TVaultListAdapter.Create; fOptions := TPersistentOptions.Create; end; procedure TDuplicateSnippetDlg.FormDestroy(Sender: TObject); begin if (ModalResult = mrOK) and chkEdit.Checked then - TUserDBMgr.EditSnippet( - TSnippetID.Create(fSnippetKey, SelectedCollectionID) - ); + TUserDBMgr.EditSnippet(TSnippetID.Create(fSnippetKey, SelectedVaultID)); fOptions.EditSnippetOnClose := chkEdit.Checked; inherited; fOptions.Free; - fCollList.Free; + fVaultList.Free; fCatList.Free; end; From 78a68f8fa1ff68b8af5a6c955bb6abf64d6d030c Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 21:30:38 +0000 Subject: [PATCH 182/222] Renaming in favourites units Renamed local variables that reference collections to refer to vaults in both Favourites.UPersist and FmFavouritesDlg units. --- Src/Favourites.UPersist.pas | 10 ++++------ Src/FmFavouritesDlg.pas | 6 +++--- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index 4eaf7fdf6..bacbdb590 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -99,18 +99,16 @@ class procedure TFavouritesPersist.Load(Favourites: TFavourites); procedure (AFields: TArray) var Key: string; - CollectionID: TVaultID; + VaultID: TVaultID; LastAccess: TDateTime; begin if Length(AFields) <> 3 then raise EFavouritesPersist.Create(sBadFormat); Key := StrTrim(AFields[0]); - CollectionID := TVaultID.CreateFromHexString( - StrTrim(AFields[1]) - ); + VaultID := TVaultID.CreateFromHexString(StrTrim(AFields[1])); LastAccess := StrToDateTime(StrTrim(AFields[2]), DateFormatSettings); - if Database.Snippets.Find(Key, CollectionID) <> nil then - Favourites.Add(TSnippetID.Create(Key, CollectionID), LastAccess); + if Database.Snippets.Find(Key, VaultID) <> nil then + Favourites.Add(TSnippetID.Create(Key, VaultID), LastAccess); end ); finally diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index 12a798dfb..746ebdf65 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -587,11 +587,11 @@ class function TFavouritesDlg.IsDisplayed: Boolean; procedure TFavouritesDlg.LVCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); var - CollectionID: TVaultID; + VaultID: TVaultID; begin - CollectionID := (Item as TFavouriteListItem).Favourite.SnippetID.VaultID; + VaultID := (Item as TFavouriteListItem).Favourite.SnippetID.VaultID; fLVFavs.Canvas.Font.Color := Preferences.GetSnippetHeadingColour( - CollectionID + VaultID ); end; From 9843ef2dbbb83395b0a34812f1bb0606e5950128 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 21:33:23 +0000 Subject: [PATCH 183/222] Renaming in FmSelectionSearchDlg unit Renamed various identifiers, including methods and private class, that referred to collections to refer to vaults. Similar renamed some controls and changed a caption. Updated some XMLDoc comments re the changes. --- Src/FmSelectionSearchDlg.dfm | 8 ++-- Src/FmSelectionSearchDlg.pas | 84 ++++++++++++++++++------------------ 2 files changed, 45 insertions(+), 47 deletions(-) diff --git a/Src/FmSelectionSearchDlg.dfm b/Src/FmSelectionSearchDlg.dfm index 9373a5513..687078e14 100644 --- a/Src/FmSelectionSearchDlg.dfm +++ b/Src/FmSelectionSearchDlg.dfm @@ -78,12 +78,12 @@ inherited SelectionSearchDlg: TSelectionSearchDlg TabOrder = 5 OnClick = btnCollapseAllClick end - object btnCollection: TBitBtn + object btnVaults: TBitBtn Left = 287 Top = 63 Width = 91 Height = 25 - Caption = 'Collectio&n' + Caption = '&Vault' DoubleBuffered = True Glyph.Data = { F6000000424DF600000000000000760000002800000010000000100000000100 @@ -97,13 +97,13 @@ inherited SelectionSearchDlg: TSelectionSearchDlg Layout = blGlyphRight ParentDoubleBuffered = False TabOrder = 3 - OnClick = btnCollectionClick + OnClick = btnVaultsClick end end inherited btnOK: TButton OnClick = btnOKClick end - object mnuCollections: TPopupMenu + object mnuVaults: TPopupMenu Left = 72 Top = 72 end diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index 1430206ae..dcb246ffc 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -51,12 +51,12 @@ TSelectionSearchDlg = class(TGenericOKDlg, INoPublicConstruct) btnExpandAll: TButton; btnCollapseAll: TButton; lblOverwriteSearch: TLabel; - btnCollection: TBitBtn; - mnuCollections: TPopupMenu; + btnVaults: TBitBtn; + mnuVaults: TPopupMenu; procedure btnClearAllClick(Sender: TObject); procedure btnOKClick(Sender: TObject); procedure btnSelectAllClick(Sender: TObject); - procedure btnCollectionClick(Sender: TObject); + procedure btnVaultsClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnExpandAllClick(Sender: TObject); procedure btnCollapseAllClick(Sender: TObject); @@ -73,23 +73,23 @@ TSelectionSearchDlg = class(TGenericOKDlg, INoPublicConstruct) @param Sender [in] Not used. } - /// Selects all snippets from the given collection. - /// TVaultID ID of the required vault. + /// Selects all snippets from the given vault. + /// TVaultID ID of the required vault. /// - procedure SelectDB(const ACollectionID: TVaultID); + procedure SelectDB(const AVaultID: TVaultID); - /// Populates collections pop-up menu with menu items. - procedure PopulateCollectionsMenu; + /// Populates vault pop-up menu with menu items. + procedure PopulateVaultsMenu; - /// Handles clicks on collection menu items. Selects snippets - /// belonging to the selected collection. - procedure CollectionMenuClick(Sender: TObject); + /// Handles clicks on vault menu items. Selects snippets belonging + /// to the selected vault. + procedure VaultMenuClick(Sender: TObject); strict protected procedure ConfigForm; override; - /// Initialises form. Populates collections menu and collapses + /// Initialises form. Populates vaults menu and collapses /// treeview. procedure InitForm; override; @@ -129,23 +129,23 @@ implementation type /// Custom menu item with additional property to store a compiler /// version. - TCollectionMenuItem = class(TMenuItem) + TVaultMenuItem = class(TMenuItem) strict private var - /// Value of Collection property - fCollection: TVault; + /// Value of Vault property + fVault: TVault; public /// Constructs a menu item with all required properties and event /// handlers. /// TComponent [in] Menu item's owner. - /// TVault [in] Vault whose name is + /// TVault [in] Vault whose name is /// displayed in menu item. /// TNotifyEvent [in] Reference to an event /// handler for menu item's OnClick event. - constructor Create(AOwner: TComponent; const ACollection: TVault; + constructor Create(AOwner: TComponent; const AVault: TVault; const AClickHandler: TNotifyEvent); reintroduce; /// Vault whose name is displayed in the menu item. - property Collection: TVault read fCollection write fCollection; + property Vault: TVault read fVault write fVault; end; { TSelectionSearchDlg } @@ -173,14 +173,14 @@ procedure TSelectionSearchDlg.btnCollapseAllClick(Sender: TObject); frmSelect.CollapseTree; end; -procedure TSelectionSearchDlg.btnCollectionClick(Sender: TObject); +procedure TSelectionSearchDlg.btnVaultsClick(Sender: TObject); var PopupPos: TPoint; // place where menu pops up begin PopupPos := ClientToScreen( - Point(btnCollection.Left, btnCollection.Top + btnCollection.Height) + Point(btnVaults.Left, btnVaults.Top + btnVaults.Height) ); - mnuCollections.Popup(PopupPos.X, PopupPos.Y); + mnuVaults.Popup(PopupPos.X, PopupPos.Y); end; procedure TSelectionSearchDlg.btnExpandAllClick(Sender: TObject); @@ -214,11 +214,6 @@ procedure TSelectionSearchDlg.btnSelectAllClick(Sender: TObject); frmSelect.SelectedSnippets := Database.Snippets; end; -procedure TSelectionSearchDlg.CollectionMenuClick(Sender: TObject); -begin - SelectDB((Sender as TCollectionMenuItem).Collection.UID); -end; - procedure TSelectionSearchDlg.ConfigForm; begin inherited; @@ -266,29 +261,27 @@ procedure TSelectionSearchDlg.InitForm; begin inherited; frmSelect.CollapseTree; - PopulateCollectionsMenu; + PopulateVaultsMenu; end; -procedure TSelectionSearchDlg.PopulateCollectionsMenu; +procedure TSelectionSearchDlg.PopulateVaultsMenu; /// Adds a menu item for given vault to the pop-up menu. - procedure AddMenuItem(const ACollection: TVault); + procedure AddMenuItem(const AVault: TVault); begin - mnuCollections.Items.Add( - TCollectionMenuItem.Create( - mnuCollections, ACollection, CollectionMenuClick - ) + mnuVaults.Items.Add( + TVaultMenuItem.Create(mnuVaults, AVault, VaultMenuClick) ); end; var - Collection: TVault; + Vault: TVault; begin - for Collection in TVaults.Instance do - AddMenuItem(Collection); + for Vault in TVaults.Instance do + AddMenuItem(Vault); end; -procedure TSelectionSearchDlg.SelectDB(const ACollectionID: TVaultID); +procedure TSelectionSearchDlg.SelectDB(const AVaultID: TVaultID); var Snippet: TSnippet; // references each snippet in database SnippetList: TSnippetList; // list of selected snippets @@ -296,7 +289,7 @@ procedure TSelectionSearchDlg.SelectDB(const ACollectionID: TVaultID); SnippetList := TSnippetList.Create; try for Snippet in Database.Snippets do - if Snippet.VaultID = ACollectionID then + if Snippet.VaultID = AVaultID then SnippetList.Add(Snippet); frmSelect.SelectedSnippets := SnippetList; finally @@ -322,14 +315,19 @@ procedure TSelectionSearchDlg.SetSelectedSnippets(const Value: TSnippetList); frmSelect.SelectedSnippets := Value; end; -{ TCollectionMenuItem } +procedure TSelectionSearchDlg.VaultMenuClick(Sender: TObject); +begin + SelectDB((Sender as TVaultMenuItem).Vault.UID); +end; + +{ TVaultMenuItem } -constructor TCollectionMenuItem.Create(AOwner: TComponent; - const ACollection: TVault; const AClickHandler: TNotifyEvent); +constructor TVaultMenuItem.Create(AOwner: TComponent; const AVault: TVault; + const AClickHandler: TNotifyEvent); begin inherited Create(AOwner); - Caption := ACollection.Name; - Collection := ACollection; + Caption := AVault.Name; + Vault := AVault; OnClick := AClickHandler; end; From 50a98399fda69ccb7bee462067c4f7ebfb6fd34b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 17:39:41 +0000 Subject: [PATCH 184/222] Renaming in FmSnippetsEditorDlg unit Renamed identifiers, and renamed + updated controls to change references to collection to vaults. Updated comments to refer to vaults instead of collections + some other comment corrections. --- Src/FmSnippetsEditorDlg.dfm | 17 ++++---- Src/FmSnippetsEditorDlg.pas | 86 +++++++++++++++++-------------------- 2 files changed, 48 insertions(+), 55 deletions(-) diff --git a/Src/FmSnippetsEditorDlg.dfm b/Src/FmSnippetsEditorDlg.dfm index 92c6a994b..4cd3888bb 100644 --- a/Src/FmSnippetsEditorDlg.dfm +++ b/Src/FmSnippetsEditorDlg.dfm @@ -90,21 +90,20 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Caption = 'Displa&y Name:' FocusControl = edDisplayName end - object lblCollection: TLabel + object lblVaults: TLabel Left = 3 Top = 10 - Width = 50 + Width = 28 Height = 13 - Caption = 'C&ollection:' - FocusControl = cbCollection + Caption = '&Vault:' + FocusControl = cbVaults end - object lblCollectionInfo: TLabel + object lblVaultInfo: TLabel Left = 411 Top = 10 - Width = 76 + Width = 54 Height = 13 - Caption = 'lblCollectionInfo' - FocusControl = cbCollection + Caption = 'lblVaultInfo' end object edSourceCode: TMemo Left = 4 @@ -191,7 +190,7 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg Caption = 'Synta&x highlight this snippet as Pascal code' TabOrder = 7 end - object cbCollection: TComboBox + object cbVaults: TComboBox Left = 93 Top = 7 Width = 298 diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 4b70297ac..5ab6ffb97 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -5,8 +5,7 @@ * * Copyright (C) 2008-2023, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a dialogue box that enables the user to create or edit user - * defined snippets. + * Implements a dialogue box that enables the user to create or edit snippets. } @@ -58,8 +57,7 @@ interface { TSnippetsEditorDlg: - Dialog box class that enables the user to create or edit a user defined - snippet. + Dialog box class that enables the user to create or edit a snippet. } TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) alMain: TActionList; @@ -142,9 +140,9 @@ TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) actClearUnits: TAction; miClearUnits: TMenuItem; miSpacer3: TMenuItem; - lblCollection: TLabel; - cbCollection: TComboBox; - lblCollectionInfo: TLabel; + lblVaults: TLabel; + cbVaults: TComboBox; + lblVaultInfo: TLabel; procedure actAddUnitExecute(Sender: TObject); procedure actAddUnitUpdate(Sender: TObject); procedure actCompileExecute(Sender: TObject); @@ -185,7 +183,7 @@ TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) strict private fSnippet: TSnippet; // Snippet being edited: nil for new snippet fCatList: TCategoryListAdapter; // Accesses sorted list of categories - fCollList: TVaultListAdapter; // Accesses sorted list of collections + fVaultList: TVaultListAdapter; // Accesses sorted list of vaults fSnipKindList: TSnipKindListAdapter; // Accesses sorted list of snippet kinds fEditData: TSnippetEditData; // Record storing a snippet's editable data @@ -207,15 +205,15 @@ TSnippetsEditorDlg = class(TGenericOKDlg, INoPublicConstruct) /// For a new snippet the return value is the vault to be applied /// to the snippet. For an existing snippet this is the value to which the /// snippet already belongs. - function SelectedCollectionID: TVaultID; + function SelectedVaultID: TVaultID; /// Returns a snippet key that is unique with the current - /// snippet collection. + /// snippet vault. /// string. The required key. /// For a new snippet this key will change depending each time the /// method is called, and will always be unique within the selected - /// collection. For an existing snippet the key is always that of the - /// snippet and never changes across method calls. + /// vault. For an existing snippet the key is always that of the snippet + /// and never changes across method calls. function UniqueSnippetKey: string; procedure PopulateControls; @@ -470,7 +468,7 @@ procedure TSnippetsEditorDlg.actViewDependenciesExecute(Sender: TObject); fDependsCLBMgr.GetCheckedSnippets(DependsList); TDependenciesDlg.Execute( Self, - TSnippetID.Create(UniqueSnippetKey, SelectedCollectionID), + TSnippetID.Create(UniqueSnippetKey, SelectedVaultID), StrTrim(edDisplayName.Text), DependsList, [tiDependsUpon], @@ -601,7 +599,7 @@ procedure TSnippetsEditorDlg.ArrangeForm; // Column 1 TCtrlArranger.AlignLefts( [ - lblCollection, lblDisplayName, lblDescription, lblKind, lblCategories, + lblVaults, lblDisplayName, lblDescription, lblKind, lblCategories, lblSourceCode, edSourceCode ], 3 @@ -609,11 +607,11 @@ procedure TSnippetsEditorDlg.ArrangeForm; // Column 2 TCtrlArranger.AlignLefts( [ - cbCollection, lblCollectionInfo, edDisplayName, frmDescription, cbKind, + cbVaults, lblVaultInfo, edDisplayName, frmDescription, cbKind, cbCategories ], TCtrlArranger.RightOf( - [lblCollection, lblDisplayName, lblDescription, lblKind, lblCategories], + [lblVaults, lblDisplayName, lblDescription, lblKind, lblCategories], 12 ) ); @@ -623,12 +621,10 @@ procedure TSnippetsEditorDlg.ArrangeForm; ); frmDescription.Width := btnViewDescription.Left - frmDescription.Left - 8; // Row 1 - TCtrlArranger.AlignVCentres( - 3, [lblCollection, cbCollection, lblCollectionInfo] - ); + TCtrlArranger.AlignVCentres(3, [lblVaults, cbVaults, lblVaultInfo]); // Row 2 TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf([lblCollection, cbCollection], 8), + TCtrlArranger.BottomOf([lblVaults, cbVaults], 8), [lblDisplayName, edDisplayName] ); // Row 3 @@ -702,7 +698,7 @@ procedure TSnippetsEditorDlg.btnOKClick(Sender: TObject); else begin (Database as IDatabaseEdit).AddSnippet( - UniqueSnippetKey, SelectedCollectionID, fEditData + UniqueSnippetKey, SelectedVaultID, fEditData ) end; except @@ -748,7 +744,7 @@ function TSnippetsEditorDlg.CreateTempSnippet: TSnippet; // Create snippet object from entered data EditData.Assign(UpdateData); Result := (Database as IDatabaseEdit).CreateTempSnippet( - UniqueSnippetKey, SelectedCollectionID, EditData + UniqueSnippetKey, SelectedVaultID, EditData ); end; @@ -821,7 +817,7 @@ procedure TSnippetsEditorDlg.FormCreate(Sender: TObject); begin inherited; fCatList := TCategoryListAdapter.Create(Database.Categories); - fCollList := TVaultListAdapter.Create; + fVaultList := TVaultListAdapter.Create; fSnipKindList := TSnipKindListAdapter.Create; fCompileMgr := TCompileMgr.Create(Self); // auto-freed fMemoCaretPosDisplayMgr := TMemoCaretPosDisplayMgr.Create; @@ -846,7 +842,7 @@ procedure TSnippetsEditorDlg.FormDestroy(Sender: TObject); FreeAndNil(fXRefsCLBMgr); FreeAndNil(fDependsCLBMgr); FreeAndNil(fSnipKindList); - FreeAndNil(fCollList); + FreeAndNil(fVaultList); FreeAndNil(fCatList); fMemoCaretPosDisplayMgr.Free; end; @@ -890,10 +886,10 @@ procedure TSnippetsEditorDlg.InitControls; frmDescription.ActiveText := fSnippet.Description; edDisplayName.Text := fSnippet.DisplayName; cbCategories.ItemIndex := fCatList.IndexOf(fSnippet.Category); - cbCollection.ItemIndex := fCollList.IndexOfUID(fSnippet.VaultID); - cbCollection.Visible := False; // can't change existing snippet collection - lblCollectionInfo.Caption := cbCollection.Text; - lblCollectionInfo.Visible := True; + cbVaults.ItemIndex := fVaultList.IndexOfUID(fSnippet.VaultID); + cbVaults.Visible := False; // can't change existing snippet vault + lblVaultInfo.Caption := cbVaults.Text; + lblVaultInfo.Visible := True; frmExtra.DefaultEditMode := emAuto; frmExtra.ActiveText := fSnippet.Extra; cbKind.ItemIndex := fSnipKindList.IndexOf(fSnippet.Kind); @@ -915,11 +911,11 @@ procedure TSnippetsEditorDlg.InitControls; cbCategories.ItemIndex := fCatList.IndexOf(TCategory.DefaultID); if cbCategories.ItemIndex = -1 then cbCategories.ItemIndex := 0; - cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); - Assert(cbCollection.ItemIndex >= 0, - ClassName + '.InitControls: No default collection in cbCollection'); - cbCollection.Visible := True; // can select collection of new snippet - lblCollectionInfo.Visible := False; + cbVaults.ItemIndex := fVaultList.IndexOfUID(TVaultID.Default); + Assert(cbVaults.ItemIndex >= 0, + ClassName + '.InitControls: No default vault in cbVaults'); + cbVaults.Visible := True; // can select vault of new snippet + lblVaultInfo.Visible := False; cbKind.ItemIndex := fSnipKindList.IndexOf(skFreeform); frmExtra.DefaultEditMode := emPlainText; frmExtra.Clear; @@ -997,19 +993,19 @@ procedure TSnippetsEditorDlg.PopulateControls; fSnipKindList.ToStrings(cbKind.Items); // Display all available categories in drop down list fCatList.ToStrings(cbCategories.Items); - // Display all available collections in drop down list - fCollList.ToStrings(cbCollection.Items); + // Display all available vaults in drop down list + fVaultList.ToStrings(cbVaults.Items); end; -function TSnippetsEditorDlg.SelectedCollectionID: TVaultID; +function TSnippetsEditorDlg.SelectedVaultID: TVaultID; begin - // If editing existing snippet ID then the collection cannot be edited + // If editing existing snippet ID then the vault cannot be edited if Assigned(fSnippet) then - // Editing existing snippet: can't change collection + // Editing existing snippet: can't change vault Result := fSnippet.VaultID else - // Editing new snippet: chosing collection is permitted - Result := fCollList.Vault(cbCollection.ItemIndex).UID; + // Editing new snippet: chosing vault is permitted + Result := fVaultList.Vault(cbVaults.ItemIndex).UID; end; procedure TSnippetsEditorDlg.SetAllCompilerResults( @@ -1026,9 +1022,7 @@ function TSnippetsEditorDlg.UniqueSnippetKey: string; if Assigned(fSnippet) then Result := fSnippet.Key else - Result := (Database as IDatabaseEdit).GetUniqueSnippetKey( - SelectedCollectionID - ); + Result := (Database as IDatabaseEdit).GetUniqueSnippetKey(SelectedVaultID); end; function TSnippetsEditorDlg.UpdateData: TSnippetEditData; @@ -1065,7 +1059,7 @@ procedure TSnippetsEditorDlg.UpdateReferences; fXRefsCLBMgr.Save; fXRefsCLBMgr.Clear; - EditSnippetID := TSnippetID.Create(UniqueSnippetKey, SelectedCollectionID); + EditSnippetID := TSnippetID.Create(UniqueSnippetKey, SelectedVaultID); EditSnippetKind := fSnipKindList.SnippetKind(cbKind.ItemIndex); {TODO -cVault: We do following kind of filtering of Database.Snippets so @@ -1075,7 +1069,7 @@ procedure TSnippetsEditorDlg.UpdateReferences; } for Snippet in Database.Snippets do begin - if Snippet.VaultID <> SelectedCollectionID then + if Snippet.VaultID <> SelectedVaultID then Continue; if Snippet.ID <> EditSnippetID then begin @@ -1118,7 +1112,7 @@ procedure TSnippetsEditorDlg.ValidateData; raise EDataEntry.Create(ErrorMessage, edSourceCode, ErrorSelection); frmExtra.Validate; if not TSnippetValidator.ValidateDependsList( - UniqueSnippetKey, SelectedCollectionID, UpdateData, ErrorMessage + UniqueSnippetKey, SelectedVaultID, UpdateData, ErrorMessage ) then raise EDataEntry.Create( // selection not applicable to list boxes StrMakeSentence(ErrorMessage) + EOL2 + sDependencyPrompt, clbDepends From 5c432178ba9a99f7d0b015529739cb922b522a1d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 17:50:10 +0000 Subject: [PATCH 185/222] Renaming in FmSWAGImportDlg unit Renamed identifiers, and renamed + updated controls to change references to collection to vaults. Updated comments to refer to vaults instead of collections + some other comment corrections. --- Src/FmSWAGImportDlg.dfm | 28 +++++------------ Src/FmSWAGImportDlg.pas | 66 +++++++++++++++++++---------------------- 2 files changed, 39 insertions(+), 55 deletions(-) diff --git a/Src/FmSWAGImportDlg.dfm b/Src/FmSWAGImportDlg.dfm index 96f67658f..112c2f536 100644 --- a/Src/FmSWAGImportDlg.dfm +++ b/Src/FmSWAGImportDlg.dfm @@ -19,16 +19,12 @@ inherited SWAGImportDlg: TSWAGImportDlg inherited pcWizard: TPageControl Width = 671 Height = 456 - ActivePage = tsIntro + ActivePage = tsUpdate ExplicitWidth = 671 ExplicitHeight = 456 object tsIntro: TTabSheet Caption = 'tsIntro' TabVisible = False - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 inline frmIntro: THTMLTpltDlgFrame Left = 0 Top = 0 @@ -59,10 +55,6 @@ inherited SWAGImportDlg: TSWAGImportDlg Caption = 'tsFolder' ImageIndex = 4 TabVisible = False - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 object lblFolder: TLabel Left = 0 Top = 8 @@ -212,17 +204,17 @@ inherited SWAGImportDlg: TSWAGImportDlg Height = 36 AutoSize = False Caption = - 'When you are ready to import the packets select the collection i' + - 'nto which you want to import them then click "Import". This step' + - ' can'#39't be undone.' + 'When you are ready to import the packets select the vault into w' + + 'hich you want to import them then click "Import". This step can'#39 + + 't be undone.' WordWrap = True end - object lblCollection: TLabel + object lblVaults: TLabel Left = 0 Top = 83 - Width = 80 + Width = 60 Height = 13 - Caption = 'Select &collection:' + Caption = 'Select &vault:' end object lvImports: TListView Left = 0 @@ -243,7 +235,7 @@ inherited SWAGImportDlg: TSWAGImportDlg TabOrder = 1 ViewStyle = vsReport end - object cbCollection: TComboBox + object cbVaults: TComboBox Left = 86 Top = 80 Width = 289 @@ -256,10 +248,6 @@ inherited SWAGImportDlg: TSWAGImportDlg Caption = 'tsFinish' ImageIndex = 3 TabVisible = False - ExplicitLeft = 0 - ExplicitTop = 0 - ExplicitWidth = 0 - ExplicitHeight = 0 inline frmOutro: THTMLTpltDlgFrame Left = 0 Top = 0 diff --git a/Src/FmSWAGImportDlg.pas b/Src/FmSWAGImportDlg.pas index 5c28fcf20..5a8964c6b 100644 --- a/Src/FmSWAGImportDlg.pas +++ b/Src/FmSWAGImportDlg.pas @@ -7,7 +7,7 @@ * * Implements a wizard dialogue box that lets the user select and import * packets from the DelphiDabbler implementation of the SWAG Pascal archive as - * new user-defined CodeSnip snippets. + * new CodeSnip snippets. } @@ -46,7 +46,7 @@ interface type /// Class that implements a wizard dialogue box that lets the user /// select and import packets from the DelphiDabbler implementation of the - /// SWAG Pascal archive as new user-defined CodeSnip snippets. + /// SWAG Pascal archive as new snippets. TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) tsIntro: TTabSheet; tsCategories: TTabSheet; @@ -75,8 +75,8 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) lblVersionNumber: TLabel; lblFolderPageInfo1: TLabel; lblUpdateDesc2: TLabel; - lblCollection: TLabel; - cbCollection: TComboBox; + lblVaults: TLabel; + cbVaults: TComboBox; /// Handles clicks on the check boxes next to packets in the /// packet selection list box by selecting and deselecting packets for /// inclusion in the import. @@ -114,9 +114,6 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) procedure FormDestroy(Sender: TObject); strict private const - {TODO -cCollections: Add combo box to select collection into which to add - imported snippets. Either add combo box to update page, or add a - new page for it before finish page or before update page.} /// Index of introductory page in wizard. cIntroPage = 0; /// Index of SWAG database folder selection page in wizard. @@ -142,23 +139,22 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) /// List of packets selected for import, sorted by ID. /// fSelectedPackets: TSortedList; - /// Object that imports selected SWAG packets into CodeSnip's - /// user database. + /// Object that imports selected SWAG packets into a specified + /// vault. fImporter: TSWAGImporter; /// ID of currently selected category. /// Set to zero if no category is selected. fCurrentCatID: Cardinal; - /// Object that populates cbCollection with an - /// alphabetical list of collection names and manages interaction with - /// it. - fCollList: TVaultListAdapter; + /// Object that populates cbVaults with an alphabetical + /// list of vault names and manages interaction with it. + fVaultList: TVaultListAdapter; /// Retrieves import directory name from edit control where it is /// entered. function GetDirNameFromEditCtrl: string; /// Retrieves vault specified by user that applies to imported /// snippets. /// TVaultID. The required vault ID. - function SelectedCollectionID: TVaultID; + function SelectedVaultID: TVaultID; /// Validates entries on the wizard page identified by the given /// page index. procedure ValidatePage(const PageIdx: Integer); @@ -202,8 +198,8 @@ TSWAGImportDlg = class(TWizardDlg, INoPublicConstruct) /// Gets the complete information for each packet selected for /// import and stores in the given list. procedure GetImportPackets(const PacketList: TList); - /// Performs the import of the selected packets as into CodeSnip's - /// user database as new user-defined snippets. + /// Performs the import of the selected packets into a specified + /// vault. /// Displays a wait dialogue box while the import is proceeding. /// procedure UpdateDatabase; @@ -370,7 +366,7 @@ procedure TSWAGImportDlg.ArrangeForm; // tsUpdate TCtrlArranger.AlignLefts( - [lblUpdateDesc1, lblUpdateDesc2, lblCollection, lvImports], 0 + [lblUpdateDesc1, lblUpdateDesc2, lblVaults, lvImports], 0 ); lblUpdateDesc1.Width := tsUpdate.ClientWidth; lblUpdateDesc2.Width := tsUpdate.ClientWidth; @@ -378,10 +374,10 @@ procedure TSWAGImportDlg.ArrangeForm; lblUpdateDesc1.Top := 3; TCtrlArranger.MoveBelow(lblUpdateDesc1, lblUpdateDesc2, 4); TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf(lblUpdateDesc2, 8), [lblCollection, cbCollection] + TCtrlArranger.BottomOf(lblUpdateDesc2, 8), [lblVaults, cbVaults] ); - TCtrlArranger.MoveToRightOf(lblCollection, cbCollection, 4); - TCtrlArranger.MoveBelow([lblCollection, cbCollection], lvImports, 12); + TCtrlArranger.MoveToRightOf(lblVaults, cbVaults, 4); + TCtrlArranger.MoveBelow([lblVaults, cbVaults], lvImports, 12); // tsFinish frmOutro.Height := frmOutro.DocHeight; @@ -531,15 +527,15 @@ procedure TSWAGImportDlg.ConfigForm; end ); - // Set up collection list - fCollList.ToStrings(cbCollection.Items); - Assert(cbCollection.Items.Count > 0, - ClassName + '.ConfigForm: no collections'); + // Set up vaults list + fVaultList.ToStrings(cbVaults.Items); + Assert(cbVaults.Items.Count > 0, + ClassName + '.ConfigForm: no vaults'); Assert(TVaults.Instance.ContainsID(TVaultID.Default), - ClassName + '.ConfigForm: default collection not found'); - cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); - Assert(cbCollection.ItemIndex >= 0, - ClassName + '.ConfigForm: default collection not in cbCollection'); + ClassName + '.ConfigForm: default vault not found'); + cbVaults.ItemIndex := fVaultList.IndexOfUID(TVaultID.Default); + Assert(cbVaults.ItemIndex >= 0, + ClassName + '.ConfigForm: default vault not in cbVaults'); end; destructor TSWAGImportDlg.Destroy; @@ -619,12 +615,12 @@ class function TSWAGImportDlg.Execute(const AOwner: TComponent): Boolean; procedure TSWAGImportDlg.FormCreate(Sender: TObject); begin inherited; - fCollList := TVaultListAdapter.Create; + fVaultList := TVaultListAdapter.Create; end; procedure TSWAGImportDlg.FormDestroy(Sender: TObject); begin - fCollList.Free; + fVaultList.Free; inherited; end; @@ -871,11 +867,11 @@ procedure TSWAGImportDlg.PreviewSelectedPacket; ); end; -function TSWAGImportDlg.SelectedCollectionID: TVaultID; +function TSWAGImportDlg.SelectedVaultID: TVaultID; begin - Assert(cbCollection.ItemIndex >= 0, - ClassName + '.SelectedCollectionID: no collection selected'); - Result := fCollList.Vault(cbCollection.ItemIndex).UID; + Assert(cbVaults.ItemIndex >= 0, + ClassName + '.SelectedVaultID: no vault selected'); + Result := fVaultList.Vault(cbVaults.ItemIndex).UID; end; procedure TSWAGImportDlg.UpdateButtons(const PageIdx: Integer); @@ -911,7 +907,7 @@ procedure TSWAGImportDlg.UpdateDatabase; procedure begin fImporter.Import( - SelectedCollectionID, + SelectedVaultID, procedure (const Packet: TSWAGPacket) begin Application.ProcessMessages; From 9117ec2d80742c4b875830b0d03337d766077ddf Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 17:59:33 +0000 Subject: [PATCH 186/222] Renaming in FrDisplayPrefs unit Renamed identifiers, and renamed + updated controls to change references to collection to vaults. Updated comments to refer to vaults instead of collections. --- Src/FrDisplayPrefs.dfm | 12 +++---- Src/FrDisplayPrefs.pas | 80 +++++++++++++++++++++--------------------- 2 files changed, 46 insertions(+), 46 deletions(-) diff --git a/Src/FrDisplayPrefs.dfm b/Src/FrDisplayPrefs.dfm index d34c1c858..bdec62876 100644 --- a/Src/FrDisplayPrefs.dfm +++ b/Src/FrDisplayPrefs.dfm @@ -18,13 +18,13 @@ inherited DisplayPrefsFrame: TDisplayPrefsFrame Height = 13 Caption = '&Group heading colour in overview pane:' end - object lblCollectionColours: TLabel + object lblVaultColours: TLabel Left = 16 Top = 139 - Width = 240 + Width = 220 Height = 13 - Caption = 'Heading colour snippets from different &collections:' - FocusControl = cbCollection + Caption = 'Heading colour snippets from different &vaults:' + FocusControl = cbVaults end object lblSourceBGColour: TLabel Left = 16 @@ -112,13 +112,13 @@ inherited DisplayPrefsFrame: TDisplayPrefsFrame TabOrder = 5 OnChange = FontSizeChange end - object cbCollection: TComboBox + object cbVaults: TComboBox Left = 16 Top = 158 Width = 170 Height = 21 Style = csDropDownList TabOrder = 6 - OnChange = cbCollectionChange + OnChange = cbVaultsChange end end diff --git a/Src/FrDisplayPrefs.pas b/Src/FrDisplayPrefs.pas index 6a1746148..94c204c65 100644 --- a/Src/FrDisplayPrefs.pas +++ b/Src/FrDisplayPrefs.pas @@ -41,7 +41,7 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) chkHideEmptySections: TCheckBox; chkSnippetsInNewTab: TCheckBox; lblGroupHeadingColour: TLabel; - lblCollectionColours: TLabel; + lblVaultColours: TLabel; btnDefColours: TButton; lblSourceBGColour: TLabel; lblOverviewFontSize: TLabel; @@ -49,18 +49,18 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) lblDetailFontSize: TLabel; cbDetailFontSize: TComboBox; lblHiliterInfo: TLabel; - cbCollection: TComboBox; + cbVaults: TComboBox; procedure chkHideEmptySectionsClick(Sender: TObject); procedure btnDefColoursClick(Sender: TObject); procedure FontSizeChange(Sender: TObject); - procedure cbCollectionChange(Sender: TObject); + procedure cbVaultsChange(Sender: TObject); strict private var /// Flag indicating if changes affect UI. fUIChanged: Boolean; /// Local copy of snippet heading / tree node colour for each - /// collection. + /// vault. fSnippetHeadingColours: TDictionary; fGroupHeadingColourBox: TColorBoxEx; @@ -70,7 +70,7 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) fSourceBGColourBox: TColorBoxEx; fSourceBGColourDlg: TColorDialogEx; - fCollList: TVaultListAdapter; + fVaultList: TVaultListAdapter; procedure SelectOverviewTreeState(const State: TOverviewStartState); {Selects combo box item associated with a overview treeview startup state. @@ -88,7 +88,7 @@ TDisplayPrefsFrame = class(TPrefsBaseFrame) procedure SnippetHeadingColourBoxChange(Sender: TObject); procedure PopulateFontSizeCombos; procedure SetTabOrder; - function SelectedCollectionID: TVaultID; + function SelectedVaultID: TVaultID; public constructor Create(AOwner: TComponent); override; {Object constructor. Sets up frame and populates controls. @@ -162,11 +162,11 @@ procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences; @param Prefs [in] Object that provides info used to update controls. } var - Collection: TVault; + Vault: TVault; begin - cbCollection.ItemIndex := fCollList.IndexOfUID(TVaultID.Default); - Assert(cbCollection.ItemIndex >= 0, - ClassName + '.Activate: no default collection found in cbCollection'); + cbVaults.ItemIndex := fVaultList.IndexOfUID(TVaultID.Default); + Assert(cbVaults.ItemIndex >= 0, + ClassName + '.Activate: no default vault found in cbVaults'); SelectOverviewTreeState(Prefs.OverviewStartState); chkHideEmptySections.OnClick := nil; // prevent OnClick when Checked set chkHideEmptySections.Checked := not Prefs.ShowEmptySections; @@ -174,12 +174,12 @@ procedure TDisplayPrefsFrame.Activate(const Prefs: IPreferences; chkSnippetsInNewTab.Checked := Prefs.ShowNewSnippetsInNewTabs; fGroupHeadingColourBox.Selected := Prefs.GroupHeadingColour; fSnippetHeadingColours.Clear; - for Collection in TVaults.Instance do + for Vault in TVaults.Instance do fSnippetHeadingColours.Add( - Collection.UID, Prefs.GetSnippetHeadingColour(Collection.UID) + Vault.UID, Prefs.GetSnippetHeadingColour(Vault.UID) ); fSnippetHeadingColourBox.Selected := - Prefs.GetSnippetHeadingColour(SelectedCollectionID); + Prefs.GetSnippetHeadingColour(SelectedVaultID); fSourceBGColourBox.Selected := Prefs.SourceCodeBGcolour; Prefs.GroupHeadingCustomColours.CopyTo( fGroupHeadingColourDlg.CustomColors, True @@ -200,13 +200,13 @@ procedure TDisplayPrefsFrame.ArrangeControls; TCtrlArranger.AlignLefts( [ lblOverviewTree, chkSnippetsInNewTab, chkHideEmptySections, - lblGroupHeadingColour, lblCollectionColours, lblSourceBGColour, + lblGroupHeadingColour, lblVaultColours, lblSourceBGColour, btnDefColours, lblOverviewFontSize, lblDetailFontSize, lblHiliterInfo ], 0 ); - // Align collections combo indented from left - cbCollection.Left := 8; + // Align vaults combo indented from left + cbVaults.Left := 8; // Align controls on right: make sure they are all to right of everything // on left that is on same line as any of them. @@ -217,7 +217,7 @@ procedure TDisplayPrefsFrame.ArrangeControls; ], TCtrlArranger.RightOf( [ - lblOverviewTree, lblGroupHeadingColour, cbCollection, lblSourceBGColour, + lblOverviewTree, lblGroupHeadingColour, cbVaults, lblSourceBGColour, lblOverviewFontSize, lblDetailFontSize ], 8 @@ -243,17 +243,17 @@ procedure TDisplayPrefsFrame.ArrangeControls; // 5th row TCtrlArranger.MoveBelow( [lblGroupHeadingColour, fGroupHeadingColourBox], - lblCollectionColours, + lblVaultColours, 12 ); // 6th row TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf(lblCollectionColours, 6), - [cbCollection, fSnippetHeadingColourBox] + TCtrlArranger.BottomOf(lblVaultColours, 6), + [cbVaults, fSnippetHeadingColourBox] ); // 7th row TCtrlArranger.AlignVCentres( - TCtrlArranger.BottomOf([cbCollection, fSnippetHeadingColourBox], 18), + TCtrlArranger.BottomOf([cbVaults, fSnippetHeadingColourBox], 18), [lblSourceBGColour, fSourceBGColourBox] ); // 8th row @@ -280,22 +280,22 @@ procedure TDisplayPrefsFrame.ArrangeControls; procedure TDisplayPrefsFrame.btnDefColoursClick(Sender: TObject); var - Collection: TVault; + Vault: TVault; begin // Restores default heading and source code background colours in colour // combo boxes fGroupHeadingColourBox.Selected := clDefGroupHeading; fSnippetHeadingColourBox.Selected := clDefSnippetHeading; - for Collection in TVaults.Instance do - fSnippetHeadingColours[Collection.UID] := clDefSnippetHeading; + for Vault in TVaults.Instance do + fSnippetHeadingColours[Vault.UID] := clDefSnippetHeading; fSourceBGColourBox.Selected := clSourceBg; fUIChanged := True; end; -procedure TDisplayPrefsFrame.cbCollectionChange(Sender: TObject); +procedure TDisplayPrefsFrame.cbVaultsChange(Sender: TObject); begin fSnippetHeadingColourBox.Selected := - fSnippetHeadingColours[SelectedCollectionID]; + fSnippetHeadingColours[SelectedVaultID]; end; procedure TDisplayPrefsFrame.chkHideEmptySectionsClick(Sender: TObject); @@ -346,7 +346,7 @@ constructor TDisplayPrefsFrame.Create(AOwner: TComponent); fSnippetHeadingColourDlg, SnippetHeadingColourBoxChange ); fSnippetHeadingColourBox.OnChange := SnippetHeadingColourBoxChange; - lblCollectionColours.FocusControl := cbCollection; + lblVaultColours.FocusControl := cbVaults; fSourceBGColourBox := CreateCustomColourBox( fSourceBGColourDlg, ColourBoxChangeHandler ); @@ -358,9 +358,9 @@ constructor TDisplayPrefsFrame.Create(AOwner: TComponent); TVaultID.TComparer.Create ); - fCollList := TVaultListAdapter.Create; - fCollList.ToStrings(cbCollection.Items); - Assert(cbCollection.Items.Count > 0, ClassName + '.Create: no collections'); + fVaultList := TVaultListAdapter.Create; + fVaultList.ToStrings(cbVaults.Items); + Assert(cbVaults.Items.Count > 0, ClassName + '.Create: no vaults'); SetTabOrder; end; @@ -388,7 +388,7 @@ procedure TDisplayPrefsFrame.Deactivate(const Prefs: IPreferences); @param Prefs [in] Object used to store information. } var - Collection: TVault; + Vault: TVault; begin Prefs.ShowNewSnippetsInNewTabs := chkSnippetsInNewTab.Checked; Prefs.ShowEmptySections := not chkHideEmptySections.Checked; @@ -401,9 +401,9 @@ procedure TDisplayPrefsFrame.Deactivate(const Prefs: IPreferences); fGroupHeadingColourDlg.CustomColors, True ); - for Collection in TVaults.Instance do + for Vault in TVaults.Instance do Prefs.SetSnippetHeadingColour( - Collection.UID, fSnippetHeadingColours[Collection.UID] + Vault.UID, fSnippetHeadingColours[Vault.UID] ); Prefs.SourceCodeBGCustomColours.CopyFrom( fSourceBGColourDlg.CustomColors, True @@ -416,7 +416,7 @@ procedure TDisplayPrefsFrame.Deactivate(const Prefs: IPreferences); destructor TDisplayPrefsFrame.Destroy; begin - fCollList.Free; + fVaultList.Free; fSnippetHeadingColours.Free; inherited; end; @@ -509,11 +509,11 @@ procedure TDisplayPrefsFrame.PopulateFontSizeCombos; TFontHelper.ListCommonFontSizes(cbDetailFontSize.Items); end; -function TDisplayPrefsFrame.SelectedCollectionID: TVaultID; +function TDisplayPrefsFrame.SelectedVaultID: TVaultID; begin - Assert(cbCollection.ItemIndex >= 0, - ClassName + '.SelectedCollectionID: no collection selected'); - Result := fCollList.Vault(cbCollection.ItemIndex).UID; + Assert(cbVaults.ItemIndex >= 0, + ClassName + '.SelectedVaultID: no vault selected'); + Result := fVaultList.Vault(cbVaults.ItemIndex).UID; end; procedure TDisplayPrefsFrame.SelectOverviewTreeState( @@ -540,7 +540,7 @@ procedure TDisplayPrefsFrame.SetTabOrder; chkSnippetsInNewTab.TabOrder := 1; chkHideEmptySections.TabOrder := 2; fGroupHeadingColourBox.TabOrder := 3; - cbCollection.TabOrder := 4; + cbVaults.TabOrder := 4; fSnippetHeadingColourBox.TabOrder := 5; fSourceBGColourBox.TabOrder := 6; btnDefColours.TabOrder := 7; @@ -551,7 +551,7 @@ procedure TDisplayPrefsFrame.SetTabOrder; procedure TDisplayPrefsFrame.SnippetHeadingColourBoxChange(Sender: TObject); begin ColourBoxChangeHandler(Sender); - fSnippetHeadingColours[SelectedCollectionID] := + fSnippetHeadingColours[SelectedVaultID] := fSnippetHeadingColourBox.Selected end; From 19ae27f0376f2966b1aa8678ddeb3f926a6a4038 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 18:09:00 +0000 Subject: [PATCH 187/222] Renaming in IntfNotifer & UNotifier units Renamed method parameters that referenced collections to refer to vaults. --- Src/IntfNotifier.pas | 9 ++++----- Src/UNotifier.pas | 21 ++++++++++----------- 2 files changed, 14 insertions(+), 16 deletions(-) diff --git a/Src/IntfNotifier.pas b/Src/IntfNotifier.pas index 8ed204229..e8aa01bca 100644 --- a/Src/IntfNotifier.pas +++ b/Src/IntfNotifier.pas @@ -33,11 +33,11 @@ interface /// Displays a snippet. /// WideString [in] Required snippet's key. /// - /// TVaultID [in] ID of the snippet's vault. + /// TVaultID [in] ID of the snippet's vault. /// /// WordBool [in] Whether to display snippet in a new /// detail pane tab. - procedure DisplaySnippet(const Key: WideString; ACollectionID: TVaultID; + procedure DisplaySnippet(const Key: WideString; AVaultID: TVaultID; NewTab: WordBool); /// Displays a category. @@ -66,10 +66,9 @@ interface /// Edits a snippet in Snippets Editor. /// WideString [in] Snippet's key. - /// TVaultID [in] ID of the snippet's vault. + /// TVaultID [in] ID of the snippet's vault. /// - procedure EditSnippet(const Key: WideString; - const ACollectionID: TVaultID); + procedure EditSnippet(const Key: WideString; const AVaultID: TVaultID); /// Displays news items from the CodeSnip news feed. procedure ShowNews; diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index 85045d010..d27751eac 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -67,12 +67,12 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) /// Displays a snippet. /// WideString [in] Required snippet's key. /// - /// TVaultID [in] ID of the snippet's + /// TVaultID [in] ID of the snippet's /// vault. /// WordBool [in] Whether to display snippet in a new /// detail pane tab. - procedure DisplaySnippet(const Key: WideString; - ACollectionID: TVaultID; NewTab: WordBool); + procedure DisplaySnippet(const Key: WideString; AVaultID: TVaultID; + NewTab: WordBool); /// Displays a category. /// WideString [in] ID of required category. @@ -107,11 +107,10 @@ TNotifier = class(TInterfacedObject, INotifier, ISetActions) /// Edits a snippet in Snippets Editor. /// WideString [in] Snippet's key. - /// TVaultID [in] ID of the snippet's + /// TVaultID [in] ID of the snippet's /// vault. /// Method of INotifier. - procedure EditSnippet(const Key: WideString; - const ACollectionID: TVaultID); + procedure EditSnippet(const Key: WideString; const AVaultID: TVaultID); /// Displays news items from the CodeSnip news feed. /// Methods of INotifier. @@ -231,25 +230,25 @@ procedure TNotifier.DisplayCategory(const CatID: WideString; NewTab: WordBool); end; end; -procedure TNotifier.DisplaySnippet(const Key: WideString; - ACollectionID: TVaultID; NewTab: WordBool); +procedure TNotifier.DisplaySnippet(const Key: WideString; AVaultID: TVaultID; + NewTab: WordBool); begin if Assigned(fDisplaySnippetAction) then begin (fDisplaySnippetAction as TSnippetAction).Key := Key; - (fDisplaySnippetAction as TSnippetAction).CollectionID := ACollectionID; + (fDisplaySnippetAction as TSnippetAction).CollectionID := AVaultID; (fDisplaySnippetAction as TSnippetAction).NewTab := NewTab; fDisplaySnippetAction.Execute; end; end; procedure TNotifier.EditSnippet(const Key: WideString; - const ACollectionID: TVaultID); + const AVaultID: TVaultID); begin if Assigned(fEditSnippetAction) then begin (fEditSnippetAction as TEditSnippetAction).ID := TSnippetID.Create( - Key, ACollectionID + Key, AVaultID ); fEditSnippetAction.Execute; end; From ae6dccbb1fdd398e8d6a8311ace195ddf519bfee Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 19:08:02 +0000 Subject: [PATCH 188/222] Renaming in SWAG.UImporter unit Renamed method parameters that referenced collections to refer to vaults. Updated related comments. --- Src/SWAG.UImporter.pas | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/Src/SWAG.UImporter.pas b/Src/SWAG.UImporter.pas index 453bcf04c..bc8fc3f49 100644 --- a/Src/SWAG.UImporter.pas +++ b/Src/SWAG.UImporter.pas @@ -62,9 +62,9 @@ TSWAGImporter = class(TObject) /// function BuildSnippetInfo(const SWAGPacket: TSWAGPacket): TSnippetEditData; - /// Imports (i.e. adds) the given SWAG packet into the user - /// database as a CodeSnip format snippet. - procedure ImportPacketAsSnippet(const ACollectionID: TVaultID; + /// Imports (i.e. adds) the given SWAG packet into the specified + /// vault. + procedure ImportPacketAsSnippet(const AVaultID: TVaultID; const SWAGPacket: TSWAGPacket); class procedure EnsureSWAGCategoryExists; @@ -82,13 +82,13 @@ TSWAGImporter = class(TObject) procedure IncludePacket(const SWAGPacket: TSWAGPacket); /// Imports all the required SWAG packets into the user database /// as new snippets. - /// TVaultID [in] Vault into which - /// packets are imported. + /// TVaultID [in] Vault into which packets + /// are imported. /// TProgressCallback [in] Optional callback to be /// called after each SWAG packet is imported. /// The packets that are imported are those that have been /// recorded by calling IncludePacket. - procedure Import(const ACollectionID: TVaultID; + procedure Import(const AVaultID: TVaultID; const Callback: TProgressCallback = nil); /// Description of the category in the user database used for all /// imported SWAG packets. @@ -258,7 +258,7 @@ function TSWAGImporter.ExtraBoilerplate: IActiveText; Result := fExtraBoilerplate; end; -procedure TSWAGImporter.Import(const ACollectionID: TVaultID; +procedure TSWAGImporter.Import(const AVaultID: TVaultID; const Callback: TProgressCallback); var SWAGPacket: TSWAGPacket; @@ -267,21 +267,19 @@ procedure TSWAGImporter.Import(const ACollectionID: TVaultID; begin if Assigned(Callback) then Callback(SWAGPacket); - ImportPacketAsSnippet(ACollectionID, SWAGPacket); + ImportPacketAsSnippet(AVaultID, SWAGPacket); end; end; procedure TSWAGImporter.ImportPacketAsSnippet( - const ACollectionID: TVaultID; const SWAGPacket: TSWAGPacket); + const AVaultID: TVaultID; const SWAGPacket: TSWAGPacket); var - SnippetKey: string; // unique ID of new snippet + SnippetKey: string; // unique ID of new snippet SnippetDetails: TSnippetEditData; // data describing new snippet begin - SnippetKey := (Database as IDatabaseEdit).GetUniqueSnippetKey(ACollectionID); + SnippetKey := (Database as IDatabaseEdit).GetUniqueSnippetKey(AVaultID); SnippetDetails := BuildSnippetInfo(SWAGPacket); - (Database as IDatabaseEdit).AddSnippet( - SnippetKey, ACollectionID, SnippetDetails - ); + (Database as IDatabaseEdit).AddSnippet(SnippetKey, AVaultID, SnippetDetails); end; procedure TSWAGImporter.IncludePacket(const SWAGPacket: TSWAGPacket); From 0e7672a54e669564a42397315ae9f7db72f1fe41 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 19:19:13 +0000 Subject: [PATCH 189/222] Renaming in welcome page References to collections welcome-tplt.html were changed to refer to vaults. HTML "collections" id was changed to "vaults" in welcome-tplt. The related CSS was changed similarly in detail.css. Placeholders in welcome-tplt that referred to collections were to changed to refer to vaults. The resolution of the placeholders in UDetailPageHTML were changed to match. Local variables in UDetailPageHTML that referred to collections were renamed to refer to vaults. --- Src/Res/CSS/detail.css | 2 +- Src/Res/HTML/welcome-tplt.html | 8 ++++---- Src/UDetailPageHTML.pas | 24 +++++++++++------------- 3 files changed, 16 insertions(+), 18 deletions(-) diff --git a/Src/Res/CSS/detail.css b/Src/Res/CSS/detail.css index 1df9e3dd8..6cffb8689 100644 --- a/Src/Res/CSS/detail.css +++ b/Src/Res/CSS/detail.css @@ -130,7 +130,7 @@ pre { border-bottom: 1px solid silver; } -#collections .caption { +#vaults .caption { background-color: #DBD1FF; } diff --git a/Src/Res/HTML/welcome-tplt.html b/Src/Res/HTML/welcome-tplt.html index efa372d16..3f06a8ce0 100644 --- a/Src/Res/HTML/welcome-tplt.html +++ b/Src/Res/HTML/welcome-tplt.html @@ -32,17 +32,17 @@

-
+
- Collections + Vaults
- There are <%CollectionCount%> collections in the database: + There are <%VaultCount%> vaults in the database:
    - <%CollectionList%> + <%VaultList%>
diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 448c94429..1880e09f2 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -414,9 +414,9 @@ function TWelcomePageHTML.GetTemplateResName: string; procedure TWelcomePageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); var - Collection: TVault; - CollectionCount: Integer; - CollectionList: TStringBuilder; + Vault: TVault; + VaultCount: Integer; + VaultList: TStringBuilder; Compilers: ICompilers; Compiler: ICompiler; CompilerList: TStringBuilder; @@ -426,23 +426,21 @@ procedure TWelcomePageHTML.ResolvePlaceholders(const Tplt: THTMLTemplate); 'externalScript', TJavaScript.LoadScript('external.js', etWindows1252) ); - CollectionCount := TVaults.Instance.Count; - Tplt.ResolvePlaceholderHTML( - 'CollectionCount', IntToStr(CollectionCount) - ); + VaultCount := TVaults.Instance.Count; + Tplt.ResolvePlaceholderHTML('VaultCount', IntToStr(VaultCount)); - CollectionList := TStringBuilder.Create; + VaultList := TStringBuilder.Create; try - for Collection in TVaults.Instance do - CollectionList.AppendLine( + for Vault in TVaults.Instance do + VaultList.AppendLine( THTML.CompoundTag( 'li', - THTML.Entities(Collection.Name) + THTML.Entities(Vault.Name) ) ); - Tplt.ResolvePlaceholderHTML('CollectionList', CollectionList.ToString); + Tplt.ResolvePlaceholderHTML('VaultList', VaultList.ToString); finally - CollectionList.Free; + VaultList.Free; end; Compilers := TCompilersFactory.CreateAndLoadCompilers; From d6dce15d07c50458a4f6d4d9cfa151be8368e49e Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 19:32:22 +0000 Subject: [PATCH 190/222] Renaming in USnippetAction unit Renamed the TSnippetAction.CollectionID property as VaultID & renamed related fields accordingly. Modified comments that referred to collections to refer to vaults. Updated calling in UNotifier re the property name change. --- Src/UNotifier.pas | 2 +- Src/USnippetAction.pas | 14 +++++++------- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index d27751eac..35e101359 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -236,7 +236,7 @@ procedure TNotifier.DisplaySnippet(const Key: WideString; AVaultID: TVaultID; if Assigned(fDisplaySnippetAction) then begin (fDisplaySnippetAction as TSnippetAction).Key := Key; - (fDisplaySnippetAction as TSnippetAction).CollectionID := AVaultID; + (fDisplaySnippetAction as TSnippetAction).VaultID := AVaultID; (fDisplaySnippetAction as TSnippetAction).NewTab := NewTab; fDisplaySnippetAction.Execute; end; diff --git a/Src/USnippetAction.pas b/Src/USnippetAction.pas index 5f4a44d9e..ca26a3260 100644 --- a/Src/USnippetAction.pas +++ b/Src/USnippetAction.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). * - * Custom action used to request display of a snippet by key and collection ID. + * Custom action used to request display of a snippet by key and vault ID. } @@ -32,15 +32,15 @@ interface /// Custom action used to request display of a snippet. /// /// - /// Required snippet is uniquely identified by its key and collection ID. + /// Required snippet is uniquely identified by its key and vault ID. /// TSnippetAction = class(TBasicAction, ISetNotifier) strict private var /// Value of Key property. fKey: string; - /// Value of CollectionID property. - fCollectionID: TVaultID; + /// Value of VaultID property. + fVaultID: TVaultID; /// Value of NewTab property. fNewTab: Boolean; /// Reference to Notifier object. @@ -61,9 +61,9 @@ TSnippetAction = class(TBasicAction, ISetNotifier) procedure SetNotifier(const Notifier: INotifier); /// Key of snippet to be displayed. property Key: string read fKey write fKey; - /// ID of the collection containing the snippet to be displayed. + /// ID of the vault containing the snippet to be displayed. /// - property CollectionID: TVaultID read fCollectionID write fCollectionID; + property VaultID: TVaultID read fVaultID write fVaultID; /// Flag indicating if snippet is to be displayed in a new detail /// pane tab. property NewTab: Boolean read fNewTab write fNewTab; @@ -89,7 +89,7 @@ function TSnippetAction.Execute: Boolean; Assert(Assigned(fNotifier), ClassName + '.Execute: Notifier not set'); Assert(Key <> '', ClassName + '.Execute: Key not provided'); - Snippet := Database.Snippets.Find(Key, fCollectionID); + Snippet := Database.Snippets.Find(Key, fVaultID); Assert(Assigned(Snippet), ClassName + '.Execute: Key not valid'); // Create a view item for snippet and get notifier to display it From 9c9d6efba93ad5dbe8a30272cd1476f21fffc360 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 19:40:11 +0000 Subject: [PATCH 191/222] Renaming in UPreferences unit Renamed identifiers that referred to collections to refer to vaults. Made similar changes to comments. --- Src/UPreferences.pas | 72 +++++++++++++++++++++----------------------- 1 file changed, 35 insertions(+), 37 deletions(-) diff --git a/Src/UPreferences.pas b/Src/UPreferences.pas index 4edfbdae5..0967a733c 100644 --- a/Src/UPreferences.pas +++ b/Src/UPreferences.pas @@ -170,18 +170,17 @@ interface read GetGroupHeadingCustomColours write SetGroupHeadingCustomColours; /// Gets the heading / tree node colour used for snippets from a - /// specified collection. - /// TVaultID [in] ID of required vault. + /// specified vault. + /// TVaultID [in] ID of required vault. /// /// TColor. Required colour. - function GetSnippetHeadingColour(const ACollectionID: TVaultID): - TColor; + function GetSnippetHeadingColour(const AVaultID: TVaultID): TColor; /// Sets heading / tree node colour used for snippets from a - /// specified collection. - /// TVaultID [in] ID of required vault. + /// specified vault. + /// TVaultID [in] ID of required vault. /// /// TColor. Required colour. - procedure SetSnippetHeadingColour(const ACollectionID: TVaultID; + procedure SetSnippetHeadingColour(const AVaultID: TVaultID; const Value: TColor); /// Gets custom colours available for snippet headings / tree @@ -538,19 +537,19 @@ TPreferences = class(TInterfacedObject, /// Gets the heading / tree node colour used for snippets from a /// specified vault. - /// TVaultID [in] ID of required vault. + /// TVaultID [in] ID of required vault. /// /// TColor. Required colour. /// Method of IPreferences. - function GetSnippetHeadingColour(const ACollectionID: TVaultID): TColor; + function GetSnippetHeadingColour(const AVaultID: TVaultID): TColor; /// Sets heading / tree node colour used for snippets from a - /// specified collection. - /// TVaultID [in] ID of required vault. + /// specified vault. + /// TVaultID [in] ID of required vault. /// /// TColor. Required colour. /// Method of IPreferences. - procedure SetSnippetHeadingColour(const ACollectionID: TVaultID; + procedure SetSnippetHeadingColour(const AVaultID: TVaultID; const Value: TColor); /// Gets custom colours available for snippet headings / tree @@ -558,7 +557,7 @@ TPreferences = class(TInterfacedObject, /// IStringList. String list containing custom colours. /// /// - /// All collections share this one custom colour list. + /// All vaults share this one custom colour list. /// Method of IPreferences. /// function GetSnippetHeadingCustomColours: IStringList; @@ -568,7 +567,7 @@ TPreferences = class(TInterfacedObject, /// IStringList [in] String list containing /// custom colours. /// - /// All collections share this one custom colour list. + /// All vaults share this one custom colour list. /// Method of IPreferences. /// procedure SetSnippetHeadingCustomColours(const AColours: IStringList); @@ -737,7 +736,7 @@ function Preferences: IPreferences; procedure TPreferences.Assign(const Src: IInterface); var SrcPref: IPreferences; // IPreferences interface of Src - Collection: TVault; + Vault: TVault; begin // Get IPreferences interface of given object if not Supports(Src, IPreferences, SrcPref) then @@ -754,9 +753,9 @@ procedure TPreferences.Assign(const Src: IInterface); Self.fShowNewSnippetsInNewTabs := SrcPref.ShowNewSnippetsInNewTabs; Self.fGroupHeadingColour := SrcPref.GetGroupHeadingColour; Self.fGroupHeadingCustomColours := SrcPref.GetGroupHeadingCustomColours; - for Collection in TVaults.Instance do + for Vault in TVaults.Instance do Self.SetSnippetHeadingColour( - Collection.UID, SrcPref.GetSnippetHeadingColour(Collection.UID) + Vault.UID, SrcPref.GetSnippetHeadingColour(Vault.UID) ); Self.fSnippetHeadingCustomColours := SrcPref.GetSnippetHeadingCustomColours; Self.fOverviewFontSize := SrcPref.OverviewFontSize; @@ -878,11 +877,10 @@ function TPreferences.GetShowNewSnippetsInNewTabs: Boolean; Result := fShowNewSnippetsInNewTabs; end; -function TPreferences.GetSnippetHeadingColour( - const ACollectionID: TVaultID): TColor; +function TPreferences.GetSnippetHeadingColour(const AVaultID: TVaultID): TColor; begin - if fSnippetHeadingColours.ContainsKey(ACollectionID) then - Result := fSnippetHeadingColours[ACollectionID] + if fSnippetHeadingColours.ContainsKey(AVaultID) then + Result := fSnippetHeadingColours[AVaultID] else Result := clDefSnippetHeading; end; @@ -1010,10 +1008,10 @@ procedure TPreferences.SetShowNewSnippetsInNewTabs(const Value: Boolean); fShowNewSnippetsInNewTabs := Value; end; -procedure TPreferences.SetSnippetHeadingColour( - const ACollectionID: TVaultID; const Value: TColor); +procedure TPreferences.SetSnippetHeadingColour(const AVaultID: TVaultID; + const Value: TColor); begin - fSnippetHeadingColours.AddOrSetValue(ACollectionID, Value); + fSnippetHeadingColours.AddOrSetValue(AVaultID, Value); end; procedure TPreferences.SetSnippetHeadingCustomColours( @@ -1062,7 +1060,7 @@ procedure TPreferences.SetWarnings(Warnings: IWarnings); function TPreferencesPersist.Clone: IInterface; var NewPref: IPreferences; // reference to new object's IPreferences interface - Collection: TVault; + Vault: TVault; begin // Create new object Result := TPreferences.Create; @@ -1079,9 +1077,9 @@ function TPreferencesPersist.Clone: IInterface; NewPref.ShowNewSnippetsInNewTabs := Self.fShowNewSnippetsInNewTabs; NewPref.GroupHeadingColour := Self.fGroupHeadingColour; NewPref.GroupHeadingCustomColours := Self.fGroupHeadingCustomColours; - for Collection in TVaults.Instance do + for Vault in TVaults.Instance do NewPref.SetSnippetHeadingColour( - Collection.UID, Self.GetSnippetHeadingColour(Collection.UID) + Vault.UID, Self.GetSnippetHeadingColour(Vault.UID) ); NewPref.SnippetHeadingCustomColours := Self.fSnippetHeadingCustomColours; NewPref.OverviewFontSize := Self.fOverviewFontSize; @@ -1100,7 +1098,7 @@ function TPreferencesPersist.Clone: IInterface; constructor TPreferencesPersist.Create; var Storage: ISettingsSection; // object used to access persistent storage - Collection: TVault; + Vault: TVault; const // Default margin size in millimeters cPrintPageMarginSizeMM = 25.0; @@ -1137,13 +1135,13 @@ constructor TPreferencesPersist.Create; ); fSnippetHeadingColours.Clear; - for Collection in TVaults.Instance do + for Vault in TVaults.Instance do begin fSnippetHeadingColours.AddOrSetValue( - Collection.UID, + Vault.UID, TColor( Storage.GetInteger( - 'SnippetHeadingColour:' + Collection.UID.ToHexString, + 'SnippetHeadingColour:' + Vault.UID.ToHexString, clDefSnippetHeading ) ) @@ -1211,7 +1209,7 @@ constructor TPreferencesPersist.Create; destructor TPreferencesPersist.Destroy; var Storage: ISettingsSection; // object used to access persistent storage - Collection: TVault; + Vault: TVault; begin // Wreite meta section (no sub-section name) Storage := Settings.EmptySection(ssPreferences); @@ -1234,16 +1232,16 @@ destructor TPreferencesPersist.Destroy; 'GroupHeadingCustomColour%d', fGroupHeadingCustomColours ); - for Collection in TVaults.Instance do + for Vault in TVaults.Instance do begin - if fSnippetHeadingColours.ContainsKey(Collection.UID) then + if fSnippetHeadingColours.ContainsKey(Vault.UID) then Storage.SetInteger( - 'SnippetHeadingColour:' + Collection.UID.ToHexString, - fSnippetHeadingColours[Collection.UID] + 'SnippetHeadingColour:' + Vault.UID.ToHexString, + fSnippetHeadingColours[Vault.UID] ) else Storage.SetInteger( - 'SnippetHeadingColour:' + Collection.UID.ToHexString, + 'SnippetHeadingColour:' + Vault.UID.ToHexString, clDefSnippetHeading ) end; From b664301307be1fd44748dfb3d483a97b0f0c6f91 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 19:42:45 +0000 Subject: [PATCH 192/222] Renaming in URTFCategoryDoc unit Renamed Collection local variable in TRTFCategoryDoc.Create to Vault. --- Src/URTFCategoryDoc.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index 6b3c94767..8040ff095 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -100,7 +100,7 @@ implementation constructor TRTFCategoryDoc.Create(const UseColour: Boolean); var - Collection: TVault; + Vault: TVault; begin inherited Create; fUseColour := UseColour; @@ -109,9 +109,9 @@ constructor TRTFCategoryDoc.Create(const UseColour: Boolean); fBuilder.FontTable.Add(MainFontName, rgfSwiss, 0); fBuilder.FontTable.Add(MonoFontName, rgfModern, 0); // Set up colour table - for Collection in TVaults.Instance do + for Vault in TVaults.Instance do fBuilder.ColourTable.Add( - Preferences.GetSnippetHeadingColour(Collection.UID) + Preferences.GetSnippetHeadingColour(Vault.UID) ); fBuilder.ColourTable.Add(Preferences.GroupHeadingColour); fBuilder.ColourTable.Add(clExternalLink); From e4ff323c2ee71e789ce4266809e9679a2844b96b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 19:48:59 +0000 Subject: [PATCH 193/222] Renaming in USaveUnitMgr & USnippetSourceGen units Renamed various identifiers that referred to collections to refer to vaults instead. Changed some resourcestrings to refer to vaults instead of collections. Made similar change to a TODO comment. --- Src/USaveUnitMgr.pas | 44 +++++++++++++++++++-------------------- Src/USnippetSourceGen.pas | 44 +++++++++++++++++++-------------------- 2 files changed, 44 insertions(+), 44 deletions(-) diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index 5ab0e2493..5cbc118bd 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -47,7 +47,7 @@ TSaveUnitMgr = class(TSaveSourceMgr) fUnitName: string; /// List of vaults that have contributed snippets to the source /// code being generated. - fCollections: TList; + fVaults: TList; /// Gets name of unit to be used in generated code. function UnitName: string; /// Creates a string list containing comments to be written to @@ -124,9 +124,9 @@ implementation sErrorMsg = 'Filename is not valid for a Pascal unit'; // Unit header comments sMainGenerator = 'This unit snippet was generated by %0:s %1:s on %2:s.'; - sCollection = 'The code was sourced from the %s collection.'; - sCollectionList = 'The code was sourced from the following collections:'; - sCollectionCredit = 'Collection "%0:s" is licensed under the %1:s'; + sVault = 'The code was sourced from the %s vault.'; + sVaultList = 'The code was sourced from the following vaults:'; + sVaultCredit = 'Vault "%0:s" is licensed under the %1:s'; // Output document title sDocTitle = 'Pascal unit generated by %s'; @@ -149,14 +149,14 @@ procedure TSaveUnitMgr.CheckFileName(const FileName: string; function TSaveUnitMgr.CreateHeaderComments: IStringList; {TODO -cRefactoring: This code has a lot in common with header comment - generator code in USnippetSourceGen and in TSnippetDoc.CollectionInfo + generator code in USnippetSourceGen and in TSnippetDoc.VaultInfo - extract common code.} - function CreditsLine(const ACollection: TVault): string; + function CreditsLine(const AVault: TVault): string; var MetaData: TMetaData; begin - MetaData := ACollection.MetaData; + MetaData := AVault.MetaData; Result := ''; if TMetaDataCap.License in MetaData.Capabilities then begin @@ -171,7 +171,7 @@ function TSaveUnitMgr.CreateHeaderComments: IStringList; end; var - Collection: TVault; + Vault: TVault; Credits: string; begin Result := TIStringList.Create; @@ -184,24 +184,24 @@ function TSaveUnitMgr.CreateHeaderComments: IStringList; ); Result.Add(''); - if fCollections.Count = 1 then - Result.Add(Format(sCollection, [fCollections[0].Name])) + if fVaults.Count = 1 then + Result.Add(Format(sVault, [fVaults[0].Name])) else begin - Result.Add(sCollectionList); - for Collection in fCollections do + Result.Add(sVaultList); + for Vault in fVaults do begin - Result.Add(' - ' + Collection.Name); + Result.Add(' - ' + Vault.Name); end; end; - for Collection in fCollections do + for Vault in fVaults do begin - Credits := CreditsLine(Collection); + Credits := CreditsLine(Vault); if Credits <> '' then begin Result.Add(''); - Result.Add(Format(sCollectionCredit, [Collection.Name, Credits])); + Result.Add(Format(sVaultCredit, [Vault.Name, Credits])); end; end; @@ -209,7 +209,7 @@ function TSaveUnitMgr.CreateHeaderComments: IStringList; destructor TSaveUnitMgr.Destroy; begin - fCollections.Free; + fVaults.Free; fSourceGen.Free; inherited; end; @@ -266,12 +266,12 @@ function TSaveUnitMgr.GetFileTypeDesc(const FileType: TSourceFileType): string; constructor TSaveUnitMgr.InternalCreate(const Snips: TSnippetList); var Snippet: TSnippet; // references each snippet in list - Collection: TVault; + Vault: TVault; begin Assert(Assigned(Snips), ClassName + '.InternalCreate: Snips is nil'); inherited InternalCreate; - fCollections := TList.Create(TVault.TComparer.Create); + fVaults := TList.Create(TVault.TComparer.Create); // Create source generator and initialize it with required snippets fSourceGen := TSourceGen.Create; @@ -280,9 +280,9 @@ constructor TSaveUnitMgr.InternalCreate(const Snips: TSnippetList); // Count the number of vaults containing snippet in the list for Snippet in Snips do begin - Collection := TVaults.Instance.GetVault(Snippet.VaultID); - if not fCollections.Contains(Collection) then - fCollections.Add(Collection); + Vault := TVaults.Instance.GetVault(Snippet.VaultID); + if not fVaults.Contains(Vault) then + fVaults.Add(Vault); end; end; diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index 337b62dcb..94301edfd 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -39,7 +39,7 @@ TSnippetSourceGen = class sealed(TNoPublicConstructObject) strict private /// List of vaults that have contributed snippets to the source /// code being generated. - fCollections: TList; + fVaults: TList; fGenerator: TSourceGen; {Object used to generate the source code} procedure Initialize(View: IView); @@ -112,19 +112,19 @@ function TSnippetSourceGen.BuildHeaderComments: IStringList; } var MetaData: TMetaData; - Collection: TVault; + Vault: TVault; Credits: string; resourcestring // Comment to be included at top of snippet // when snippets include those from main database sMainGenerator = 'This code snippet was generated by %0:s %1:s on %2:s.'; - sCollection = 'The code was sourced from the %s collection.'; - sCollectionList = 'The code was sourced from the following collections:'; - sCollectionCredit = 'Collection "%0:s" is licensed under the %1:s'; + sVault = 'The code was sourced from the %s vault.'; + sVaultList = 'The code was sourced from the following vaults:'; + sVaultCredit = 'Vault "%0:s" is licensed under the %1:s'; - function CreditsLine(const ACollection: TVault): string; + function CreditsLine(const AVault: TVault): string; begin - MetaData := ACollection.MetaData; + MetaData := AVault.MetaData; Result := ''; if TMetaDataCap.License in MetaData.Capabilities then Result := Result + StrMakeSentence(MetaData.LicenseInfo.NameWithURL); @@ -147,24 +147,24 @@ function TSnippetSourceGen.BuildHeaderComments: IStringList; ); Result.Add(''); - if fCollections.Count = 1 then - Result.Add(Format(sCollection, [fCollections[0].Name])) + if fVaults.Count = 1 then + Result.Add(Format(sVault, [fVaults[0].Name])) else begin - Result.Add(sCollectionList); - for Collection in fCollections do + Result.Add(sVaultList); + for Vault in fVaults do begin - Result.Add(' - ' + Collection.Name); + Result.Add(' - ' + Vault.Name); end; end; - for Collection in fCollections do + for Vault in fVaults do begin - Credits := CreditsLine(Collection); + Credits := CreditsLine(Vault); if Credits <> '' then begin Result.Add(''); - Result.Add(Format(sCollectionCredit, [Collection.Name, Credits])); + Result.Add(Format(sVaultCredit, [Vault.Name, Credits])); end; end; @@ -200,7 +200,7 @@ destructor TSnippetSourceGen.Destroy; {Class destructor. Tears down object. } begin - fCollections.Free; + fVaults.Free; fGenerator.Free; inherited; end; @@ -247,7 +247,7 @@ procedure TSnippetSourceGen.Initialize(View: IView); var Snips: TSnippetList; // list of snippets in a category to display Snippet: TSnippet; // a snippet in Snips list - Collection: TVault; + Vault: TVault; begin // Record required snippet(s) if Supports(View, ISnippetView) then @@ -255,7 +255,7 @@ procedure TSnippetSourceGen.Initialize(View: IView); // view is single snippet: just record that Snippet := (View as ISnippetView).Snippet; fGenerator.IncludeSnippet(Snippet); - fCollections.Add(TVaults.Instance.GetVault(Snippet.VaultID)); + fVaults.Add(TVaults.Instance.GetVault(Snippet.VaultID)); end else begin @@ -266,9 +266,9 @@ procedure TSnippetSourceGen.Initialize(View: IView); fGenerator.IncludeSnippets(Snips); // ignores freeform snippets for Snippet in Snips do begin - Collection := TVaults.Instance.GetVault(Snippet.VaultID); - if not fCollections.Contains(Collection) then - fCollections.Add(Collection); + Vault := TVaults.Instance.GetVault(Snippet.VaultID); + if not fVaults.Contains(Vault) then + fVaults.Add(Vault); end; finally Snips.Free; @@ -286,7 +286,7 @@ constructor TSnippetSourceGen.InternalCreate(View: IView); Assert(CanGenerate(View), ClassName + '.InternalCreate: View not supported'); inherited InternalCreate; fGenerator := TSourceGen.Create; - fCollections := TList.Create(TVault.TComparer.Create); + fVaults := TList.Create(TVault.TComparer.Create); Initialize(View); end; From eca43ec006d3fe299415d84332e7547a2315beb6 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 19:52:29 +0000 Subject: [PATCH 194/222] Renaming in USnippetIDListIOHandler unit Renamed local variables in TSnippetIDListFileReader.ParseLine that referred to collections to refer to vaults. --- Src/USnippetIDListIOHandler.pas | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Src/USnippetIDListIOHandler.pas b/Src/USnippetIDListIOHandler.pas index 8563904af..c7dd944cb 100644 --- a/Src/USnippetIDListIOHandler.pas +++ b/Src/USnippetIDListIOHandler.pas @@ -84,17 +84,17 @@ procedure TSnippetIDListFileReader.ParseLine(AFields: TArray); sBadFileFormat = 'Invalid snippet ID list file format'; var Key: string; - CollectionHex: string; - CollectionID: TVaultID; + VaultHex: string; + VaultID: TVaultID; begin Key := StrTrim(AFields[0]); if Key = '' then raise ESnippetIDListFileReader.Create(sBadFileFormat); - CollectionHex := StrTrim(AFields[1]); - if CollectionHex = '' then + VaultHex := StrTrim(AFields[1]); + if VaultHex = '' then raise ESnippetIDListFileReader.Create(sBadFileFormat); - CollectionID := TVaultID.CreateFromHexString(CollectionHex); - fSnippetIDs.Add(TSnippetID.Create(Key, CollectionID)); + VaultID := TVaultID.CreateFromHexString(VaultHex); + fSnippetIDs.Add(TSnippetID.Create(Key, VaultID)); end; function TSnippetIDListFileReader.ReadFile(const FileName: string): From 9d43820b311bb0152e876b36f3d5a762bff95dd9 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 20:02:00 +0000 Subject: [PATCH 195/222] Renaming in USnippetValidator unit Renamed ACollectionID parameter name in TSnippetValidator.ValidateDependsList method to AVaultID. Changed XMLDoc comments accordingly. --- Src/USnippetValidator.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index baf098002..4c4af42ca 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -60,8 +60,8 @@ TSnippetValidator = class(TNoConstructObject) /// /// string [in] Key of snippet for which /// dependencies are to be checked. - /// TVaultID [in] ID of the vault to - /// which snippet belongs. + /// TVaultID [in] ID of the vault to which + /// the snippet belongs. /// TSnippetEditData [in] Data describing /// properties and references of snippet for which dependencies are to be /// checked. @@ -70,7 +70,7 @@ TSnippetValidator = class(TNoConstructObject) /// Boolean. True if dependency list is valid or /// False if not. class function ValidateDependsList(const AKey: string; - const ACollectionID: TVaultID; const AData: TSnippetEditData; + const AVaultID: TVaultID; const AData: TSnippetEditData; out AErrorMsg: string): Boolean; overload; class function ValidateSourceCode(const Source: string; @@ -268,13 +268,13 @@ class function TSnippetValidator.ValidateDependsList(const Snippet: TSnippet; end; class function TSnippetValidator.ValidateDependsList(const AKey: string; - const ACollectionID: TVaultID; const AData: TSnippetEditData; + const AVaultID: TVaultID; const AData: TSnippetEditData; out AErrorMsg: string): Boolean; var TempSnippet: TSnippet; // temporary snippet that is checked for dependencies begin TempSnippet := (Database as IDatabaseEdit).CreateTempSnippet( - AKey, ACollectionID, AData + AKey, AVaultID, AData ); try Result := ValidateDependsList(TempSnippet, AErrorMsg); From 223509409da78dfabfff11a78316a4a3e18daa16 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 20:06:58 +0000 Subject: [PATCH 196/222] Renaming in UStatusBarMgr unit Changed status bar manager to display number of vaults instead of number of collections. Made related changes to local variable, resourcestring names & values and some comments. --- Src/UStatusBarMgr.pas | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/Src/UStatusBarMgr.pas b/Src/UStatusBarMgr.pas index 41fda6ac1..b15c5da8c 100644 --- a/Src/UStatusBarMgr.pas +++ b/Src/UStatusBarMgr.pas @@ -350,29 +350,29 @@ procedure TStatusBarMgr.ShowSnippetsInfo; } var TotalSnippets: Integer; // number of snippets in database - TotalCollections: Integer; // number of collections in database + TotalVaults: Integer; // number of vaults in database resourcestring // status bar message strings sSnippet = 'snippet'; sSnippets = 'snippets'; - sCollection = 'collection'; - sCollections = 'collections'; + sVault = 'vault'; + sVaults = 'vaults'; sStats = '%0:d %1:s in %2:d %3:s'; const SnippetsStr: array[Boolean] of string = (sSnippet, sSnippets); - CollectionsStr: array[Boolean] of string = (sCollection, sCollections); + VaultsStr: array[Boolean] of string = (sVault, sVaults); begin // Calculate database stats TotalSnippets := Database.Snippets.Count; - TotalCollections := TVaults.Instance.Count; + TotalVaults := TVaults.Instance.Count; // Build display text and display it fStatusBar.Panels[cDBPanel].Text := Format( sStats, [ TotalSnippets, SnippetsStr[TotalSnippets <> 1], - TotalCollections, - CollectionsStr[TotalCollections <> 1] + TotalVaults, + VaultsStr[TotalVaults <> 1] ] ); end; From 18c14758c48c44579942c7963ba0292d13a45b07 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 20:13:21 +0000 Subject: [PATCH 197/222] Renaming in UUserDBMgr unit Renamed various identifiers that referred to collection with names that refer to vaults. Made related changes to comments. Replaced "database" in some resourcestrings with "vault". --- Src/UUserDBMgr.pas | 72 ++++++++++++++++++++++------------------------ 1 file changed, 35 insertions(+), 37 deletions(-) diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index f5d0da6de..da2375db7 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -78,10 +78,10 @@ TUserDBMgr = class(TNoConstructObject) /// Moves the user database to a new location specified by the /// user. class procedure MoveDatabase; - /// Deletes all the snippets in a collection specified by the - /// user. - /// Boolean. True if the collection's data was - /// deleted, False otherwise. + /// Deletes all the snippets in a vault specified by the user. + /// + /// Boolean. True if the vault's data was deleted, + /// False otherwise. class function DeleteDatabase: Boolean; end; @@ -180,16 +180,15 @@ TRestoreThread = class(TThread) var /// Name of backup file to be restored. fBakFileName: string; - - fCollection: TVault; + + fVault: TVault; strict protected /// Restores the user database from a backup. procedure Execute; override; public /// Constructs a new, suspended, thread that can restore the /// given vault from the given backup file. - constructor Create(const BakFileName: string; - const ACollection: TVault); + constructor Create(const BakFileName: string; const AVault: TVault); end; public /// Performs the restoration of a vault from a background thread @@ -199,9 +198,9 @@ TRestoreThread = class(TThread) /// box, over which it is aligned. /// string [in] Name of backup file to be /// restored. - /// TVault Vault being restored. + /// TVault Vault being restored. class procedure Execute(AOwner: TComponent; const BakFileName: string; - const ACollection: TVault); + const AVault: TVault); end; type @@ -217,15 +216,14 @@ TBackupThread = class(TThread) /// Name of backup file to be created. fBakFileName: string; - fCollection: TVault; + fVault: TVault; strict protected /// Backs up the user database. procedure Execute; override; public /// Constructs a new, suspended, thread that can backup the /// given vault to the given backup file. - constructor Create(const BakFileName: string; - const ACollection: TVault); + constructor Create(const BakFileName: string; const AVault: TVault); end; public /// Performs a vault backup operation in a background thread and @@ -235,9 +233,9 @@ TBackupThread = class(TThread) /// box, over which it is aligned. /// string [in] Name of backup file to be /// created. - /// TVault Vault being backed up. + /// TVault Vault being backed up. class procedure Execute(AOwner: TComponent; const BakFileName: string; - const ACollection: TVault); + const AVault: TVault); end; { TUserDBMgr } @@ -257,18 +255,18 @@ class procedure TUserDBMgr.AddSnippet; class procedure TUserDBMgr.BackupDatabase(ParentCtrl: TComponent); var FileName: string; - Collection: TVault; + Vault: TVault; resourcestring sOverwritePrompt = '"%s" already exists. OK to overwrite?'; begin - if TVaultBackupDlg.Execute(ParentCtrl, FileName, Collection) then + if TVaultBackupDlg.Execute(ParentCtrl, FileName, Vault) then begin if TFile.Exists(FileName) and not TMessageBox.Confirm( ParentCtrl, Format(sOverwritePrompt, [FileName]) ) then Exit; - TUserDBBackupUI.Execute(ParentCtrl, FileName, Collection); + TUserDBBackupUI.Execute(ParentCtrl, FileName, Vault); end; end; @@ -323,13 +321,13 @@ class procedure TUserDBMgr.DeleteACategory; class function TUserDBMgr.DeleteDatabase: Boolean; var - CollectionToDelete: TVault; + VaultToDelete: TVault; begin - if not TDeleteVaultDlg.Execute(nil, CollectionToDelete) then + if not TDeleteVaultDlg.Execute(nil, VaultToDelete) then Exit(False); - if not TDirectory.Exists(CollectionToDelete.Storage.Directory) then + if not TDirectory.Exists(VaultToDelete.Storage.Directory) then Exit(False); - TDirectory.Delete(CollectionToDelete.Storage.Directory, True); + TDirectory.Delete(VaultToDelete.Storage.Directory, True); Result := True; end; @@ -441,11 +439,11 @@ class procedure TUserDBMgr.RenameACategory; class function TUserDBMgr.RestoreDatabase(ParentCtrl: TComponent): Boolean; var FileName: string; - Collection: TVault; + Vault: TVault; resourcestring sFileDoesNotExist = '"%s" does not exist.'; begin - Result := TVaultBackupDlg.Execute(ParentCtrl, FileName, Collection); + Result := TVaultBackupDlg.Execute(ParentCtrl, FileName, Vault); if Result then begin if not TFile.Exists(FileName) then @@ -456,7 +454,7 @@ class function TUserDBMgr.RestoreDatabase(ParentCtrl: TComponent): Boolean; ); Exit; end; - TUserDBRestoreUI.Execute(ParentCtrl, FileName, Collection); + TUserDBRestoreUI.Execute(ParentCtrl, FileName, Vault); end; end; @@ -514,14 +512,14 @@ procedure TUserDBSaveUI.TSaveThread.Execute; { TUserDBRestoreUI } class procedure TUserDBRestoreUI.Execute(AOwner: TComponent; - const BakFileName: string; const ACollection: TVault); + const BakFileName: string; const AVault: TVault); resourcestring // Caption for wait dialog - sWaitCaption = 'Restoring database files...'; + sWaitCaption = 'Restoring vault files...'; var Thread: TRestoreThread; // thread that performs restore operation begin - Thread := TRestoreThread.Create(BakFileName, ACollection); + Thread := TRestoreThread.Create(BakFileName, AVault); try RunThreadWithWaitDlg(Thread, AOwner, sWaitCaption); finally @@ -532,18 +530,18 @@ class procedure TUserDBRestoreUI.Execute(AOwner: TComponent; { TUserDBRestoreUI.TRestoreThread } constructor TUserDBRestoreUI.TRestoreThread.Create(const BakFileName: string; - const ACollection: TVault); + const AVault: TVault); begin inherited Create(True); fBakFileName := BakFileName; - fCollection := ACollection; + fVault := AVault; end; procedure TUserDBRestoreUI.TRestoreThread.Execute; var UserDBBackup: TVaultBackup; begin - UserDBBackup := TVaultBackup.Create(fBakFileName, fCollection); + UserDBBackup := TVaultBackup.Create(fBakFileName, fVault); try UserDBBackup.Restore; finally @@ -554,14 +552,14 @@ procedure TUserDBRestoreUI.TRestoreThread.Execute; { TUserDBBackupUI } class procedure TUserDBBackupUI.Execute(AOwner: TComponent; - const BakFileName: string; const ACollection: TVault); + const BakFileName: string; const AVault: TVault); resourcestring // Caption for wait dialog - sWaitCaption = 'Backing up database...'; + sWaitCaption = 'Backing up vault...'; var Thread: TBackupThread; // thread that performs restore operation begin - Thread := TBackupThread.Create(BakFileName, ACollection); + Thread := TBackupThread.Create(BakFileName, AVault); try RunThreadWithWaitDlg(Thread, AOwner, sWaitCaption); finally @@ -572,11 +570,11 @@ class procedure TUserDBBackupUI.Execute(AOwner: TComponent; { TUserDBBackupUI.TBackupThread } constructor TUserDBBackupUI.TBackupThread.Create(const BakFileName: string; - const ACollection: TVault); + const AVault: TVault); begin inherited Create(True); fBakFileName := BakFileName; - fCollection := ACollection; + fVault := AVault; end; procedure TUserDBBackupUI.TBackupThread.Execute; @@ -586,7 +584,7 @@ procedure TUserDBBackupUI.TBackupThread.Execute; // Dialog box caption sCaption = 'Save Backup'; begin - UserDBBackup := TVaultBackup.Create(fBakFileName, fCollection); + UserDBBackup := TVaultBackup.Create(fBakFileName, fVault); try UserDBBackup.Backup; finally From db28abb35be74b40d7979558ccc1d42691dc4a61 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 20:49:55 +0000 Subject: [PATCH 198/222] Renaming in FmDependenciesDlg unit Renamed the nested ExtractCollectionItem function in TDependenciesDlg.lbDependentsDrawItem to ExtractVaultItem. --- Src/FmDependenciesDlg.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index 6fcd47818..bf63872c9 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -419,7 +419,7 @@ procedure TDependenciesDlg.lbDependentsDrawItem(Control: TWinControl; LB: TListBox; Canvas: TCanvas; - function ExtractCollectionItem: TVaultID; + function ExtractVaultItem: TVaultID; begin Result := (LB.Items.Objects[Index] as TBox).Value; end; @@ -429,7 +429,7 @@ procedure TDependenciesDlg.lbDependentsDrawItem(Control: TWinControl; Canvas := LB.Canvas; if not (odSelected in State) then Canvas.Font.Color := Preferences.GetSnippetHeadingColour( - ExtractCollectionItem + ExtractVaultItem ); Canvas.TextRect( Rect, From be426e0c14ec6b85e54d029bc4fc3b18dac8ccf7 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 11:56:48 +0000 Subject: [PATCH 199/222] Comments & string changed in DB.IO.DataFormat.Native A single resourcestring was changed to refer to vaults instead of collections. Numerous comments were changed similarly. --- Src/DB.IO.DataFormat.Native.pas | 66 +++++++++++++++++---------------- 1 file changed, 35 insertions(+), 31 deletions(-) diff --git a/Src/DB.IO.DataFormat.Native.pas b/Src/DB.IO.DataFormat.Native.pas index 064717021..165e7d853 100644 --- a/Src/DB.IO.DataFormat.Native.pas +++ b/Src/DB.IO.DataFormat.Native.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2025, Peter Johnson (gravatar.com/delphidabbler). * - * Implements classes that can read and write collections stored in the CodeSnip + * Implements classes that can read and write vaults stored in the CodeSnip * Vault native data format. } @@ -30,8 +30,12 @@ interface type - /// Base class for classes that read and write collection data in - /// the native data format. + {TODO -cVault: Change file format to replace "collection.xml" with "vault.xml" + and "collection" tag with "vault" tag. + } + + /// Base class for classes that read and write vault data in the + /// native data format. TNativeDataRW = class abstract(TInterfacedObject) strict private var @@ -41,11 +45,11 @@ TNativeDataRW = class abstract(TInterfacedObject) fXMLDoc: IXMLDocumentEx; strict protected const - /// Name of collection's XML file. + /// Name of vault's XML file. XMLFileName = 'collection.xml'; /// Extension used for source code files. SourceCodeFileExt = '.source'; - /// Name of collection's license file, if any. + /// Name of vaults's license file, if any. LicenseTextFileName = 'license.txt'; /// Watermark included in all native data format files. /// @@ -135,7 +139,7 @@ TNativeDataRW = class abstract(TInterfacedObject) strict protected - /// Directory containing the collection. + /// Directory containing the vault. property DataDirectory: string read fDataDirectory; /// XML document object. @@ -164,21 +168,21 @@ TNativeDataRW = class abstract(TInterfacedObject) /// Returns fully specified path of the XML file. function PathToXMLFile: string; - /// Returns fully specified path of a file within the collection + /// Returns fully specified path of a file within the vault /// directory. function FilePath(const AFileName: string): string; public /// Object constructor. Creates an XML document to access the - /// collection's XML file. + /// vaults's XML file. /// string [in] Full path to the - /// directory that contains the collection's data files. + /// directory that contains the vault's data files. constructor Create(const ADataDirectory: string); end; - /// Class that performs the low level reading of collection data in + /// Class that performs the low level reading of vault data in /// CodeSnip Vault native format from an XML file and linked data files. /// TNativeDataReader = class sealed(TNativeDataRW, IDataReader) @@ -229,27 +233,27 @@ TNativeDataReader = class sealed(TNativeDataRW, IDataReader) procedure HandleException(const EObj: TObject); public - /// Object constructor. Loads XML from file if the collection - /// exists, otherwise creates a minimal empty document. + /// Object constructor. Loads XML from file if the vault exists, + /// otherwise creates a minimal empty document. /// string [in] Full path to the - /// directory that contains the collection's data files. + /// directory that contains the vault's data files. constructor Create(const ADirectory: string); - /// Checks if the collection exists. - /// Boolean. Returns True if the collection exists - /// or False if not. + /// Checks if the vault exists. + /// Boolean. Returns True if the vault exists or + /// False if not. /// /// This method is always called before any other IDataReader /// methods. If it returns False then no other IDataReader /// methods are called. Therefore other methods can safely assume that the - /// collection exists. + /// vault exists. /// Method of IDataReader. /// function DatabaseExists: Boolean; - {TODO -cRefactor: Rename DatabaseExists to CollectionExists.} + {TODO -cRefactor: Rename DatabaseExists to VaultExists.} /// Gets the unique IDs of all categories referenced in the - /// collection. + /// vault. /// IStringList. List of category IDs. /// Method of IDataReader. function GetAllCatIDs: IStringList; @@ -259,12 +263,12 @@ TNativeDataReader = class sealed(TNativeDataRW, IDataReader) /// /// TCategoryData [in/out] An empty, /// initialised, properties record is passed in and a record with the - /// properties read from the collection data is passed out. + /// properties read from the vault data is passed out. /// Method of IDataReader. procedure GetCatProps(const CatID: string; var Props: TCategoryData); /// Gets the unique keys of all snippets in a category within the - /// collection. + /// vault. /// string [in] ID of the required category. /// /// IStringList. List of snippet keys. @@ -276,13 +280,13 @@ TNativeDataReader = class sealed(TNativeDataRW, IDataReader) /// snippet. /// TSnippetData [in/out] An empty, /// initialised, properties record is passed in and a record with the - /// properties read from the collection data is passed out. + /// properties read from the vault data is passed out. /// Method of IDataReader. procedure GetSnippetProps(const SnippetKey: string; var Props: TSnippetData); - /// Gets a list of the keys of all snippets within the collection - /// that are cross-referenced by a given snippet. + /// Gets a list of the keys of all snippets within the vault that + /// are cross-referenced by a given snippet. /// string [in] Key of snippet for which /// cross references are required. /// IStringList. List of keys of cross referenced snippets. @@ -308,14 +312,14 @@ TNativeDataReader = class sealed(TNativeDataRW, IDataReader) /// Method of IDataReader. function GetSnippetUnits(const SnippetKey: string): IStringList; - /// Gets the collection's meta data. + /// Gets the vault's meta data. /// TMetaData. The required meta data. Will be null if /// is no meta data. /// Method of IDataReader. function GetMetaData: TMetaData; end; - /// Class that performs the low level writing of collection data in + /// Class that performs the low level writing of vault data in /// CodeSnip Vault native format to an XML file and linked data files. /// TNativeDataWriter = class sealed(TNativeDataRW, IDataWriter) @@ -366,7 +370,7 @@ TNativeDataWriter = class sealed(TNativeDataRW, IDataWriter) AItemNodeName: string; const AItems: IStringList); public - /// Initialises the collection write. + /// Initialises the vault write. /// /// Always called before all other IDataWriter methods. /// Method of IDataWriter. @@ -437,13 +441,13 @@ TNativeDataWriter = class sealed(TNativeDataRW, IDataWriter) procedure WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); - /// Writes the collection's meta data. + /// Writes the vault's meta data. /// TMetaData [in] Meta data to be written. /// /// Method of IDataWriter. procedure WriteMetaData(const AMetaData: TMetaData); - /// Finalises the collection write. + /// Finalises the vault write. /// /// Always called after all other IDataWriter methods. /// Method of IDataWriter. @@ -474,7 +478,7 @@ implementation sMissingNode = 'Document has no %s node.'; // TNativeDataReader error messages sParseError = 'Error parsing XML file'; - sBadDataFormat = 'Invalid native collection data format: %s'; + sBadDataFormat = 'Invalid native vault data format: %s'; sNoRootNode = 'Invalid document: no root element present'; sBadRootName = 'Invalid document: root element must be named <%s>'; sBadWatermark = 'Invalid document: watermark is incorrect'; @@ -632,7 +636,7 @@ function TNativeDataReader.GetCatSnippets(const CatID: string): IStringList; {TODO -cVault: Check the following comment and decide if this still applies. Replace Exit with exception if necessary.} // This is not an error since it is possible that a category exists in - // another collection and loader will request info from here also + // another vault and loader will request info from here also Exit(TIStringList.Create); Result := GetEnclosedListItems( CatNode, CategorySnippetsListNodeName, CategorySnippetsListItemNodeName From ba20205164f48861e925caa3d0a4b68b020ddc05 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 20:42:43 +0000 Subject: [PATCH 200/222] Update comments re change from collections to vaults Only comments were updated. Node code was changed. --- Src/DB.DataFormats.pas | 14 +++++++------- Src/DB.MetaData.pas | 24 ++++++++++++------------ Src/DBIO.UFileIOIntf.pas | 4 ++-- Src/DBIO.UIniData.pas | 17 ++++++++--------- Src/DBIO.UNulDataReader.pas | 2 +- Src/DBIO.UXMLDataIO.pas | 4 ++-- Src/UCodeImportExport.pas | 13 ++++++------- 7 files changed, 38 insertions(+), 40 deletions(-) diff --git a/Src/DB.DataFormats.pas b/Src/DB.DataFormats.pas index 37394cf98..45ba879ef 100644 --- a/Src/DB.DataFormats.pas +++ b/Src/DB.DataFormats.pas @@ -4,7 +4,7 @@ interface type - /// Enumeration of the kinds of supported snippet collection data + /// Enumeration of the kinds of supported snippet vault data /// formats. /// /// Error -- Invalid format. Used to indicate an unknown format @@ -30,7 +30,7 @@ interface ); /// Record containing details of the data format and location in - /// which a collection is stored. + /// which data is stored. TDataStorageDetails = record strict private var @@ -62,19 +62,19 @@ TMapRecord = record end; const // There are so few entries in this table it's not worth the overhead - // of using a dicitionary for the lookup. + // of using a dictionary for the lookup. LookupTable: array[0..2] of TMapRecord = ( (Kind: TDataFormatKind.Native_Vault; - Name: 'CodeSnip Vault Native Snippet Collection'), + Name: 'CodeSnip Vault Native Snippet Format'), (Kind: TDataFormatKind.Native_v4; - Name: 'CodeSnip 4 Native Snippet Collection'), + Name: 'CodeSnip 4 Native Snippet Format'), (Kind: TDataFormatKind.DCSC_v2; - Name: 'DelphiDabbler Code Snippets Collection v2') + Name: 'DelphiDabbler Code Snippets Collection v2 Format') ); class function IndexOf(const AKind: TDataFormatKind): Integer; static; public const - /// Specifies the data format used for the default collection. + /// Specifies the data format used for the default format. /// DefaultFormat = TDataFormatKind.Native_v4; public diff --git a/Src/DB.MetaData.pas b/Src/DB.MetaData.pas index 36679cd7d..cbd1a8ea5 100644 --- a/Src/DB.MetaData.pas +++ b/Src/DB.MetaData.pas @@ -5,7 +5,8 @@ * * Copyright (C) 2025, Peter Johnson (gravatar.com/delphidabbler). * - * Encapsulates a collection's data format metadata. + * Encapsulates a metadata that applies to a vault. Available metadata depends + * on that supported by a vault's chosen data format. } @@ -24,13 +25,12 @@ interface /// Enumeration of the capabilities of a data format. /// - /// - Version - supports the collection's data format version - /// number. - /// - License - supports collection license information. - /// - Copyright - supports collection copyright information. + /// - Version - supports data format version numbering. + /// - License - supports vault license information. + /// - Copyright - supports vault copyright information. /// /// - Acknowledgements - supports acknowledgements for the - /// collection. + /// vault. /// TMetaDataCap = ( Version, @@ -43,7 +43,7 @@ interface /// TMetaDataCaps = set of TMetaDataCap; - /// Record providing information about a collection's license. + /// Record providing information about a vault's license. /// TLicenseInfo = record strict private @@ -92,7 +92,7 @@ TLicenseInfo = record function NameWithURL: string; end; - /// Record providing informaton about a collection's copyright. + /// Record providing informaton about a vault's copyright. /// TCopyrightInfo = record strict private @@ -145,7 +145,7 @@ TCopyrightInfo = record function ToString: string; end; - /// Encapsulates a collection's meta data. + /// Encapsulates meta data associated with a vault. TMetaData = record strict private var @@ -180,15 +180,15 @@ TMetaData = record property Version: TVersionNumber read GetVersion write fVersion; - /// Information about the collection license. + /// Information about the vault's license. property LicenseInfo: TLicenseInfo read GetLicenseInfo write fLicenseInfo; - /// Information about the collection's copyright. + /// Information about the vault's copyright. property CopyrightInfo: TCopyrightInfo read GetCopyrightInfo write fCopyrightInfo; - /// List of acknowledgements. + /// List of acknowledgements associated with a vault. property Acknowledgements: IStringList read GetAcknowledgements write fAcknowledgements; end; diff --git a/Src/DBIO.UFileIOIntf.pas b/Src/DBIO.UFileIOIntf.pas index 0adc83a3e..767321f5d 100644 --- a/Src/DBIO.UFileIOIntf.pas +++ b/Src/DBIO.UFileIOIntf.pas @@ -79,7 +79,7 @@ interface @return List of unit names. } - /// Gets the collection's meta data. + /// Gets the vault's meta data. /// TMetaData. The required meta data. May be null if meta /// data is not supported or not present. function GetMetaData: TMetaData; @@ -138,7 +138,7 @@ interface @param XRefs [in] List of snippet keys. } - /// Write the collection's meta data. + /// Write the vault's meta data. /// TMetaData [in] Meta data to be written. /// /// Data formats may support all, some or no metadata. diff --git a/Src/DBIO.UIniData.pas b/Src/DBIO.UIniData.pas index f95a2cdcd..3bf81cceb 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DBIO.UIniData.pas @@ -10,7 +10,7 @@ } {TODO -cVault: rename INI term to DCSCv2 - this isn't a general .ini data - IO unit, the .ini format only part of a wider collection format.} + IO unit, the .ini format only part of a wider vault format.} unit DBIO.UIniData; @@ -141,7 +141,7 @@ TIniFileCache = class(TObject) /// Returns fully specified path to given file name. /// function DataFile(const FileName: string): string; - /// Checks if a given file exists in collection directory. + /// Checks if a given file exists in the vault directory. /// function DataFileExists(const FileName: string): Boolean; /// Reads all lines from given file and returns them as an array. @@ -231,15 +231,15 @@ TIniFileCache = class(TObject) /// string [in] Snippet's key. /// IStringList containing unit names. function GetSnippetUnits(const SnippetKey: string): IStringList; - /// Gets the collection's meta data. + /// Gets the vault's meta data. /// TMetaData. The required meta data. Will be null if /// is no meta data present. /// Method of IDataReader. function GetMetaData: TMetaData; end; - /// Write a collection to disk in the DelphiDabbler Code Snippets - /// collection format. + /// Write a vault to disk in the DelphiDabbler Code Snippets + /// Collection v2 format. TIniDataWriter = class sealed(TInterfacedObject, IDataWriter) strict private type @@ -381,7 +381,7 @@ TUTF8IniFileCache = class(TObject) /// /// /// NOTE: This method conforms to DelphiDabbler Code Snippets - /// collection format v2.1.x. + /// Collection format v2.1.x. /// Method of IDataWriter. /// procedure WriteSnippetProps(const SnippetKey: string; @@ -413,7 +413,7 @@ TUTF8IniFileCache = class(TObject) procedure WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); - /// Writes the collection's meta data. + /// Writes the vault's meta data. /// TMetaData [in] Meta data to be written. /// /// Method of IDataWriter. @@ -601,8 +601,7 @@ function TIniDataReader.GetCatSnippets(const CatID: string): IStringList; CatIniFile := CatToCatIni(CatID); if not TFile.Exists(CatIniFile) then // This is not an error since it is possible that a category exists in - // another collection and loader will request info from that collection - // too. + // another vault and loader will request info from that vault too. Exit; CatIni := fIniCache.GetIniFile(CatToCatIni(CatID)); SnipList := TStringList.Create; diff --git a/Src/DBIO.UNulDataReader.pas b/Src/DBIO.UNulDataReader.pas index 9f3de1043..b98522bd5 100644 --- a/Src/DBIO.UNulDataReader.pas +++ b/Src/DBIO.UNulDataReader.pas @@ -77,7 +77,7 @@ TNulDataReader = class(TInterfacedObject, @return Empty unit name list. } - /// Gets the collection's meta data. + /// Gets the vault's meta data. /// TMetaData. Null value. /// Method of IDataReader. function GetMetaData: TMetaData; diff --git a/Src/DBIO.UXMLDataIO.pas b/Src/DBIO.UXMLDataIO.pas index 88ff92dea..706505835 100644 --- a/Src/DBIO.UXMLDataIO.pas +++ b/Src/DBIO.UXMLDataIO.pas @@ -156,7 +156,7 @@ TXMLDataReader = class(TXMLDataIO, @return List of unit names. } - /// Gets the collection's meta data. + /// Gets the vault's meta data. /// TMetaData. Null value. /// /// Meta data is not supported by the data format. @@ -245,7 +245,7 @@ TXMLDataWriter = class(TXMLDataIO, @param XRefs [in] List of snippet keys. } - /// Writes the collection's meta data. + /// Writes the vault's meta data. /// TMetaData [in] Meta data to be written. /// /// diff --git a/Src/UCodeImportExport.pas b/Src/UCodeImportExport.pas index 207ac2cd2..5fa9dc5e3 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/UCodeImportExport.pas @@ -268,7 +268,7 @@ constructor TCodeExporter.InternalCreate(const SnipList: TSnippetList); fSnippetKeyMap := TDictionary.Create( TSnippetID.TComparer.Create ); - // Create map of actual snippet ID to new unique key with default collection + // Create map of actual snippet ID to new unique key with default vault for Snippet in SnipList do fSnippetKeyMap.Add( Snippet.ID, @@ -311,10 +311,10 @@ procedure TCodeExporter.WriteSnippet(const ParentNode: IXMLNode; SnippetNode: IXMLNode; // new snippet node begin // Create snippet node with attribute that specifies snippet key. - // Snippet is exported under a new, unique key within the Default collection. - // Since no collection information is saved, we need choose one collection in - // order to generate the key, and the Default collection is the only one - // guaranteed to be present. + // Snippet is exported under a new, unique key within the Default vault. + // Since no vault information is saved, we need choose one vault in order + // to generate the key, and the Default vault is the only one guaranteed to be + // present. SnippetNode := fXMLDoc.CreateElement(ParentNode, cSnippetNode); SnippetNode.Attributes[cSnippetNameAttr] := fSnippetKeyMap[Snippet.ID]; // Add nodes for properties: (ignore category and xrefs) @@ -420,8 +420,7 @@ procedure TCodeImporter.Execute(const Data: TBytes); Depends.Clear; for SnippetName in SnippetNames do // Note: in building snippet ID list we assume each snippet is from the - // default collection. It may not be, but there is no way of telling - // from XML. + // default vault. It may not be, but there is no way of telling from XML. Depends.Add(TSnippetID.Create(SnippetName, TVaultID.Default)); end; From c0ce3d838c05a983ddc76fcfd080bba8ddab1627 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 21:08:18 +0000 Subject: [PATCH 201/222] Change CodeSnip Vault native data format. Renamed "collection.xml" as "vault.xml" Within "vault.xml", renamed the outer node as . --- Src/DB.IO.DataFormat.Native.pas | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/Src/DB.IO.DataFormat.Native.pas b/Src/DB.IO.DataFormat.Native.pas index 165e7d853..c5171e0ac 100644 --- a/Src/DB.IO.DataFormat.Native.pas +++ b/Src/DB.IO.DataFormat.Native.pas @@ -30,10 +30,6 @@ interface type - {TODO -cVault: Change file format to replace "collection.xml" with "vault.xml" - and "collection" tag with "vault" tag. - } - /// Base class for classes that read and write vault data in the /// native data format. TNativeDataRW = class abstract(TInterfacedObject) @@ -46,7 +42,7 @@ TNativeDataRW = class abstract(TInterfacedObject) strict protected const /// Name of vault's XML file. - XMLFileName = 'collection.xml'; + XMLFileName = 'vault.xml'; /// Extension used for source code files. SourceCodeFileExt = '.source'; /// Name of vaults's license file, if any. @@ -61,7 +57,7 @@ TNativeDataRW = class abstract(TInterfacedObject) CurrentFileVersion: TVersionNumber = (V1: 1; V2: 0; V3: 0; V4: 0); // XML node and attribute names - RootNodeName = 'collection'; + RootNodeName = 'vault'; RootNodeWatermarkAttr = 'watermark'; RootNodeVersionMajorAttr = 'version-major'; RootNodeVersionMinorAttr = 'version-minor'; From 91b2a23f04972908cde4fa4090f02daa3ae09e4d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 11:51:43 +0000 Subject: [PATCH 202/222] Update native vault data format documentation Replaced all occurences of "collection" with "vault" where the occur in text. No change was made to the name of the root tag or .xml file name. Updated re the change of format (using instead of and "vault.xml" instead of "collection.xml". Uncommented information about , and tags. Uncommented section about license file. --- .../FileFormats/collections/native.html | 104 +++++++++--------- 1 file changed, 49 insertions(+), 55 deletions(-) diff --git a/Docs/Design/FileFormats/collections/native.html b/Docs/Design/FileFormats/collections/native.html index 30942b3c0..879242ca2 100644 --- a/Docs/Design/FileFormats/collections/native.html +++ b/Docs/Design/FileFormats/collections/native.html @@ -7,14 +7,14 @@ * * Copyright (C) 2024, Peter Johnson (gravatar.com/delphidabbler). * - * CodeSnip File Format Documentation: Native Collection Format v5 + * CodeSnip File Format Documentation: Native Vault Format --> - CodeSnip File Format Documentation - Native Collection Format + CodeSnip File Format Documentation - Native Vault Format

- Native Collection Format + Native Vault Format

@@ -63,11 +63,9 @@

  • Source Files
    • -
  • @@ -84,15 +82,15 @@

    - This file format is the default collection data format used by CodeSnip Vault. + This file format is the default vault data format used by CodeSnip Vault.

    - The format comprises a single XML file along with a number of data files located in the same directory. Each user can have zero or more snippet collections that use this format. + The format comprises a single XML file along with a number of data files located in the same directory. Each user can have zero or more snippet vaults that use this format.

    - The XML file is named collection.xml. It contains all the information about about the collection, except for the source code of each snippet. + The XML file is named vault.xml. It contains all the information about about the vault, except for the source code of each snippet.

    @@ -112,7 +110,7 @@

    - All files are text files that use UTF-8 encoding, without any UTF-8 preamble (BOM). The XML processing instruction of collection.xml has its encoding atrribute set to UTF-8. + All files are text files that use UTF-8 encoding, without any UTF-8 preamble (BOM). The XML processing instruction of vault.xml has its encoding atrribute set to UTF-8.

    • @@ -156,11 +154,11 @@

    - collection + vault

    - Parent node that contains all the collection data. + Parent node that contains all the vault data.

    Attributes: @@ -188,16 +186,16 @@

    - collection/categories + vault/categories

    - Contains a list of all categories used by the collection. + Contains a list of all categories used by the vault.

    - collection/categories/category + vault/categories/category

    @@ -217,7 +215,7 @@

    - collection/categories/category/description + vault/categories/category/description

    @@ -226,7 +224,7 @@

    - collection/categories/category/snippet-keys + vault/categories/category/snippet-keys

    @@ -235,7 +233,7 @@

    - collection/categories/category/snippet-keys/key + vault/categories/category/snippet-keys/key

    @@ -245,22 +243,22 @@

    The value must be:

      -
    • unique withing the collection
      • +
    • unique withing the vault
    • a valid Unicode Pascal identifier

    - collection/snippets + vault/snippets

    - Contains defintiions of all snippets in the collection. + Contains defintiions of all snippets in the vault.

    - collection/snippets/snippet + vault/snippets/snippet

    @@ -281,7 +279,7 @@

    The value must be:

      -
    • unique withing the collection
      • +
    • unique withing the vault
    • a valid Unicode Pascal identifier

    @@ -293,7 +291,7 @@

    The unique id of the category to which the snippet belongs.

    - The value must correspond to the id attribute of one of the collection/categories/category nodes. + The value must correspond to the id attribute of one of the vault/categories/category nodes.

    @@ -318,14 +316,14 @@

    The values are not case sensitive.

    - If collection/snippets/snippet/source-code/language has any value other than Pascal then this attribute must have value freeform. + If vault/snippets/snippet/source-code/language has any value other than Pascal then this attribute must have value freeform.

    - collection/snippets/snippet/display-name + vault/snippets/snippet/display-name

    @@ -334,7 +332,7 @@

    - collection/snippets/snippet/description + vault/snippets/snippet/description

    @@ -349,7 +347,7 @@

    - collection/snippets/snippet/notes + vault/snippets/snippet/notes

    @@ -364,7 +362,7 @@

    - collection/snippets/snippet/source-code + vault/snippets/snippet/source-code

    @@ -411,7 +409,7 @@

    - collection/snippets/snippet/compile-results + vault/snippets/snippet/compile-results

    @@ -431,7 +429,7 @@

    - collection/snippets/snippet/compile-results/compiler + vault/snippets/snippet/compile-results/compiler
    @@ -568,7 +566,7 @@

    - collection/snippets/snippet/tests + vault/snippets/snippet/tests

    @@ -624,7 +622,7 @@

    - collection/snippets/snippet/required-units + vault/snippets/snippet/required-units

    @@ -634,13 +632,13 @@

    The node may be omitted if there are no required units.

    - If collection/snippets/snippet/source-code/language has any value other than Pascal then this node has no meaning and must be omitted. + If vault/snippets/snippet/source-code/language has any value other than Pascal then this node has no meaning and must be omitted.

    - collection/snippets/snippet/required-units/unit + vault/snippets/snippet/required-units/unit

    @@ -652,7 +650,7 @@

    - collection/snippets/snippet/required-snippets + vault/snippets/snippet/required-snippets

    @@ -662,12 +660,12 @@

    The node may be omitted if there are no required snippets.

    - If collection/snippets/snippet/source-code/language has any value other than Pascal then this node has no meaning and must be omitted. + If vault/snippets/snippet/source-code/language has any value other than Pascal then this node has no meaning and must be omitted.

    - collection/snippets/snippet/required-snippets/key + vault/snippets/snippet/required-snippets/key

    @@ -676,7 +674,7 @@

    - collection/snippets/snippet/xrefs + vault/snippets/snippet/xrefs

    @@ -688,7 +686,7 @@

    - collection/snippets/snippet/xrefs/key + vault/snippets/snippet/xrefs/key

    @@ -696,13 +694,12 @@

    - @@ -882,10 +878,9 @@

    - Source code files are referenced by the file-name attribute of a snippet's collection/snippets/snippet/source-code node in the XML file. + Source code files are referenced by the file-name attribute of a snippet's vault/snippets/snippet/source-code node in the XML file.

    - From b5c29896f1caec50bd174b9cb619a6771f7fd5ab Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Tue, 4 Mar 2025 11:54:12 +0000 Subject: [PATCH 203/222] Rename directory containing vault documentation The "collections" part of the directory name was changed to "vaults" --- Docs/Design/FileFormats/{collections => vaults}/native.html | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename Docs/Design/FileFormats/{collections => vaults}/native.html (100%) diff --git a/Docs/Design/FileFormats/collections/native.html b/Docs/Design/FileFormats/vaults/native.html similarity index 100% rename from Docs/Design/FileFormats/collections/native.html rename to Docs/Design/FileFormats/vaults/native.html From eb225be13717f849d233de5f7e94a3654acac344 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 5 Mar 2025 09:51:58 +0000 Subject: [PATCH 204/222] Remove pre-processor from DCSC loading code Removed TDatabasePreprocessor class from UIniDataLoader unit and modified code in TDatabaseIniFile that called it. The pre-processor was only required for the DCSC v1 file format. --- Src/UIniDataLoader.pas | 345 +---------------------------------------- 1 file changed, 1 insertion(+), 344 deletions(-) diff --git a/Src/UIniDataLoader.pas b/Src/UIniDataLoader.pas index 8f40ee460..74ce850b1 100644 --- a/Src/UIniDataLoader.pas +++ b/Src/UIniDataLoader.pas @@ -119,143 +119,6 @@ TDatabaseFileMapper = class(TNoConstructObject) } end; -type - { - TDatabasePreprocessor: - Static class used to pre-process ini file, acting on pre-processor - instructions. Does not support nesting of directives. Supported instructions - are: - #if-ver-eq - Checks if application version is equal to . - #if-ver-neq - Checks if application version is not equal to . - #if-ver-lt - Checks if application version is less than . - #if-ver-gt - Checks if application version is greater than . - #if-ver-inrange - Checks if application version is in the range of versions specified from - to , inclusive. - #end-if - Ends a block started by any of the #if- instructions above. - When a #if- instruction evaluates true then all the following lines in the - ini file up to the #end-if instruction and included. If it evaluates false - the enclosed lines are ignored. - Version numbers are in form 9.9.9.9. Minor version numbers are optional - and are filled with zeroes, so specifying 3 is equivalent to 3.0.0.0 and - 2.1 is equivalent to 2.1.0.0. - Unrecognised instructions are ignored and are not included in the output. - } - TDatabasePreprocessor = class(TNoConstructObject) - strict private - type - { - TVerCompareMethod: - Type of methods used to compare version numbers. - @param Ver1 [in] First version number to compare. - @param Ver2 [in] Second version number to compare. - @return True if required condition applies, False if not. - } - TVerCompareMethod = function(Ver1, Ver2: TVersionNumber): Boolean - of object; - const - // Symbols that prefix every pre-processor instruction - cPreProcPrefix = ';#'; - // Pre-processor instructions / directives - cEndIf = cPreProcPrefix + 'end-if'; // ends if instruction - cIfVerEQ = cPreProcPrefix + 'if-ver-eq'; // appver = param - cIfVerNEQ = cPreProcPrefix + 'if-ver-neq'; // appver <> param - cIfVerLT = cPreProcPrefix + 'if-ver-lt'; // appver < param - cIfVerGT = cPreProcPrefix + 'if-ver-gt'; // appver > param - cIfVerInRange = cPreProcPrefix + 'if-ver-inrange'; // appver in range - class function ProcessVerEQ(const Lines: IStringList; - var LineIdx: Integer): IStringList; - {Processes a ifvereq pre-processor directive. Includes lines before endif - directive only if condition is met, i.e. app version is equal to version - specified in directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current line before processing. - Out: index of last line processed. - } - class function ProcessVerNEQ(const Lines: IStringList; - var LineIdx: Integer): IStringList; - {Processes a ifverneq pre-processor directive. Includes lines before endif - directive only if condition is met, i.e. app version is not equal to - version specified in directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current line before processing. - Out: index of last line processed. - } - class function ProcessVerLT(const Lines: IStringList; - var LineIdx: Integer): IStringList; - {Processes a ifverlt pre-processor directive. Includes lines before endif - directive only if condition is met, i.e. app version is less than version - specified in directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current line before processing. - Out: index of last line processed. - } - class function ProcessVerGT(const Lines: IStringList; - var LineIdx: Integer): IStringList; - {Processes a ifvergt pre-processor directive. Includes lines before endif - directive only if condition is met, i.e. app version is greater than - version specified in directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current line before processing. - Out: index of last line processed. - } - class function ProcessVerInRange(const Lines: IStringList; - var LineIdx: Integer): IStringList; - {Processes ifverinrange pre-processor directive. Includes lines before - endif directive only if condition is met, i.e. app version is in range of - version numbers specified in directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current kine before processing. - Out: index of last line processed. - } - class function CompareEQ(Ver1, Ver2: TVersionNumber): Boolean; - {Compares two version numbers to check if first is equal to second. - @param Ver1 [in] First version number to compare. - @param Ver2 [in] Second version number to compare. - @return True if Ver1 = Ver2, False if not. - } - class function CompareNEQ(Ver1, Ver2: TVersionNumber): Boolean; - {Compares two version numbers to check if first is not equal to second. - @param Ver1 [in] First version number to compare. - @param Ver2 [in] Second version number to compare. - @return True if Ver1 <> Ver2, False if not. - } - class function CompareGT(Ver1, Ver2: TVersionNumber): Boolean; - {Compares two version numbers to check if first is greater than second. - @param Ver1 [in] First version number to compare. - @param Ver2 [in] Second version number to compare. - @return True if Ver1 > Ver2, False if not. - } - class function CompareLT(Ver1, Ver2: TVersionNumber): Boolean; - {Compares two version numbers to check if first is less than second. - @param Ver1 [in] First version number to compare. - @param Ver2 [in] Second version number to compare. - @return True if Ver1 < Ver2, False if not. - } - class function ProcessVerCompare(const Lines: IStringList; - var LineIdx: Integer; const CompareFn: TVerCompareMethod): IStringList; - {Processes a version comparison directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current line before processing. - Out: index of last line processed. - @param CompareFn [in] Method to used to compare application version with - version number read from directive to determine if directive executes. - } - class function ProcessToEndIf(const Lines: IStringList; - var LineIdx: Integer; const RecordLines: Boolean): IStringList; - public - class function PreProcess(Lines: IStringList): IStringList; - {Performs pre-processing. - @param Lines [in] Lines of text to be pre-processed. - @return Lines after preprocessing. - } - end; - { TDatabaseIniFile } constructor TDatabaseIniFile.Create(const FileReader: TMainDBFileReader; @@ -276,11 +139,7 @@ constructor TDatabaseIniFile.Create(const FileReader: TMainDBFileReader; ); // load ini file from concatenated contents of Files after running through // pre-processor - SetStrings( - TDatabasePreprocessor.PreProcess( - LoadFiles(Files) - ) - ); + SetStrings(LoadFiles(Files)); end; function TDatabaseIniFile.LoadFiles(const FileNames: IStringList): IStringList; @@ -373,207 +232,5 @@ class function TDatabaseFileMapper.GetRelatedFiles( end; end; -{ TDatabasePreprocessor } - -class function TDatabasePreprocessor.CompareEQ(Ver1, - Ver2: TVersionNumber): Boolean; - {Compares two version numbers to check if first is equal to second. - @param Ver1 [in] First version number to compare. - @param Ver2 [in] Second version number to compare. - @return True if Ver1 = Ver2, False if not. - } -begin - Result := Ver1 = Ver2; -end; - -class function TDatabasePreprocessor.CompareGT(Ver1, - Ver2: TVersionNumber): Boolean; - {Compares two version numbers to check if first is greater than second. - @param Ver1 [in] First version number to compare. - @param Ver2 [in] Second version number to compare. - @return True if Ver1 > Ver2, False if not. - } -begin - Result := Ver1 > Ver2; -end; - -class function TDatabasePreprocessor.CompareLT(Ver1, - Ver2: TVersionNumber): Boolean; - {Compares two version numbers to check if first is less than second. - @param Ver1 [in] First version number to compare. - @param Ver2 [in] Second version number to compare. - @return True if Ver1 < Ver2, False if not. - } -begin - Result := Ver1 < Ver2; -end; - -class function TDatabasePreprocessor.CompareNEQ(Ver1, - Ver2: TVersionNumber): Boolean; - {Compares two version numbers to check if first is not equal to second. - @param Ver1 [in] First version number to compare. - @param Ver2 [in] Second version number to compare. - @return True if Ver1 <> Ver2, False if not. - } -begin - Result := Ver1 <> Ver2; -end; - -class function TDatabasePreprocessor.PreProcess(Lines: IStringList): - IStringList; - {Performs pre-processing. - @param Lines [in] Lines of text to be pre-processed. - @return Lines after preprocessing. - } -var - LineIdx: Integer; // indexes each line - Line: string; // trimmed content of a line -begin - Result := TIStringList.Create; - LineIdx := 0; - while LineIdx < Lines.Count do - begin - Line := StrTrim(Lines[LineIdx]); - // Check for pre-processor instructions - if StrStartsStr(cIfVerLT, Line) then - Result.Add(ProcessVerLT(Lines, LineIdx)) - else if StrStartsStr(cIfVerGT, Line) then - Result.Add(ProcessVerGT(Lines, LineIdx)) - else if StrStartsStr(cIfVerInRange, Line) then - Result.Add(ProcessVerInRange(Lines, LineIdx)) - else if StrStartsStr(cIfVerEQ, Line) then - Result.Add(ProcessVerEQ(Lines, LineIdx)) - else if StrStartsStr(cIfVerNEQ, Line) then - Result.Add(ProcessVerNEQ(Lines, LineIdx)) - else if StrStartsStr(cPreProcPrefix, Line) then - // ignore unknown pre-proc dirs - else - // no pre-processor, just use trimmed line - Result.Add(Line); - Inc(LineIdx); - end; -end; - -class function TDatabasePreprocessor.ProcessToEndIf(const Lines: IStringList; - var LineIdx: Integer; const RecordLines: Boolean): IStringList; -begin - Inc(LineIdx); - Result := TIStringList.Create; - while (LineIdx < Lines.Count) and (StrTrim(Lines[LineIdx]) <> cEndIf) do - begin - if RecordLines then - Result.Add(Lines[LineIdx]); - Inc(LineIdx); - end; -end; - -class function TDatabasePreprocessor.ProcessVerCompare(const Lines: IStringList; - var LineIdx: Integer; const CompareFn: TVerCompareMethod): IStringList; - {Processes a version comparison directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current line before processing. Out: - index of last line processed. - @param CompareFn [in] Method to used to compare application version with - version number read from directive to determine if directive executes. - } -var - InstParts: IStringList; // parts of the pre-processor instruction - Ver: TVersionNumber; // version number from directive -begin - // Get version number parameter - InstParts := TIStringList.Create(Lines[LineIdx], ' ', False, True); - if InstParts.Count >= 2 then - Ver := InstParts[1] // implicit conversion of string to TVersionNumber - else - Ver := TVersionNumber.Nul; // 0.0.0.0 - // Process lines up to endif - Result := ProcessToEndIf( - Lines, LineIdx, CompareFn(TVersionInfo.ProductVerNum, Ver) - ); -end; - -class function TDatabasePreprocessor.ProcessVerEQ(const Lines: IStringList; - var LineIdx: Integer): IStringList; - {Processes a ifvereq pre-processor directive. Includes lines before endif - directive only if condition is met, i.e. app version is equal to version - specified in directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current line before processing. Out: - index of last line processed. - } -begin - Result := ProcessVerCompare(Lines, LineIdx, CompareEQ); -end; - -class function TDatabasePreprocessor.ProcessVerGT(const Lines: IStringList; - var LineIdx: Integer): IStringList; - {Processes a ifvergt pre-processor directive. Includes lines before endif - directive only if condition is met, i.e. app version is greater than - version specified in directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current line before processing. Out: - index of last line processed. - } -begin - Result := ProcessVerCompare(Lines, LineIdx, CompareGT); -end; - -class function TDatabasePreprocessor.ProcessVerInRange(const Lines: IStringList; - var LineIdx: Integer): IStringList; - {Processes ifverinrange pre-processor directive. Includes lines before endif - directive only if condition is met, i.e. app version is in range of version - numbers specified in directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current kine before processing. Out: - index of last line processed. - } -var - InstParts: IStringList; // parts of the pre-processor instruction - VerLo: TVersionNumber; // version number from directive - VerHi: TVersionNumber; // version number from directive - IncludeContents: Boolean; // flag true if enclosed lines to be included -begin - Result := TIStringList.Create; - // Get version number parameter - InstParts := TIStringList.Create(Lines[LineIdx], ' ', False, True); - if InstParts.Count < 3 then - IncludeContents := False - else - begin - VerLo := InstParts[1]; // implicit conversion of string to TVersionNumber - VerHi := InstParts[2]; // implicit conversion of string to TVersionNumber - IncludeContents := (TVersionInfo.ProductVerNum >= VerLo) and - (TVersionInfo.ProductVerNum <= VerHi); - end; - // Process lines up to endif - Result := ProcessToEndIf(Lines, LineIdx, IncludeContents); -end; - -class function TDatabasePreprocessor.ProcessVerLT(const Lines: IStringList; - var LineIdx: Integer): IStringList; - {Processes a ifverlt pre-processor directive. Includes lines before endif - directive only if condition is met, i.e. app version is less than version - specified in directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current line before processing. Out: - index of last line processed. - } -begin - Result := ProcessVerCompare(Lines, LineIdx, CompareLT); -end; - -class function TDatabasePreprocessor.ProcessVerNEQ(const Lines: IStringList; - var LineIdx: Integer): IStringList; - {Processes a ifverneq pre-processor directive. Includes lines before endif - directive only if condition is met, i.e. app version is not equal to version - specified in directive. - @param Lines [in] Lines of ini file. - @param LineIdx [in/out] In: index of current line before processing. Out: - index of last line processed. - } -begin - Result := ProcessVerCompare(Lines, LineIdx, CompareNEQ); -end; - end. From 1d0b8115211dabf9fe111793decc0abdcefc9252 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 5 Mar 2025 10:06:54 +0000 Subject: [PATCH 205/222] Remove support for overloaded category ini files. DCSC v1 supported different versions of category ini files with different extensions whose content was combined when a category ini file was loaded. TDatabaseFileMapper implemented this feature. DCSC v2 does not support such overloaded file names so TDatabaseFileMapper was removed from UIniDataLoader. TDatabaseIniFile.Create was modified to load just a single file. Some XMLDoc comments were altered to reflect this and previous changes. --- Src/UIniDataLoader.pas | 178 +++++++---------------------------------- 1 file changed, 31 insertions(+), 147 deletions(-) diff --git a/Src/UIniDataLoader.pas b/Src/UIniDataLoader.pas index 74ce850b1..fcb288f94 100644 --- a/Src/UIniDataLoader.pas +++ b/Src/UIniDataLoader.pas @@ -5,8 +5,8 @@ * * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). * - * Implements an extension of TMemIniFile that loads the ini data from a set of - * associated files and pre-processes the data. + * Implements an extension of TMemIniFile that loads its data from a file and + * strips enclosing quotes from string data. } @@ -24,57 +24,38 @@ interface type - /// - /// Extension of TMemIniFile that loads the ini data from a set of associated - /// files. Any quotes enclosing values read from ini file are stripped. Files - /// are pre-processed, and modified according to any pre-processing - /// directives. + /// Extension of TMemIniFile that loads its data from a file. + /// Any quotes enclosing values read from the ini file are stripped. /// TDatabaseIniFile = class(TMemIniFile) strict private var - /// Loads database files using correct encoding. + /// Loads database file using correct encoding. fFileReader: TMainDBFileReader; - /// - /// Concatenates the content of a list of text files. - /// - /// IStringList [in] List of text files. - /// IStringList containing concatenation of lines read from the - /// files. - function LoadFiles(const FileNames: IStringList): IStringList; public - /// - /// Object constructor. Sets up ini file object and loads data into it from - /// a set of associated files. - /// + /// Object constructor. Sets up ini file object and loads data + /// into it from a file. /// TMainDBFileReader [in] Object used to read /// database text files using correct encoding. - /// string [in] Base name of associated files - /// containing data. + /// string [in] Name of ini file. constructor Create(const FileReader: TMainDBFileReader; - const FileName: string); - /// - /// Retrieves a string value from an ini file. - /// - /// string [in] Section containing value. - /// string [in] Identifier of value. - /// string [in] Default value used if ident is not - /// present or not assigned. - /// string containing required value, with any enclosing quotes - /// removed. - /// - /// Overrides method in base class to strip enclosing quotes. + const AFileName: string); + /// Retrieves a string value from an ini file. + /// string [in] Section containing value. + /// + /// string [in] Identifier of value. + /// string [in] Default value used if + /// Ident has no associated value. + /// string containing the required value, with any + /// enclosing quotes removed. + /// Overrides the method in base class to strip enclosing quotes. /// function ReadString(const Section, Ident, Default: string): string; override; - /// - /// Loads ini object's data from a string list. - /// + /// Loads ini object's data from a string list. /// IStringList [in] Strings to be loaded. - /// - /// Overloads inherited SetStrings to load data from IStringList as well - /// as TStringList. - /// + /// Overloads inherited SetStrings to load data from a + /// IStringList as well as TStringList. procedure SetStrings(const Strings: IStringList); overload; end; @@ -89,66 +70,26 @@ implementation uses // Delphi SysUtils, + IOUtils, // Project - UConsts, UStrUtils, UVersionInfo; - - -type - { - TDatabaseFileMapper: - Static class that gets a list of file names associated with a specified file - name. Used to associate database file names visible only to early versions - of CodeSnip with file names visible to later versions. - } - TDatabaseFileMapper = class(TNoConstructObject) - strict private - class function AlternateFileName(const FileName, InnerExt: string): string; - {Creates an alternate file name for a specified file and an "inner" - extension that is inserted before the file's current extension. - @param FileName [in] File name to form basis of alternate name. - @param InnerExt [in] "Inner" extension that comes between file name and - its last extension. - @return Alternate file name. - } - public - class function GetRelatedFiles(const FileName: string): IStringList; - {Builds a list of file names associated with a file name. - @param FileName [in] Original file name. - @return List of associated files, all of which exist. Original file name - may be omitted from the list if it doesn't exist. - } - end; + UConsts, + UStrUtils, + UVersionInfo; { TDatabaseIniFile } constructor TDatabaseIniFile.Create(const FileReader: TMainDBFileReader; - const FileName: string); -var - Files: IStringList; // List of associated file names + const AFileName: string); resourcestring - // Error message - sMissingCatFile = 'Neither category file "%s" nor its alternate exists.'; + sFileNotFound = 'File "%s" does not exist.'; begin - inherited Create(FileName); + inherited Create(AFileName); fFileReader := FileReader; - // get list of associated files - Files := TDatabaseFileMapper.GetRelatedFiles(FileName); - if Files.Count = 0 then + if not TFile.Exists(AFileName) then raise EDatabaseIniFile.CreateFmt( - sMissingCatFile, [ExtractFileName(FileName)] + sFileNotFound, [ExtractFileName(AFileName)] ); - // load ini file from concatenated contents of Files after running through - // pre-processor - SetStrings(LoadFiles(Files)); -end; - -function TDatabaseIniFile.LoadFiles(const FileNames: IStringList): IStringList; -var - FileName: string; // each file name is list -begin - Result := TIStringList.Create; - for FileName in FileNames do - Result.Add(fFileReader.ReadAllStrings(FileName)); + SetStrings(fFileReader.ReadAllStrings(AFileName)); end; function TDatabaseIniFile.ReadString(const Section, Ident, @@ -175,62 +116,5 @@ procedure TDatabaseIniFile.SetStrings(const Strings: IStringList); end; end; -{ TDatabaseFileMapper } - -function RemoveFileExt(const FileName: string): string; - {Removes an extension from a file name. - @param FileName [in] File name from which extension is to be removed. - @return File name without extension. - } -begin - if StrContainsStr('.', FileName) then - Result := SysUtils.ChangeFileExt(FileName, '') - else - Result := FileName; -end; - -class function TDatabaseFileMapper.AlternateFileName( - const FileName, InnerExt: string): string; - {Creates an alternate file name for a specified file and an "inner" extension - that is inserted before the file's current extension. - @param FileName [in] File name to form basis of alternate name. - @param InnerExt [in] "Inner" extension that comes between file name and its - last extension. - @return Alternate file name. - } -var - BaseName: string; // base of file name without extension - Extension: string; // extension common to all names -begin - Extension := ExtractFileExt(FileName); - BaseName := RemoveFileExt(ExtractFileName(FileName)); - Result := ExtractFilePath(FileName) + BaseName + InnerExt + Extension; -end; - -class function TDatabaseFileMapper.GetRelatedFiles( - const FileName: string): IStringList; - {Builds a list of file names associated with a file name. - @param FileName [in] Original file name. - @return List of associated files, all of which exist. Original file name may - be omitted from the list if it doesn't exist. - } -var - AltFileName: string; // an alternate file name - InnerExt: string; // each inner extension -const - // "Inner" extensions to be interposed between filename and its extension - InnerExts: array[0..1] of string = ('.3', '.4'); -begin - Result := TIStringList.Create; - if FileExists(FileName) then - Result.Add(FileName); - for InnerExt in InnerExts do - begin - AltFileName := AlternateFileName(FileName, InnerExt); - if (AltFileName <> '') and FileExists(AltFileName) then - Result.Add(AltFileName); - end; -end; - end. From 02accdce43aa77c4424040d37994916d465de339 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 5 Mar 2025 10:40:05 +0000 Subject: [PATCH 206/222] Remove support for DCSC files with legacy encoding. Some files used in DCSC v1 could use either UTF8 or Windows 1252 encoding. SCSC v2 only uses UTF8 files with BOM. TMainDBFileReader in UMainDBFileReader was used to detect the encoding of data files and provide code to load them using the correct encoding. This is no longer required - all files are now loaded using UTF8. So UMainDBFileReader is redundant and has been removed from the project and deleted. Code in UIniDataLoader and DBIO.UIniData has been modified to work without TMainDBFileReader and instead to use TFileIO to load files, hard coded to use UTF8 with BOM. --- Src/CodeSnip.dpr | 1 - Src/CodeSnip.dproj | 1 - Src/DBIO.UIniData.pas | 23 ++---- Src/UIniDataLoader.pas | 42 +++++------ Src/UMainDBFileReader.pas | 151 -------------------------------------- 5 files changed, 26 insertions(+), 192 deletions(-) delete mode 100644 Src/UMainDBFileReader.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 7c0be4143..1a36814ca 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -266,7 +266,6 @@ uses ULEDImageList in 'ULEDImageList.pas', ULinkAction in 'ULinkAction.pas', ULocales in 'ULocales.pas', - UMainDBFileReader in 'UMainDBFileReader.pas', UMainDisplayMgr in 'UMainDisplayMgr.pas', UMarquee in 'UMarquee.pas', UMeasurement in 'UMeasurement.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index c165faa45..b3ce392bc 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -468,7 +468,6 @@ - diff --git a/Src/DBIO.UIniData.pas b/Src/DBIO.UIniData.pas index 3bf81cceb..bca472c8e 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DBIO.UIniData.pas @@ -33,7 +33,6 @@ interface DB.USnippet, DBIO.UFileIOIntf, UIStringList, - UMainDBFileReader, UVersionInfo; @@ -59,11 +58,9 @@ TIniFileCache = class(TObject) var /// Maps file names to related ini file objects. fCache: TIniFileMap; - /// Loads database files using correct encoding. - fFileReader: TMainDBFileReader; public /// Object constructor. Sets up empty cache. - constructor Create(const FileReader: TMainDBFileReader); + constructor Create; /// Object destructor. Frees cache. destructor Destroy; override; /// @@ -90,8 +87,6 @@ TIniFileCache = class(TObject) fSnippetCatMap: TSnippetCatMap; /// Cache of category ini file objects. fIniCache: TIniFileCache; - /// Reads DB files using correct encoding. - fFileReader: TMainDBFileReader; /// Data format version number. fVersion: TVersionNumber; const @@ -525,15 +520,14 @@ constructor TIniDataReader.Create(const DBDir: string); // Create helper objects used to speed up access to ini files if DatabaseExists then begin - fFileReader := TMainDBFileReader.Create(MasterFileName); - fIniCache := TIniFileCache.Create(fFileReader); + fIniCache := TIniFileCache.Create; try ReadVersionNumber; if fVersion.IsNull then raise EDataIO.Create(sVersionNotSpecified); if fVersion.V1 <> SupportedMajorVersion then raise EDataIO.CreateFmt(sVersionNotSupported, [string(fVersion)]); - fMasterIni := TDatabaseIniFile.Create(fFileReader, MasterFileName); + fMasterIni := TDatabaseIniFile.Create(MasterFileName); fCatIDs := TStringList.Create; fSnippetCatMap := TSnippetCatMap.Create(TTextEqualityComparer.Create); // Load required indexes @@ -566,7 +560,6 @@ function TIniDataReader.DataFileExists(const FileName: string): Boolean; destructor TIniDataReader.Destroy; begin - fFileReader.Free; fIniCache.Free; fSnippetCatMap.Free; fCatIDs.Free; @@ -744,7 +737,9 @@ procedure TIniDataReader.GetSnippetProps(const SnippetKey: string; begin SnipFileName := CatIni.ReadString(SnippetKey, cSnipFileName, ''); try - Result := fFileReader.ReadAllText(DataFile(SnipFileName)); + Result := TFileIO.ReadAllText( + DataFile(SnipFileName), TEncoding.UTF8, True + ); except // if error loading file then database is corrupt on E: EFOpenError do @@ -970,11 +965,9 @@ function TIniDataReader.SnippetToCat(const SnippetKey: string): string; { TIniDataReader.TIniFileCache } -constructor TIniDataReader.TIniFileCache.Create( - const FileReader: TMainDBFileReader); +constructor TIniDataReader.TIniFileCache.Create; begin inherited Create; - fFileReader := FileReader; // fCache owns and frees the ini file objects fCache := TIniFileMap.Create( [doOwnsValues], TTextEqualityComparer.Create @@ -991,7 +984,7 @@ function TIniDataReader.TIniFileCache.GetIniFile( const PathToFile: string): TCustomIniFile; begin if not fCache.ContainsKey(PathToFile) then - fCache.Add(PathToFile, TDatabaseIniFile.Create(fFileReader, PathToFile)); + fCache.Add(PathToFile, TDatabaseIniFile.Create(PathToFile)); Result := fCache[PathToFile]; end; diff --git a/Src/UIniDataLoader.pas b/Src/UIniDataLoader.pas index fcb288f94..2fd39a5b9 100644 --- a/Src/UIniDataLoader.pas +++ b/Src/UIniDataLoader.pas @@ -18,9 +18,10 @@ interface uses // Delphi - Classes, IniFiles, + Types, + IniFiles, // Project - UBaseObjects, UExceptions, UIStringList, UMainDBFileReader; + UExceptions; type @@ -28,18 +29,11 @@ interface /// Any quotes enclosing values read from the ini file are stripped. /// TDatabaseIniFile = class(TMemIniFile) - strict private - var - /// Loads database file using correct encoding. - fFileReader: TMainDBFileReader; public /// Object constructor. Sets up ini file object and loads data /// into it from a file. - /// TMainDBFileReader [in] Object used to read - /// database text files using correct encoding. /// string [in] Name of ini file. - constructor Create(const FileReader: TMainDBFileReader; - const AFileName: string); + constructor Create(const AFileName: string); /// Retrieves a string value from an ini file. /// string [in] Section containing value. /// @@ -52,11 +46,11 @@ TDatabaseIniFile = class(TMemIniFile) /// function ReadString(const Section, Ident, Default: string): string; override; - /// Loads ini object's data from a string list. - /// IStringList [in] Strings to be loaded. - /// Overloads inherited SetStrings to load data from a - /// IStringList as well as TStringList. - procedure SetStrings(const Strings: IStringList); overload; + /// Loads ini object's data from a string array. + /// TStringDynArray [in] Array of strings to + /// be loaded. + /// Overloads inherited SetStrings method. + procedure SetStrings(const AStrings: TStringDynArray); overload; end; type @@ -70,26 +64,24 @@ implementation uses // Delphi SysUtils, + Classes, IOUtils, // Project UConsts, - UStrUtils, - UVersionInfo; + UIOUtils; { TDatabaseIniFile } -constructor TDatabaseIniFile.Create(const FileReader: TMainDBFileReader; - const AFileName: string); +constructor TDatabaseIniFile.Create(const AFileName: string); resourcestring sFileNotFound = 'File "%s" does not exist.'; begin inherited Create(AFileName); - fFileReader := FileReader; if not TFile.Exists(AFileName) then raise EDatabaseIniFile.CreateFmt( sFileNotFound, [ExtractFileName(AFileName)] ); - SetStrings(fFileReader.ReadAllStrings(AFileName)); + SetStrings(TFileIO.ReadAllLines(AFileName, TEncoding.UTF8, True)); end; function TDatabaseIniFile.ReadString(const Section, Ident, @@ -103,13 +95,15 @@ function TDatabaseIniFile.ReadString(const Section, Ident, Result := Copy(Result, 2, Length(Result) - 2); end; -procedure TDatabaseIniFile.SetStrings(const Strings: IStringList); +procedure TDatabaseIniFile.SetStrings(const AStrings: TStringDynArray); var - SL: TStringList; // string list use to call inherited method + SL: TStringList; + Str: string; begin SL := TStringList.Create; try - Strings.CopyTo(SL); + for Str in AStrings do + SL.Add(Str); SetStrings(SL); finally FreeAndNil(SL); diff --git a/Src/UMainDBFileReader.pas b/Src/UMainDBFileReader.pas deleted file mode 100644 index d463babe8..000000000 --- a/Src/UMainDBFileReader.pas +++ /dev/null @@ -1,151 +0,0 @@ -{ - * This Source Code Form is subject to the terms of the Mozilla Public License, - * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at https://mozilla.org/MPL/2.0/ - * - * Copyright (C) 2005-2021, Peter Johnson (gravatar.com/delphidabbler). - * - * Implements class that can read files from main database using correct - * encoding. -} - - -unit UMainDBFileReader; - -interface - -uses - // Delphi - SysUtils, - // Project - UEncodings, UIStringList; - -type - /// - /// Loads files from main database, taking into account file encoding. - /// - /// - /// All files in database folder are assumed to have the same encoding. Only - /// one file is tested. - /// - TMainDBFileReader = class(TObject) - strict private - const - /// ANSI code page used for v4 and earlier database files. - /// - LegacyCodePage = TEncodingHelper.Windows1252CodePage; - var - /// Encoding to use when reading text files. - fEncoding: TEncoding; - /// - /// Detects encoding used by specified file. - /// - /// string [in] Name of file. - /// Required TEncoding instance. Callers should free this instance - /// if it not a standard encoding. - /// - /// Main database files created by CodeSnip v3 and earlier use the Default - /// encoding while those created by v4 use UTF-8 files that have the UTF-8 - /// preamble. - /// - function GetFileEncoding(const FileName: string): TEncoding; - public - /// - /// Object constructor. Sets up object to use encoding used for given - /// specimen file. - /// - constructor Create(const SpecimenFile: string); - /// - /// Object destructor. Tears down object. - /// - destructor Destroy; override; - /// - /// Reads all text from a text file using known encoding. - /// - /// string [in] Name of text file to read. - /// String containing contents of file. - function ReadAllText(const FileName: string): string; - /// - /// Reads all lines from a text file using known encoding. - /// - /// string [in] Name of text file to read. - /// IStringList object containing lines from file. - function ReadAllStrings(const FileName: string): IStringList; - end; - -implementation - - -uses - // Delphi - Classes, - // Project - UIOUtils; - - -{ TMainDBFileReader } - -constructor TMainDBFileReader.Create(const SpecimenFile: string); -begin - inherited Create; - fEncoding := GetFileEncoding(SpecimenFile); -end; - -destructor TMainDBFileReader.Destroy; -begin - TEncodingHelper.FreeEncoding(fEncoding); - inherited; -end; - -function TMainDBFileReader.GetFileEncoding(const FileName: string): TEncoding; - - /// Checks if two byte arrays are equal. - function BytesMatch(const BA1, BA2: TBytes): Boolean; - var - I: Integer; - begin - if Length(BA1) <> Length(BA2) then - Exit(False); - for I := 0 to Pred(Length(BA1)) do - if BA1[I] <> BA2[I] then - Exit(False); - Result := True; - end; - -var - FS: TFileStream; // stream onto file - Buffer: TBytes; // buffer containing first few bytes of file - UTF8Preamble: TBytes; // bytes of UTF-8 preamble -begin - UTF8Preamble := TEncoding.UTF8.GetPreamble; - Assert(Length(UTF8Preamble) > 0, - ClassName + '.GetFileEncoding: UTF-8 preamble has zero length'); - FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); - try - if FS.Size >= Length(UTF8Preamble) then - begin - // read first few bytes of file to see if they match UTF-8 preamble - SetLength(Buffer, Length(UTF8Preamble)); - FS.ReadBuffer(Pointer(Buffer)^, Length(Buffer)); - if BytesMatch(Buffer, UTF8Preamble) then - Exit(TEncoding.UTF8); - end; - finally - FS.Free; - end; - Result := TEncodingHelper.GetEncoding(LegacyCodePage); -end; - -function TMainDBFileReader.ReadAllStrings(const FileName: string): IStringList; -begin - Result := TIStringList.Create( - TFileIO.ReadAllLines(FileName, fEncoding, True) - ); -end; - -function TMainDBFileReader.ReadAllText(const FileName: string): string; -begin - Result := TFileIO.ReadAllText(FileName, fEncoding, True); -end; - -end. From c12d1c808294673a31a217c4b56aa011215ff3e4 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 5 Mar 2025 12:40:22 +0000 Subject: [PATCH 207/222] Merge code from UIniDataLoader into DBIO.UIniData The TDatabaseIniFile class in UIniDataLoader has been reduced to a rump that is essentially a ini file extension that strips surrounding quotes from string values read from the ini file. The entire class was moved to be a nested class of TIniDataReader. It was renamed as TUTF8IniFileEx. The EDatabaseIniFile exception was not brought over: EDataIO was used instead. UIniDataLoader was removed from the project. --- Src/CodeSnip.dpr | 1 - Src/CodeSnip.dproj | 1 - Src/DBIO.UIniData.pas | 85 ++++++++++++++++++++++++++---- Src/UIniDataLoader.pas | 114 ----------------------------------------- 4 files changed, 75 insertions(+), 126 deletions(-) delete mode 100644 Src/UIniDataLoader.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 1a36814ca..29d56f6a6 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -257,7 +257,6 @@ uses UHTMLUtils in 'UHTMLUtils.pas', UHTTPProtocol in 'UHTTPProtocol.pas', UImageTags in 'UImageTags.pas', - UIniDataLoader in 'UIniDataLoader.pas', UInitialLetter in 'UInitialLetter.pas', UIOUtils in 'UIOUtils.pas', UIStringList in 'UIStringList.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index b3ce392bc..8361e1e3f 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -459,7 +459,6 @@ - diff --git a/Src/DBIO.UIniData.pas b/Src/DBIO.UIniData.pas index bca472c8e..2b01f3041 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DBIO.UIniData.pas @@ -24,7 +24,6 @@ interface Classes, Types, Generics.Collections, - Generics.Defaults, IniFiles, // Project ActiveText.UMain, @@ -38,12 +37,40 @@ interface type - /// - /// Reads main CodeSnip database data from .ini and .dat files. - /// + /// Reads a vault from disk in the DelphiDabbler Code Snippets + /// Collection v2 format. TIniDataReader = class sealed(TInterfacedObject, IDataReader) strict private type + /// Extension of TMemIniFile that loads its data from a + /// UTF8 encoded file with BOM. Any quotes enclosing values read from the + /// ini file are stripped. + TUTF8IniFileEx = class(TMemIniFile) + public + /// Object constructor. Sets up ini file object and loads data + /// into it from a file. + /// string [in] Name of ini file. + /// + constructor Create(const AFileName: string); + /// Retrieves a string value from an ini file. + /// string [in] Section containing value. + /// + /// string [in] Identifier of value. + /// string [in] Default value used if + /// Ident has no associated value. + /// string containing the required value, with any + /// enclosing quotes removed. + /// Overrides the method in base class to strip enclosing + /// quotes. + function ReadString(const Section, Ident, Default: string): string; + override; + /// Loads ini object's data from a string array. + /// TStringDynArray [in] Array of strings + /// to be loaded. + /// Overloads inherited SetStrings method. + procedure SetStrings(const AStrings: TStringDynArray); overload; + end; + /// /// Class that implements a cache of ini file objects, indexed by ini /// file name. @@ -434,11 +461,9 @@ implementation UConsts, UEncodings, UExceptions, - UIniDataLoader, UIOUtils, UREMLDataIO, USnippetExtraHelper, - USystemInfo, UStrUtils, UUtils; @@ -527,7 +552,7 @@ constructor TIniDataReader.Create(const DBDir: string); raise EDataIO.Create(sVersionNotSpecified); if fVersion.V1 <> SupportedMajorVersion then raise EDataIO.CreateFmt(sVersionNotSupported, [string(fVersion)]); - fMasterIni := TDatabaseIniFile.Create(MasterFileName); + fMasterIni := TUTF8IniFileEx.Create(MasterFileName); fCatIDs := TStringList.Create; fSnippetCatMap := TSnippetCatMap.Create(TTextEqualityComparer.Create); // Load required indexes @@ -868,8 +893,7 @@ procedure TIniDataReader.HandleCorruptDatabase(const EObj: TObject); begin DeleteFiles(DataDir, '*.*'); if (EObj is EDataIO) - or (EObj is EFileStreamError) - or (EObj is EDatabaseIniFile) then + or (EObj is EFileStreamError) then // we have database error: raise new exception containing old message raise EDataIO.CreateFmt(sDBError, [(EObj as Exception).Message]) else @@ -963,6 +987,47 @@ function TIniDataReader.SnippetToCat(const SnippetKey: string): string; Result := fCatIDs[CatIdx]; end; +{ TIniDataReader.TUTF8IniFileEx } + +constructor TIniDataReader.TUTF8IniFileEx.Create(const AFileName: string); +resourcestring + sFileNotFound = 'File "%s" does not exist.'; +begin + inherited Create(AFileName); + if not TFile.Exists(AFileName) then + raise EDataIO.CreateFmt( + sFileNotFound, [ExtractFileName(AFileName)] + ); + SetStrings(TFileIO.ReadAllLines(AFileName, TEncoding.UTF8, True)); +end; + +function TIniDataReader.TUTF8IniFileEx.ReadString(const Section, Ident, + Default: string): string; +begin + // Read string from ini + Result := inherited ReadString(Section, Ident, Default); + // Strip any leading and trailing quotes + if (Length(Result) > 1) and (Result[1] = DOUBLEQUOTE) + and (Result[Length(Result)] = DOUBLEQUOTE) then + Result := Copy(Result, 2, Length(Result) - 2); +end; + +procedure TIniDataReader.TUTF8IniFileEx.SetStrings( + const AStrings: TStringDynArray); +var + SL: TStringList; + Str: string; +begin + SL := TStringList.Create; + try + for Str in AStrings do + SL.Add(Str); + SetStrings(SL); + finally + SL.Free; + end; +end; + { TIniDataReader.TIniFileCache } constructor TIniDataReader.TIniFileCache.Create; @@ -984,7 +1049,7 @@ function TIniDataReader.TIniFileCache.GetIniFile( const PathToFile: string): TCustomIniFile; begin if not fCache.ContainsKey(PathToFile) then - fCache.Add(PathToFile, TDatabaseIniFile.Create(PathToFile)); + fCache.Add(PathToFile, TUTF8IniFileEx.Create(PathToFile)); Result := fCache[PathToFile]; end; diff --git a/Src/UIniDataLoader.pas b/Src/UIniDataLoader.pas deleted file mode 100644 index 2fd39a5b9..000000000 --- a/Src/UIniDataLoader.pas +++ /dev/null @@ -1,114 +0,0 @@ -{ - * This Source Code Form is subject to the terms of the Mozilla Public License, - * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at https://mozilla.org/MPL/2.0/ - * - * Copyright (C) 2009-2021, Peter Johnson (gravatar.com/delphidabbler). - * - * Implements an extension of TMemIniFile that loads its data from a file and - * strips enclosing quotes from string data. -} - - -unit UIniDataLoader; - - -interface - - -uses - // Delphi - Types, - IniFiles, - // Project - UExceptions; - - -type - /// Extension of TMemIniFile that loads its data from a file. - /// Any quotes enclosing values read from the ini file are stripped. - /// - TDatabaseIniFile = class(TMemIniFile) - public - /// Object constructor. Sets up ini file object and loads data - /// into it from a file. - /// string [in] Name of ini file. - constructor Create(const AFileName: string); - /// Retrieves a string value from an ini file. - /// string [in] Section containing value. - /// - /// string [in] Identifier of value. - /// string [in] Default value used if - /// Ident has no associated value. - /// string containing the required value, with any - /// enclosing quotes removed. - /// Overrides the method in base class to strip enclosing quotes. - /// - function ReadString(const Section, Ident, Default: string): string; - override; - /// Loads ini object's data from a string array. - /// TStringDynArray [in] Array of strings to - /// be loaded. - /// Overloads inherited SetStrings method. - procedure SetStrings(const AStrings: TStringDynArray); overload; - end; - -type - /// Type of exception raised by TDatabaseIniFile. - EDatabaseIniFile = class(ECodeSnip); - - -implementation - - -uses - // Delphi - SysUtils, - Classes, - IOUtils, - // Project - UConsts, - UIOUtils; - -{ TDatabaseIniFile } - -constructor TDatabaseIniFile.Create(const AFileName: string); -resourcestring - sFileNotFound = 'File "%s" does not exist.'; -begin - inherited Create(AFileName); - if not TFile.Exists(AFileName) then - raise EDatabaseIniFile.CreateFmt( - sFileNotFound, [ExtractFileName(AFileName)] - ); - SetStrings(TFileIO.ReadAllLines(AFileName, TEncoding.UTF8, True)); -end; - -function TDatabaseIniFile.ReadString(const Section, Ident, - Default: string): string; -begin - // Read string from ini - Result := inherited ReadString(Section, Ident, Default); - // Strip any leading and trailing quotes - if (Length(Result) > 1) and (Result[1] = DOUBLEQUOTE) - and (Result[Length(Result)] = DOUBLEQUOTE) then - Result := Copy(Result, 2, Length(Result) - 2); -end; - -procedure TDatabaseIniFile.SetStrings(const AStrings: TStringDynArray); -var - SL: TStringList; - Str: string; -begin - SL := TStringList.Create; - try - for Str in AStrings do - SL.Add(Str); - SetStrings(SL); - finally - FreeAndNil(SL); - end; -end; - -end. - From 5908050a4bc5344fb0358153da6d8aa291627b86 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 5 Mar 2025 12:52:04 +0000 Subject: [PATCH 208/222] Rename DBIO.UIniData as DB.IO.DataFormat.DCSCv2 The old name of this unit was not indicative of the purpose of this unit. It is specialised for reading / writing the DelphiDabbler Code Snippets Collection v2 format. The fact that the .ini file format is used as part of the format is secondary. The uses statement of DB.UDatabaseIO was updated to reference the renamed unit. --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/{DBIO.UIniData.pas => DB.IO.DataFormat.DCSCv2.pas} | 4 +--- Src/DB.UDatabaseIO.pas | 2 +- 4 files changed, 4 insertions(+), 6 deletions(-) rename Src/{DBIO.UIniData.pas => DB.IO.DataFormat.DCSCv2.pas} (99%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 29d56f6a6..75590ae55 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -69,7 +69,7 @@ uses DB.USnippet in 'DB.USnippet.pas', DB.USnippetKind in 'DB.USnippetKind.pas', DBIO.UFileIOIntf in 'DBIO.UFileIOIntf.pas', - DBIO.UIniData in 'DBIO.UIniData.pas', + DB.IO.DataFormat.DCSCv2 in 'DB.IO.DataFormat.DCSCv2.pas', DBIO.UNulDataReader in 'DBIO.UNulDataReader.pas', DBIO.UXMLDataIO in 'DBIO.UXMLDataIO.pas', Favourites.UManager in 'Favourites.UManager.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 8361e1e3f..e6152ad67 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -72,7 +72,7 @@ - + diff --git a/Src/DBIO.UIniData.pas b/Src/DB.IO.DataFormat.DCSCv2.pas similarity index 99% rename from Src/DBIO.UIniData.pas rename to Src/DB.IO.DataFormat.DCSCv2.pas index 2b01f3041..ebc79bd6d 100644 --- a/Src/DBIO.UIniData.pas +++ b/Src/DB.IO.DataFormat.DCSCv2.pas @@ -9,10 +9,8 @@ * files. } -{TODO -cVault: rename INI term to DCSCv2 - this isn't a general .ini data - IO unit, the .ini format only part of a wider vault format.} -unit DBIO.UIniData; +unit DB.IO.DataFormat.DCSCv2; interface diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 2c2084dc9..04d25cb56 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -133,7 +133,7 @@ implementation DB.IO.DataFormat.Native, DBIO.UCategoryIO, DBIO.UFileIOIntf, - DBIO.UIniData, + DB.IO.DataFormat.DCSCv2, DBIO.UNulDataReader, DBIO.UXMLDataIO, UAppInfo, From 8a7c1d7b83b13d4c002994c2d0e7d6735af882bd Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 5 Mar 2025 16:49:30 +0000 Subject: [PATCH 209/222] Rename database i/o units to standardise naming Updated uses clauses of all affected units. --- Src/CodeSnip.dpr | 14 +++++++------- Src/CodeSnip.dproj | 14 +++++++------- Src/{DBIO.UCategoryIO.pas => DB.IO.Categories.pas} | 2 +- ...ImportExport.pas => DB.IO.ImportExport.CS4.pas} | 2 +- Src/{DBIO.UXMLDataIO.pas => DB.IO.Vault.CS4.pas} | 4 ++-- ...ataFormat.DCSCv2.pas => DB.IO.Vault.DCSCv2.pas} | 4 ++-- ...ataFormat.Native.pas => DB.IO.Vault.Native.pas} | 4 ++-- ...BIO.UNulDataReader.pas => DB.IO.Vault.Null.pas} | 4 ++-- Src/{DBIO.UFileIOIntf.pas => DB.IO.Vault.pas} | 2 +- Src/DB.UDatabaseIO.pas | 12 ++++++------ Src/DB.UMain.pas | 2 +- Src/FmCodeExportDlg.pas | 2 +- Src/UCodeImportMgr.pas | 2 +- 13 files changed, 34 insertions(+), 34 deletions(-) rename Src/{DBIO.UCategoryIO.pas => DB.IO.Categories.pas} (99%) rename Src/{UCodeImportExport.pas => DB.IO.ImportExport.CS4.pas} (99%) rename Src/{DBIO.UXMLDataIO.pas => DB.IO.Vault.CS4.pas} (99%) rename Src/{DB.IO.DataFormat.DCSCv2.pas => DB.IO.Vault.DCSCv2.pas} (99%) rename Src/{DB.IO.DataFormat.Native.pas => DB.IO.Vault.Native.pas} (99%) rename Src/{DBIO.UNulDataReader.pas => DB.IO.Vault.Null.pas} (99%) rename Src/{DBIO.UFileIOIntf.pas => DB.IO.Vault.pas} (99%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 75590ae55..a8148b507 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -68,10 +68,10 @@ uses DB.UMain in 'DB.UMain.pas', DB.USnippet in 'DB.USnippet.pas', DB.USnippetKind in 'DB.USnippetKind.pas', - DBIO.UFileIOIntf in 'DBIO.UFileIOIntf.pas', - DB.IO.DataFormat.DCSCv2 in 'DB.IO.DataFormat.DCSCv2.pas', - DBIO.UNulDataReader in 'DBIO.UNulDataReader.pas', - DBIO.UXMLDataIO in 'DBIO.UXMLDataIO.pas', + DB.IO.Vault in 'DB.IO.Vault.pas', + DB.IO.Vault.DCSCv2 in 'DB.IO.Vault.DCSCv2.pas', + DB.IO.Vault.Null in 'DB.IO.Vault.Null.pas', + DB.IO.Vault.CS4 in 'DB.IO.Vault.CS4.pas', Favourites.UManager in 'Favourites.UManager.pas', Favourites.UFavourites in 'Favourites.UFavourites.pas', Favourites.UPersist in 'Favourites.UPersist.pas', @@ -193,7 +193,7 @@ uses UI.Adapters.CategoryList in 'UI.Adapters.CategoryList.pas', ClassHelpers.UControls in 'ClassHelpers.UControls.pas', UClipboardHelper in 'UClipboardHelper.pas', - UCodeImportExport in 'UCodeImportExport.pas', + DB.IO.ImportExport.CS4 in 'DB.IO.ImportExport.CS4.pas', UCodeImportMgr in 'UCodeImportMgr.pas', UCodeShareMgr in 'UCodeShareMgr.pas', UColorBoxEx in 'UColorBoxEx.pas', @@ -373,11 +373,11 @@ uses ClassHelpers.UActions in 'ClassHelpers.UActions.pas', DB.Vaults in 'DB.Vaults.pas', UTabSeparatedFileIO in 'UTabSeparatedFileIO.pas', - DBIO.UCategoryIO in 'DBIO.UCategoryIO.pas', + DB.IO.Categories in 'DB.IO.Categories.pas', UI.Adapters.VaultList in 'UI.Adapters.VaultList.pas', UI.Forms.BackupVaultDlg in 'UI.Forms.BackupVaultDlg.pas' {VaultBackupDlg}, DB.DataFormats in 'DB.DataFormats.pas', - DB.IO.DataFormat.Native in 'DB.IO.DataFormat.Native.pas', + DB.IO.Vault.Native in 'DB.IO.Vault.Native.pas', DB.MetaData in 'DB.MetaData.pas'; // Include resources diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index e6152ad67..532176c87 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -71,10 +71,10 @@ - - - - + + + + @@ -395,7 +395,7 @@ - + @@ -579,13 +579,13 @@ - +
    VaultBackupDlg
     - + diff --git a/Src/DBIO.UCategoryIO.pas b/Src/DB.IO.Categories.pas similarity index 99% rename from Src/DBIO.UCategoryIO.pas rename to Src/DB.IO.Categories.pas index 4c058c641..d7ff60cfb 100644 --- a/Src/DBIO.UCategoryIO.pas +++ b/Src/DB.IO.Categories.pas @@ -8,7 +8,7 @@ * Class that read and write category information from and to files. } -unit DBIO.UCategoryIO; +unit DB.IO.Categories; interface diff --git a/Src/UCodeImportExport.pas b/Src/DB.IO.ImportExport.CS4.pas similarity index 99% rename from Src/UCodeImportExport.pas rename to Src/DB.IO.ImportExport.CS4.pas index 5fa9dc5e3..8af0625ad 100644 --- a/Src/UCodeImportExport.pas +++ b/Src/DB.IO.ImportExport.CS4.pas @@ -9,7 +9,7 @@ } -unit UCodeImportExport; +unit DB.IO.ImportExport.CS4; interface diff --git a/Src/DBIO.UXMLDataIO.pas b/Src/DB.IO.Vault.CS4.pas similarity index 99% rename from Src/DBIO.UXMLDataIO.pas rename to Src/DB.IO.Vault.CS4.pas index 706505835..12c654629 100644 --- a/Src/DBIO.UXMLDataIO.pas +++ b/Src/DB.IO.Vault.CS4.pas @@ -10,7 +10,7 @@ } -unit DBIO.UXMLDataIO; +unit DB.IO.Vault.CS4; interface @@ -23,7 +23,7 @@ interface DB.MetaData, DB.UCategory, DB.USnippet, - DBIO.UFileIOIntf, + DB.IO.Vault, UIStringList, UREMLDataIO, UXMLDocumentEx; diff --git a/Src/DB.IO.DataFormat.DCSCv2.pas b/Src/DB.IO.Vault.DCSCv2.pas similarity index 99% rename from Src/DB.IO.DataFormat.DCSCv2.pas rename to Src/DB.IO.Vault.DCSCv2.pas index ebc79bd6d..cf01c21c3 100644 --- a/Src/DB.IO.DataFormat.DCSCv2.pas +++ b/Src/DB.IO.Vault.DCSCv2.pas @@ -10,7 +10,7 @@ } -unit DB.IO.DataFormat.DCSCv2; +unit DB.IO.Vault.DCSCv2; interface @@ -28,7 +28,7 @@ interface DB.MetaData, DB.UCategory, DB.USnippet, - DBIO.UFileIOIntf, + DB.IO.Vault, UIStringList, UVersionInfo; diff --git a/Src/DB.IO.DataFormat.Native.pas b/Src/DB.IO.Vault.Native.pas similarity index 99% rename from Src/DB.IO.DataFormat.Native.pas rename to Src/DB.IO.Vault.Native.pas index c5171e0ac..e7325ab42 100644 --- a/Src/DB.IO.DataFormat.Native.pas +++ b/Src/DB.IO.Vault.Native.pas @@ -10,7 +10,7 @@ } -unit DB.IO.DataFormat.Native; +unit DB.IO.Vault.Native; interface @@ -23,7 +23,7 @@ interface DB.UCategory, DB.USnippet, DB.USnippetKind, - DBIO.UFileIOIntf, + DB.IO.Vault, UIStringList, UVersionInfo, UXMLDocumentEx; diff --git a/Src/DBIO.UNulDataReader.pas b/Src/DB.IO.Vault.Null.pas similarity index 99% rename from Src/DBIO.UNulDataReader.pas rename to Src/DB.IO.Vault.Null.pas index b98522bd5..ee166df74 100644 --- a/Src/DBIO.UNulDataReader.pas +++ b/Src/DB.IO.Vault.Null.pas @@ -9,7 +9,7 @@ } -unit DBIO.UNulDataReader; +unit DB.IO.Vault.Null; interface @@ -20,7 +20,7 @@ interface DB.MetaData, DB.UCategory, DB.USnippet, - DBIO.UFileIOIntf, + DB.IO.Vault, UIStringList; diff --git a/Src/DBIO.UFileIOIntf.pas b/Src/DB.IO.Vault.pas similarity index 99% rename from Src/DBIO.UFileIOIntf.pas rename to Src/DB.IO.Vault.pas index 767321f5d..85ed52a53 100644 --- a/Src/DBIO.UFileIOIntf.pas +++ b/Src/DB.IO.Vault.pas @@ -11,7 +11,7 @@ } -unit DBIO.UFileIOIntf; +unit DB.IO.Vault; interface diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index 04d25cb56..d702d3914 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -130,12 +130,12 @@ implementation IOUtils, // Project DB.DataFormats, - DB.IO.DataFormat.Native, - DBIO.UCategoryIO, - DBIO.UFileIOIntf, - DB.IO.DataFormat.DCSCv2, - DBIO.UNulDataReader, - DBIO.UXMLDataIO, + DB.IO.Vault.CS4, + DB.IO.Vault.DCSCv2, + DB.IO.Vault.Native, + DB.IO.Vault, + DB.IO.Vault.Null, + DB.IO.Categories, UAppInfo, UConsts, UIStringList, diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 90ab6b19c..e8cd8ab9d 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -321,7 +321,7 @@ implementation Generics.Defaults, // Project DB.UDatabaseIO, - DBIO.UCategoryIO, + DB.IO.Categories, IntfCommon, UExceptions, UQuery, diff --git a/Src/FmCodeExportDlg.pas b/Src/FmCodeExportDlg.pas index 5931a2c8c..36bc924f8 100644 --- a/Src/FmCodeExportDlg.pas +++ b/Src/FmCodeExportDlg.pas @@ -77,7 +77,7 @@ implementation SysUtils, Dialogs, // Project DB.Vaults, - UCodeImportExport, + DB.IO.ImportExport.CS4, UCtrlArranger, UEncodings, UExceptions, diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index ae63eb4f1..55fd332d3 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -23,7 +23,7 @@ interface Generics.Defaults, // Project DB.Vaults, - UCodeImportExport, + DB.IO.ImportExport.CS4, UExceptions, UIStringList; From 03445c3924e537e23ba137add1f4e5902918ab6b Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Wed, 5 Mar 2025 19:48:48 +0000 Subject: [PATCH 210/222] Standardise class names in all DB.IO namespace units Renamed all major classes in units in the DB.IO namespace into a standard format that describes the data format they use. Many of these class names previously described the type of file used (e.g. XML or .ini). --- Src/DB.IO.Categories.pas | 50 +++++----- Src/DB.IO.ImportExport.CS4.pas | 82 +++++++++-------- Src/DB.IO.Vault.CS4.pas | 112 +++++++++++----------- Src/DB.IO.Vault.DCSCv2.pas | 163 ++++++++++++++++++--------------- Src/DB.IO.Vault.Native.pas | 101 ++++++++++---------- Src/DB.IO.Vault.Null.pas | 33 +++---- Src/DB.IO.Vault.pas | 25 ++--- Src/DB.UDatabaseIO.pas | 70 +++++++------- Src/FmCodeExportDlg.pas | 2 +- Src/UCodeImportMgr.pas | 4 +- 10 files changed, 324 insertions(+), 318 deletions(-) diff --git a/Src/DB.IO.Categories.pas b/Src/DB.IO.Categories.pas index d7ff60cfb..8f28eb091 100644 --- a/Src/DB.IO.Categories.pas +++ b/Src/DB.IO.Categories.pas @@ -22,8 +22,9 @@ interface UTabSeparatedFileIO; type - /// Base class for category reader and writer classes. - TCategoryIO = class abstract(TObject) + /// Base class for category storage reader and writer classes. + /// + TCategoryStorage = class abstract(TObject) strict protected const /// Watermark that is present on the first line of a valid @@ -31,8 +32,8 @@ TCategoryIO = class abstract(TObject) Watermark = #$25BA + ' CodeSnip Categories v1 ' + #$25C4; end; - /// Class used to read category information from a file. - TCategoryReader = class sealed(TCategoryIO) + /// Reads category information from storage. + TCategoryStorageReader = class sealed(TCategoryStorage) public type /// Key / Value pair associating the category ID (key) with the @@ -47,8 +48,8 @@ TCategoryReader = class sealed(TCategoryIO) fCatData: TList; /// Parses fields that have been split out from each text line. /// - /// ECategoryReader raised if the fields are not valid. - /// + /// ECategoryStorageReader raised if the fields are not + /// valid. procedure ParseFields(AFields: TArray); public /// Creates object to read from file AFileName. @@ -58,16 +59,17 @@ TCategoryReader = class sealed(TCategoryIO) /// Reads data about each category defined in file. /// TArray<TCategoryIDAndData>. Array of category /// data. - /// ECategoryReader raised if the file can't be read or - /// if its contents are invalid. + /// ECategoryStorageReader raised if the file can't be + /// read or if its contents are invalid. function Read: TArray; end; - /// Class of exception raised by TCategoryReader. - ECategoryReader = class(ECodeSnip); + /// Class of exception raised by TCategoryStorageReader. + /// + ECategoryStorageReader = class(ECodeSnip); - /// Class used to write category information to a file. - TCategoryWriter = class sealed(TCategoryIO) + /// Writes category information to storage. + TCategoryStorageWriter = class sealed(TCategoryStorage) strict private var /// Object that writes data to a tab delimited UTF8 text file. @@ -89,9 +91,9 @@ implementation // Project UStrUtils; -{ TCategoryReader } +{ TCategoryStorageReader } -constructor TCategoryReader.Create(const AFileName: string); +constructor TCategoryStorageReader.Create(const AFileName: string); begin Assert(not StrIsEmpty(AFileName), ClassName + '.Create: AFileName is empty'); inherited Create; @@ -99,14 +101,14 @@ constructor TCategoryReader.Create(const AFileName: string); fCatData := TList.Create; end; -destructor TCategoryReader.Destroy; +destructor TCategoryStorageReader.Destroy; begin fCatData.Free; fFileReader.Free; inherited; end; -procedure TCategoryReader.ParseFields(AFields: TArray); +procedure TCategoryStorageReader.ParseFields(AFields: TArray); resourcestring sMalformedLine = 'Malformed line in categories file'; var @@ -114,45 +116,45 @@ procedure TCategoryReader.ParseFields(AFields: TArray); Data: TCategoryData; begin if Length(AFields) <> 2 then - raise ECategoryReader.Create(sMalformedLine); + raise ECategoryStorageReader.Create(sMalformedLine); if StrIsEmpty(AFields[0]) or StrIsEmpty(AFields[1]) then - raise ECategoryReader.Create(sMalformedLine); + raise ECategoryStorageReader.Create(sMalformedLine); CatID := StrTrim(AFields[0]); Data.Init; Data.Desc := StrTrim(AFields[1]); fCatData.Add(TCategoryIDAndData.Create(CatID, Data)); end; -function TCategoryReader.Read: TArray; +function TCategoryStorageReader.Read: TArray; begin fCatData.Clear; try fFileReader.Read(ParseFields); except on E: ETabSeparatedReader do - raise ECategoryReader.Create(E); + raise ECategoryStorageReader.Create(E); else raise; end; Result := fCatData.ToArray; end; -{ TCategoryWriter } +{ TCategoryStorageWriter } -constructor TCategoryWriter.Create(const AFileName: string); +constructor TCategoryStorageWriter.Create(const AFileName: string); begin Assert(not StrIsEmpty(AFileName), ClassName + '.Create: AFileName is empty'); inherited Create; fFileWriter := TTabSeparatedFileWriter.Create(AFileName, Watermark); end; -destructor TCategoryWriter.Destroy; +destructor TCategoryStorageWriter.Destroy; begin fFileWriter.Free; inherited; end; -procedure TCategoryWriter.Write(const ACategoryList: TCategoryList); +procedure TCategoryStorageWriter.Write(const ACategoryList: TCategoryList); var Cat: TCategory; begin diff --git a/Src/DB.IO.ImportExport.CS4.pas b/Src/DB.IO.ImportExport.CS4.pas index 8af0625ad..00608cd91 100644 --- a/Src/DB.IO.ImportExport.CS4.pas +++ b/Src/DB.IO.ImportExport.CS4.pas @@ -51,8 +51,9 @@ TSnippetInfo = record TSnippetInfoList = array of TSnippetInfo; type - /// Imports code snippets from XML. - TCodeImporter = class(TNoPublicConstructObject) + /// Imports code snippets from CodeSnip 4 import/export format + /// files. + TCS4SnippetImporter = class(TNoPublicConstructObject) strict private const {TODO -cVault: Let user select or create a category rather than imposing @@ -96,13 +97,14 @@ TCodeImporter = class(TNoPublicConstructObject) end; type - /// Class of exception raised when TCodeImporter encounters invalid - /// XML. - ECodeImporter = class(ECodeSnipXML); + /// Class of exception raised when TCS4SnippetImporter + /// encounters invalid XML. + ECS4SnippetImporter = class(ECodeSnipXML); type - /// Exports code snippets to XML. - TCodeExporter = class(TNoPublicConstructObject) + /// Exports code snippets to CodeSnip 4 import/export format file + /// + TCS4SnippetExporter = class(TNoPublicConstructObject) strict private var fSnippetKeyMap: TDictionary; @@ -167,9 +169,9 @@ TCodeExporter = class(TNoPublicConstructObject) end; type - /// Class of exception raised when TCodeExporter detects an expected - /// error. - ECodeExporter = class(ECodeSnipXML); + /// Class of exception raised when TCS4SnippetExporter + /// detects an expected error. + ECS4SnippetExporter = class(ECodeSnipXML); implementation @@ -199,16 +201,16 @@ implementation cEarliestVersion = 1; // earliest file version supported by importer cLatestVersion = 7; // current file version written by exporter -{ TCodeExporter } +{ TCS4SnippetExporter } -destructor TCodeExporter.Destroy; +destructor TCS4SnippetExporter.Destroy; begin fSnippetKeyMap.Free; fXMLDoc := nil; inherited; end; -function TCodeExporter.Execute: TEncodedData; +function TCS4SnippetExporter.Execute: TEncodedData; var RootNode: IXMLNode; // document root node resourcestring @@ -239,10 +241,10 @@ function TCodeExporter.Execute: TEncodedData; end; end; -class function TCodeExporter.ExportSnippets(const SnipList: TSnippetList): +class function TCS4SnippetExporter.ExportSnippets(const SnipList: TSnippetList): TEncodedData; var - Instance: TCodeExporter; + Instance: TCS4SnippetExporter; begin Instance := InternalCreate(SnipList); try @@ -252,14 +254,14 @@ class function TCodeExporter.ExportSnippets(const SnipList: TSnippetList): end; end; -procedure TCodeExporter.HandleException(const EObj: TObject); +procedure TCS4SnippetExporter.HandleException(const EObj: TObject); begin if (EObj is EFileStreamError) or (EObj is ECodeSnipXML) then - raise ECodeExporter.Create(EObj as Exception); + raise ECS4SnippetExporter.Create(EObj as Exception); raise EObj; end; -constructor TCodeExporter.InternalCreate(const SnipList: TSnippetList); +constructor TCS4SnippetExporter.InternalCreate(const SnipList: TSnippetList); var Snippet: TSnippet; begin @@ -276,7 +278,8 @@ constructor TCodeExporter.InternalCreate(const SnipList: TSnippetList); ); end; -function TCodeExporter.SnippetKeys(const SnipList: TSnippetList): IStringList; +function TCS4SnippetExporter.SnippetKeys(const SnipList: TSnippetList): + IStringList; var Snippet: TSnippet; // references each snippet in list begin @@ -286,14 +289,14 @@ function TCodeExporter.SnippetKeys(const SnipList: TSnippetList): IStringList; Result.Add(fSnippetKeyMap[Snippet.ID]); end; -procedure TCodeExporter.WriteProgInfo(const ParentNode: IXMLNode); +procedure TCS4SnippetExporter.WriteProgInfo(const ParentNode: IXMLNode); begin fXMLDoc.CreateElement( ParentNode, cProgVersionNode, TAppInfo.ProgramReleaseVersion ); end; -procedure TCodeExporter.WriteReferenceList(const ParentNode: IXMLNode; +procedure TCS4SnippetExporter.WriteReferenceList(const ParentNode: IXMLNode; const ListNodeName: string; PasNames: IStringList); begin // Don't write list tags if no items @@ -305,7 +308,7 @@ procedure TCodeExporter.WriteReferenceList(const ParentNode: IXMLNode; ); end; -procedure TCodeExporter.WriteSnippet(const ParentNode: IXMLNode; +procedure TCS4SnippetExporter.WriteSnippet(const ParentNode: IXMLNode; const Snippet: TSnippet); var SnippetNode: IXMLNode; // new snippet node @@ -358,7 +361,7 @@ procedure TCodeExporter.WriteSnippet(const ParentNode: IXMLNode; ); end; -procedure TCodeExporter.WriteSnippets(const ParentNode: IXMLNode); +procedure TCS4SnippetExporter.WriteSnippets(const ParentNode: IXMLNode); var Node: IXMLNode; // new snippets list node Snippet: TSnippet; // refers to each exported snippet @@ -370,16 +373,16 @@ procedure TCodeExporter.WriteSnippets(const ParentNode: IXMLNode); WriteSnippet(Node, Snippet); end; -{ TCodeImporter } +{ TCS4SnippetImporter } -destructor TCodeImporter.Destroy; +destructor TCS4SnippetImporter.Destroy; begin fXMLDoc := nil; OleUninitialize; inherited; end; -class procedure TCodeImporter.EnsureImportCategoryExists; +class procedure TCS4SnippetImporter.EnsureImportCategoryExists; resourcestring ImportCatDesc = 'Imported Snippets'; var @@ -393,7 +396,7 @@ class procedure TCodeImporter.EnsureImportCategoryExists; end; end; -procedure TCodeImporter.Execute(const Data: TBytes); +procedure TCS4SnippetImporter.Execute(const Data: TBytes); /// Reads list of units from under SnippetNode into Units list. procedure GetUnits(const SnippetNode: IXMLNode; Units: IStringList); @@ -479,9 +482,8 @@ procedure TCodeImporter.Execute(const Data: TBytes); fSnippetInfo[Idx].Data.Props.SourceCode := TXMLDocHelper.GetSubTagText( fXMLDoc, SnippetNode, cSourceCodeTextNode ); - fSnippetInfo[Idx].Data.Props.HiliteSource := TXMLDocHelper.GetHiliteSource( - fXMLDoc, SnippetNode, True - ); + fSnippetInfo[Idx].Data.Props.HiliteSource := + TXMLDocHelper.GetHiliteSource(fXMLDoc, SnippetNode, True); // how we read extra property depends on version of file case fVersion of 1: @@ -522,15 +524,15 @@ procedure TCodeImporter.Execute(const Data: TBytes); end; except on E: EDOMParseError do - raise ECodeImporter.Create(sParseError); + raise ECS4SnippetImporter.Create(sParseError); on E: ECodeSnipXML do - raise ECodeImporter.Create(E); + raise ECS4SnippetImporter.Create(E); else raise; end; end; -function TCodeImporter.GetAllSnippetNodes: IXMLSimpleNodeList; +function TCS4SnippetImporter.GetAllSnippetNodes: IXMLSimpleNodeList; var SnippetsNode: IXMLNode; // node under which all snippets are stored begin @@ -538,11 +540,11 @@ function TCodeImporter.GetAllSnippetNodes: IXMLSimpleNodeList; Result := fXMLDoc.FindChildNodes(SnippetsNode, cSnippetNode); end; -class procedure TCodeImporter.ImportData(out SnippetInfo: TSnippetInfoList; - const Data: TBytes); +class procedure TCS4SnippetImporter.ImportData( + out SnippetInfo: TSnippetInfoList; const Data: TBytes); var Idx: Integer; // loops through all imported snippets - Instance: TCodeImporter; + Instance: TCS4SnippetImporter; begin Instance := InternalCreate; try @@ -555,7 +557,7 @@ class procedure TCodeImporter.ImportData(out SnippetInfo: TSnippetInfoList; end; end; -constructor TCodeImporter.InternalCreate; +constructor TCS4SnippetImporter.InternalCreate; begin inherited InternalCreate; OleInitialize(nil); @@ -564,7 +566,7 @@ constructor TCodeImporter.InternalCreate; EnsureImportCategoryExists; end; -function TCodeImporter.ValidateDoc: Integer; +function TCS4SnippetImporter.ValidateDoc: Integer; var SnippetsNode: IXMLNode; // node where snippets are recorded SnippetNodes: IXMLSimpleNodeList; // list of nodes describing snippets @@ -582,11 +584,11 @@ function TCodeImporter.ValidateDoc: Integer; // Must be a snippets node SnippetsNode := fXMLDoc.FindNode(cExportRootNode + '\' + cSnippetsNode); if not Assigned(SnippetsNode) then - raise ECodeImporter.CreateFmt(sMissingNode, [cSnippetsNode]); + raise ECS4SnippetImporter.CreateFmt(sMissingNode, [cSnippetsNode]); // Must be at least one snippet node SnippetNodes := fXMLDoc.FindChildNodes(SnippetsNode, cSnippetNode); if SnippetNodes.Count = 0 then - raise ECodeImporter.CreateFmt(sMissingNode, [cSnippetNode]); + raise ECS4SnippetImporter.CreateFmt(sMissingNode, [cSnippetNode]); end; { TSnippetInfo } diff --git a/Src/DB.IO.Vault.CS4.pas b/Src/DB.IO.Vault.CS4.pas index 12c654629..e60380594 100644 --- a/Src/DB.IO.Vault.CS4.pas +++ b/Src/DB.IO.Vault.CS4.pas @@ -31,12 +31,9 @@ interface type - { - TXMLDataIO: - Base class for classes that read and write databases stored in an XML file - and linked data files. - } - TXMLDataIO = class(TInterfacedObject) + /// Base class for classes that read and write vault data in the + /// CodeSnip 4 user data format. + TCS4VaultStorage = class(TInterfacedObject) strict protected fDBDir: string; // Database directory fXMLDoc: IXMLDocumentEx; // Extended XML document object @@ -76,13 +73,10 @@ TXMLDataIO = class(TInterfacedObject) } end; - { - TXMLDataReader: - Class that can read a database from an XML file and various linked data - files. - } - TXMLDataReader = class(TXMLDataIO, - IDataReader + /// Reads a vault's data from storage in the CodeSnip 4 user data + /// format. + TCS4VaultStorageReader = class(TCS4VaultStorage, + IVaultStorageReader ) strict private fVersion: Integer; @@ -165,13 +159,10 @@ TXMLDataReader = class(TXMLDataIO, function GetMetaData: TMetaData; end; - { - TXMLDataWriter: - Class that can write a database to an XML file and various linked data - files. - } - TXMLDataWriter = class(TXMLDataIO, - IDataWriter + /// Writes a vault's data to storage in the CodeSnip 4 user data + /// format. + TCS4VaultStorageWriter = class(TCS4VaultStorage, + IVaultStorageWriter ) strict private fFileNum: Integer; // Number of next available unused data file @@ -304,13 +295,13 @@ procedure Error(const FmtStr: string; const Args: array of const); overload; raise EDataIO.CreateFmt(FmtStr, Args); end; -{ TXMLDataIO } +{ TCS4VaultStorage } resourcestring // Error message sMissingNode = 'Document has no %s node.'; -constructor TXMLDataIO.Create(const DBDir: string); +constructor TCS4VaultStorage.Create(const DBDir: string); {Class constructor. Creates object and XML document for a given database. @param DBDir [in] Directory where database is stored. } @@ -323,7 +314,7 @@ constructor TXMLDataIO.Create(const DBDir: string); fXMLDoc := TXMLDocHelper.CreateXMLDoc; end; -function TXMLDataIO.DataDir: string; +function TCS4VaultStorage.DataDir: string; {Gets name of directory storing the database being accessed. Path varies according to which database is being accessed. @return Path to directory. @@ -332,7 +323,7 @@ function TXMLDataIO.DataDir: string; Result := ExcludeTrailingPathDelimiter(fDBDir); end; -function TXMLDataIO.DataFile(const FileName: string): string; +function TCS4VaultStorage.DataFile(const FileName: string): string; {Gets full path to a file name. Path depends on which database is being accessed. @param FileName [in] File name for which path is required. @@ -342,7 +333,7 @@ function TXMLDataIO.DataFile(const FileName: string): string; Result := IncludeTrailingPathDelimiter(DataDir) + FileName; end; -destructor TXMLDataIO.Destroy; +destructor TCS4VaultStorage.Destroy; {Class destructor. Tears down object. } begin @@ -352,7 +343,7 @@ destructor TXMLDataIO.Destroy; inherited; end; -function TXMLDataIO.FindCategoryNode(const CatID: string): IXMLNode; +function TCS4VaultStorage.FindCategoryNode(const CatID: string): IXMLNode; {Finds a specified category node in the file. @param CatID [in] Id of required category. @return Required node or nil if node doesn't exist. @@ -371,7 +362,7 @@ function TXMLDataIO.FindCategoryNode(const CatID: string): IXMLNode; ) end; -function TXMLDataIO.FindSnippetNode(const SnippetKey: string): IXMLNode; +function TCS4VaultStorage.FindSnippetNode(const SnippetKey: string): IXMLNode; {Finds a specified snippet node for a snippet in the file. @param SnippetKey [in] Key of required snippet. @return Required node or nil if node doesn't exist. @@ -390,7 +381,7 @@ function TXMLDataIO.FindSnippetNode(const SnippetKey: string): IXMLNode; ); end; -function TXMLDataIO.PathToXMLFile: string; +function TCS4VaultStorage.PathToXMLFile: string; {Gets fully specified path to the XML file. Path depends on which database is being accessed. @return Required path. @@ -399,7 +390,7 @@ function TXMLDataIO.PathToXMLFile: string; Result := DataFile(cDatabaseFileName); end; -{ TXMLDataReader } +{ TCS4VaultStorageReader } resourcestring // Error messages @@ -409,7 +400,7 @@ function TXMLDataIO.PathToXMLFile: string; sMissingSource = 'Source code file name missing for snippet "%s"'; sDBError = 'The database is corrupt and had been deleted.' + EOL2 + '%s'; -constructor TXMLDataReader.Create(const DBDir: string); +constructor TCS4VaultStorageReader.Create(const DBDir: string); {Class constructor. Sets up object and loads XML from file if database master file exists, otherwise creates a minimal empty document. @param DBDir [in] Directory where database is stored. @@ -442,7 +433,7 @@ constructor TXMLDataReader.Create(const DBDir: string); end; end; -function TXMLDataReader.DatabaseExists: Boolean; +function TCS4VaultStorageReader.DatabaseExists: Boolean; {Check if the database exists. This method is always called first. No other methods are called if this method returns false. @return True if database exists, False if not. @@ -451,7 +442,7 @@ function TXMLDataReader.DatabaseExists: Boolean; Result := FileExists(PathToXMLFile); end; -function TXMLDataReader.GetAllCatIDs: IStringList; +function TCS4VaultStorageReader.GetAllCatIDs: IStringList; {Get ids of all categories in database. @return List of category names. } @@ -473,7 +464,7 @@ function TXMLDataReader.GetAllCatIDs: IStringList; end; end; -procedure TXMLDataReader.GetCatProps(const CatID: string; +procedure TCS4VaultStorageReader.GetCatProps(const CatID: string; var Props: TCategoryData); {Get properties of a category. @param CatID [in] Id of required category. @@ -497,7 +488,8 @@ procedure TXMLDataReader.GetCatProps(const CatID: string; end; end; -function TXMLDataReader.GetCatSnippets(const CatID: string): IStringList; +function TCS4VaultStorageReader.GetCatSnippets(const CatID: string): + IStringList; {Get keys of all snippets in a category. @param CatID [in] Id of category containing snippets. @return List of snippet keys. @@ -520,13 +512,13 @@ function TXMLDataReader.GetCatSnippets(const CatID: string): IStringList; end; end; -function TXMLDataReader.GetMetaData: TMetaData; +function TCS4VaultStorageReader.GetMetaData: TMetaData; begin // Meta data not supported by this data format Result := TMetaData.CreateNull; end; -function TXMLDataReader.GetSnippetDepends(const SnippetKey: string): +function TCS4VaultStorageReader.GetSnippetDepends(const SnippetKey: string): IStringList; {Get list of all snippets on which a given snippet depends. @param SnippetKey [in] Key of required snippet. @@ -536,7 +528,7 @@ function TXMLDataReader.GetSnippetDepends(const SnippetKey: string): Result := GetSnippetReferences(SnippetKey, cDependsNode); end; -procedure TXMLDataReader.GetSnippetProps(const SnippetKey: string; +procedure TCS4VaultStorageReader.GetSnippetProps(const SnippetKey: string; var Props: TSnippetData); {Get properties of a snippet. @param SnippetKey [in] Key of required snippet. @@ -546,7 +538,6 @@ procedure TXMLDataReader.GetSnippetProps(const SnippetKey: string; var SnippetNode: IXMLNode; // node for required snippet - // --------------------------------------------------------------------------- function GetPropertyText(const PropTagName: string): string; {Gets text of a specified property. @param PropTagName [in] Tag associated with property. @@ -656,7 +647,6 @@ procedure TXMLDataReader.GetSnippetProps(const SnippetKey: string; else Result := TActiveTextFactory.CreateActiveText; end; - // --------------------------------------------------------------------------- begin try @@ -682,8 +672,8 @@ procedure TXMLDataReader.GetSnippetProps(const SnippetKey: string; end; end; -function TXMLDataReader.GetSnippetReferences(const SnippetKey, RefName: string): - IStringList; +function TCS4VaultStorageReader.GetSnippetReferences(const SnippetKey, + RefName: string): IStringList; {Get list of all specified references made by a snippet. @param SnippetKey [in] Key of required snippet. @param RefName [in] Name of node containing snippet's references. @@ -706,7 +696,8 @@ function TXMLDataReader.GetSnippetReferences(const SnippetKey, RefName: string): end; end; -function TXMLDataReader.GetSnippetUnits(const SnippetKey: string): IStringList; +function TCS4VaultStorageReader.GetSnippetUnits(const SnippetKey: string): + IStringList; {Get list of all units referenced by a snippet. @param SnippetKey [in] Key of required snippet. @return List of unit keys. @@ -715,7 +706,8 @@ function TXMLDataReader.GetSnippetUnits(const SnippetKey: string): IStringList; Result := GetSnippetReferences(SnippetKey, cUnitsNode); end; -function TXMLDataReader.GetSnippetXRefs(const SnippetKey: string): IStringList; +function TCS4VaultStorageReader.GetSnippetXRefs(const SnippetKey: string): + IStringList; {Get list of all snippets that are cross referenced by a snippet. @param SnippetKey [in] Key of snippet we need cross references for. @return List of snippet keys. @@ -724,7 +716,7 @@ function TXMLDataReader.GetSnippetXRefs(const SnippetKey: string): IStringList; Result := GetSnippetReferences(SnippetKey, cXRefNode); end; -procedure TXMLDataReader.HandleCorruptDatabase(const EObj: TObject); +procedure TCS4VaultStorageReader.HandleCorruptDatabase(const EObj: TObject); {Called when a corrupt database is encountered. Deletes all files and raises exception. @param EObj [in] Reference to exception that caused this method to be @@ -747,7 +739,7 @@ procedure TXMLDataReader.HandleCorruptDatabase(const EObj: TObject); raise EObj; end; -function TXMLDataReader.ValidateDoc: Integer; +function TCS4VaultStorageReader.ValidateDoc: Integer; {Validates XML document and gets file version. @return XML file version number. @except EDataIO raised if XML is not valid. @@ -767,9 +759,9 @@ function TXMLDataReader.ValidateDoc: Integer; Error(sMissingNode, [cSnippetsNode]); end; -{ TXMLDataWriter } +{ TCS4VaultStorageWriter } -procedure TXMLDataWriter.Finalise; +procedure TCS4VaultStorageWriter.Finalise; {Finalises the database. Always called after all other methods. } var @@ -793,7 +785,7 @@ procedure TXMLDataWriter.Finalise; end; end; -procedure TXMLDataWriter.HandleException(const EObj: TObject); +procedure TCS4VaultStorageWriter.HandleException(const EObj: TObject); {Handles exceptions raised by converting expected exceptions into ECodeSnip derived exceptions. @param EObj [in] Reference to exception to be handled. @@ -805,7 +797,7 @@ procedure TXMLDataWriter.HandleException(const EObj: TObject); raise EObj; end; -procedure TXMLDataWriter.Initialise; +procedure TCS4VaultStorageWriter.Initialise; {Initialise the database. Always called before any other methods. } var @@ -843,7 +835,7 @@ procedure TXMLDataWriter.Initialise; end; end; -procedure TXMLDataWriter.WriteCatProps(const CatID: string; +procedure TCS4VaultStorageWriter.WriteCatProps(const CatID: string; const Props: TCategoryData); {Write the properties of a category. Always called before WriteCatSnippets for a given category, so can be used to perform any per-category initialisation. @@ -863,7 +855,7 @@ procedure TXMLDataWriter.WriteCatProps(const CatID: string; end; end; -procedure TXMLDataWriter.WriteCatSnippets(const CatID: string; +procedure TCS4VaultStorageWriter.WriteCatSnippets(const CatID: string; const SnipList: IStringList); {Write the list of snippets belonging to a category. Always called after WriteCatProps for any given category. @@ -888,13 +880,13 @@ procedure TXMLDataWriter.WriteCatSnippets(const CatID: string; end; end; -procedure TXMLDataWriter.WriteMetaData(const AMetaData: TMetaData); +procedure TCS4VaultStorageWriter.WriteMetaData(const AMetaData: TMetaData); begin // Do nothing: meta data not supported. end; -procedure TXMLDataWriter.WriteNameList(const Parent: IXMLNode; const ListName, - ItemName: string; const Items: IStringList); +procedure TCS4VaultStorageWriter.WriteNameList(const Parent: IXMLNode; + const ListName, ItemName: string; const Items: IStringList); {Writes a list of names to XML. @param Parent [in] Reference to node under which list is to be stored. @param ListName [in] Name of tag that encloses the list items. @@ -910,8 +902,8 @@ procedure TXMLDataWriter.WriteNameList(const Parent: IXMLNode; const ListName, fXMLDoc.CreateElement(ListNode, ItemName, Item); end; -procedure TXMLDataWriter.WriteReferenceList(const SnippetKey, ListName: string; - const Items: IStringList); +procedure TCS4VaultStorageWriter.WriteReferenceList(const SnippetKey, + ListName: string; const Items: IStringList); {Writes a snippet's reference list to XML. @param SnippetKey [in] Key of snippet whose reference list is to be written. @@ -938,7 +930,7 @@ procedure TXMLDataWriter.WriteReferenceList(const SnippetKey, ListName: string; end; end; -procedure TXMLDataWriter.WriteSnippetDepends(const SnippetKey: string; +procedure TCS4VaultStorageWriter.WriteSnippetDepends(const SnippetKey: string; const Depends: IStringList); {Write the list of snippets on which a snippet depends. @param SnippetKey [in] Snippet's key. @@ -948,7 +940,7 @@ procedure TXMLDataWriter.WriteSnippetDepends(const SnippetKey: string; WriteReferenceList(SnippetKey, cDependsNode, Depends); end; -procedure TXMLDataWriter.WriteSnippetProps(const SnippetKey: string; +procedure TCS4VaultStorageWriter.WriteSnippetProps(const SnippetKey: string; const Props: TSnippetData); {Write the properties of a snippet. Always called after all categories are written and before WriteSnippetsUnits, so can be used to perform any per- @@ -1006,7 +998,7 @@ procedure TXMLDataWriter.WriteSnippetProps(const SnippetKey: string; end; end; -procedure TXMLDataWriter.WriteSnippetUnits(const SnippetKey: string; +procedure TCS4VaultStorageWriter.WriteSnippetUnits(const SnippetKey: string; const Units: IStringList); {Write the list of units required by a snippet. @param SnippetKey [in] Snippet's key. @@ -1016,7 +1008,7 @@ procedure TXMLDataWriter.WriteSnippetUnits(const SnippetKey: string; WriteReferenceList(SnippetKey, cUnitsNode, Units); end; -procedure TXMLDataWriter.WriteSnippetXRefs(const SnippetKey: string; +procedure TCS4VaultStorageWriter.WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); {Write the list of snippets that a snippet cross-references. @param SnippetKey [in] Snippet's key. diff --git a/Src/DB.IO.Vault.DCSCv2.pas b/Src/DB.IO.Vault.DCSCv2.pas index cf01c21c3..2ea1368d3 100644 --- a/Src/DB.IO.Vault.DCSCv2.pas +++ b/Src/DB.IO.Vault.DCSCv2.pas @@ -35,9 +35,11 @@ interface type - /// Reads a vault from disk in the DelphiDabbler Code Snippets - /// Collection v2 format. - TIniDataReader = class sealed(TInterfacedObject, IDataReader) + /// Reads a vault's data from storage in the DelphiDabbler Code + /// Snippets Collection v2 format. + TDCSCV2VaultStorageReader = class sealed(TInterfacedObject, + IVaultStorageReader + ) strict private type /// Extension of TMemIniFile that loads its data from a @@ -179,7 +181,8 @@ TIniFileCache = class(TObject) /// string [in] Name of a key in ini file storing /// comma separated list of references. /// IStringList containing names of referenced items. - function GetSnippetReferences(const SnippetKey, KeyName: string): IStringList; + function GetSnippetReferences(const SnippetKey, KeyName: string): + IStringList; strict protected /// /// Extracts comma delimited text fields into a string list. @@ -258,9 +261,11 @@ TIniFileCache = class(TObject) function GetMetaData: TMetaData; end; - /// Write a vault to disk in the DelphiDabbler Code Snippets - /// Collection v2 format. - TIniDataWriter = class sealed(TInterfacedObject, IDataWriter) + /// Writes a vault's data to storage in the DelphiDabbler Code + /// Snippets Collection v2 format. + TDCSCV2VaultStorageWriter = class sealed(TInterfacedObject, + IVaultStorageWriter + ) strict private type @@ -519,20 +524,20 @@ implementation 'FPC' ); -{ TIniDataReader } +{ TDCSCV2VaultStorageReader } -function TIniDataReader.CatToCatIni(const CatID: string): string; +function TDCSCV2VaultStorageReader.CatToCatIni(const CatID: string): string; begin Result := DataFile(fMasterIni.ReadString(CatID, cMasterIniName, '')); end; -class function TIniDataReader.CommaStrToStrings( +class function TDCSCV2VaultStorageReader.CommaStrToStrings( const CommaStr: string): IStringList; begin Result := TIStringList.Create(CommaStr, ',', False, True); end; -constructor TIniDataReader.Create(const DBDir: string); +constructor TDCSCV2VaultStorageReader.Create(const DBDir: string); resourcestring // Error messages sVersionNotSpecified = 'Format version number not specified'; @@ -561,27 +566,28 @@ constructor TIniDataReader.Create(const DBDir: string); end; end; -function TIniDataReader.DatabaseExists: Boolean; +function TDCSCV2VaultStorageReader.DatabaseExists: Boolean; begin Result := FileExists(MasterFileName); end; -function TIniDataReader.DataDir: string; +function TDCSCV2VaultStorageReader.DataDir: string; begin Result := ExcludeTrailingPathDelimiter(fDBDir) end; -function TIniDataReader.DataFile(const FileName: string): string; +function TDCSCV2VaultStorageReader.DataFile(const FileName: string): string; begin Result := IncludeTrailingPathDelimiter(DataDir) + FileName; end; -function TIniDataReader.DataFileExists(const FileName: string): Boolean; +function TDCSCV2VaultStorageReader.DataFileExists(const FileName: string): + Boolean; begin Result := TFile.Exists(DataFile(FileName), False); end; -destructor TIniDataReader.Destroy; +destructor TDCSCV2VaultStorageReader.Destroy; begin fIniCache.Free; fSnippetCatMap.Free; @@ -590,12 +596,12 @@ destructor TIniDataReader.Destroy; inherited; end; -function TIniDataReader.GetAllCatIDs: IStringList; +function TDCSCV2VaultStorageReader.GetAllCatIDs: IStringList; begin Result := TIStringList.Create(fCatIDs); end; -procedure TIniDataReader.GetCatProps(const CatID: string; +procedure TDCSCV2VaultStorageReader.GetCatProps(const CatID: string; var Props: TCategoryData); begin try @@ -605,7 +611,8 @@ procedure TIniDataReader.GetCatProps(const CatID: string; end; end; -function TIniDataReader.GetCatSnippets(const CatID: string): IStringList; +function TDCSCV2VaultStorageReader.GetCatSnippets(const CatID: string): + IStringList; var CatIniFile: string; CatIni: TCustomIniFile; // accesses .ini file associated with category @@ -632,7 +639,8 @@ function TIniDataReader.GetCatSnippets(const CatID: string): IStringList; end; end; -function TIniDataReader.GetFileEncoding(const FileName: string): TEncoding; +function TDCSCV2VaultStorageReader.GetFileEncoding(const FileName: string): + TEncoding; begin // Old v1 database meta files may be in the system default encodings, v1 and // all v2 and later use UTF-8 with BOM. @@ -642,7 +650,7 @@ function TIniDataReader.GetFileEncoding(const FileName: string): TEncoding; Result := TEncoding.Default; end; -function TIniDataReader.GetMetaData: TMetaData; +function TDCSCV2VaultStorageReader.GetMetaData: TMetaData; var SL: TStringList; LicenseText: string; @@ -682,19 +690,18 @@ function TIniDataReader.GetMetaData: TMetaData; ); end; -function TIniDataReader.GetSnippetDepends(const SnippetKey: string): +function TDCSCV2VaultStorageReader.GetSnippetDepends(const SnippetKey: string): IStringList; begin Result := GetSnippetReferences(SnippetKey, cDependsName); end; -procedure TIniDataReader.GetSnippetProps(const SnippetKey: string; +procedure TDCSCV2VaultStorageReader.GetSnippetProps(const SnippetKey: string; var Props: TSnippetData); var CatIni: TCustomIniFile; // .ini file associated with snippet's category CatID: string; // snippet's category id - // --------------------------------------------------------------------------- /// Reads "StandardFormat" value from ini file. function GetStdFormatProperty: Boolean; begin @@ -834,7 +841,6 @@ procedure TIniDataReader.GetSnippetProps(const SnippetKey: string; else // Str = 'none' or any invalid value Result := stiNone; end; - // --------------------------------------------------------------------------- begin try @@ -859,7 +865,7 @@ procedure TIniDataReader.GetSnippetProps(const SnippetKey: string; end; end; -function TIniDataReader.GetSnippetReferences(const SnippetKey, +function TDCSCV2VaultStorageReader.GetSnippetReferences(const SnippetKey, KeyName: string): IStringList; var CatIni: TCustomIniFile; // accesses snippet's category's .ini @@ -874,17 +880,19 @@ function TIniDataReader.GetSnippetReferences(const SnippetKey, end; end; -function TIniDataReader.GetSnippetUnits(const SnippetKey: string): IStringList; +function TDCSCV2VaultStorageReader.GetSnippetUnits(const SnippetKey: string): + IStringList; begin Result := GetSnippetReferences(SnippetKey, cUnitsName); end; -function TIniDataReader.GetSnippetXRefs(const SnippetKey: string): IStringList; +function TDCSCV2VaultStorageReader.GetSnippetXRefs(const SnippetKey: string): + IStringList; begin Result := GetSnippetReferences(SnippetKey, cXRefName); end; -procedure TIniDataReader.HandleCorruptDatabase(const EObj: TObject); +procedure TDCSCV2VaultStorageReader.HandleCorruptDatabase(const EObj: TObject); resourcestring // Error message sDBError = 'The database is corrupt and had been deleted.' + EOL2 + '%s'; @@ -899,7 +907,7 @@ procedure TIniDataReader.HandleCorruptDatabase(const EObj: TObject); raise EObj; end; -procedure TIniDataReader.LoadIndices; +procedure TDCSCV2VaultStorageReader.LoadIndices; var SnippetKey: string; // key of each snippet in a category CatIdx: Integer; // loops thru all categories @@ -919,12 +927,13 @@ procedure TIniDataReader.LoadIndices; end; end; -function TIniDataReader.MasterFileName: string; +function TDCSCV2VaultStorageReader.MasterFileName: string; begin Result := DataFile(cMasterFileName); end; -function TIniDataReader.ReadFileLines(const FileName: string): TStringDynArray; +function TDCSCV2VaultStorageReader.ReadFileLines(const FileName: string): + TStringDynArray; var Encoding: TEncoding; begin @@ -941,7 +950,7 @@ function TIniDataReader.ReadFileLines(const FileName: string): TStringDynArray; end; end; -function TIniDataReader.ReadFileText(const FileName: string): string; +function TDCSCV2VaultStorageReader.ReadFileText(const FileName: string): string; begin if not DataFileExists(FileName) then Exit(''); @@ -950,7 +959,7 @@ function TIniDataReader.ReadFileText(const FileName: string): string; ); end; -procedure TIniDataReader.ReadVersionNumber; +procedure TDCSCV2VaultStorageReader.ReadVersionNumber; var VersionStr: string; begin @@ -972,7 +981,8 @@ procedure TIniDataReader.ReadVersionNumber; end; end; -function TIniDataReader.SnippetToCat(const SnippetKey: string): string; +function TDCSCV2VaultStorageReader.SnippetToCat(const SnippetKey: string): + string; var CatIdx: Integer; // index of category in category list for this snippet resourcestring @@ -985,9 +995,10 @@ function TIniDataReader.SnippetToCat(const SnippetKey: string): string; Result := fCatIDs[CatIdx]; end; -{ TIniDataReader.TUTF8IniFileEx } +{ TDCSCV2VaultStorageReader.TUTF8IniFileEx } -constructor TIniDataReader.TUTF8IniFileEx.Create(const AFileName: string); +constructor TDCSCV2VaultStorageReader.TUTF8IniFileEx.Create( + const AFileName: string); resourcestring sFileNotFound = 'File "%s" does not exist.'; begin @@ -999,8 +1010,8 @@ constructor TIniDataReader.TUTF8IniFileEx.Create(const AFileName: string); SetStrings(TFileIO.ReadAllLines(AFileName, TEncoding.UTF8, True)); end; -function TIniDataReader.TUTF8IniFileEx.ReadString(const Section, Ident, - Default: string): string; +function TDCSCV2VaultStorageReader.TUTF8IniFileEx.ReadString(const Section, + Ident, Default: string): string; begin // Read string from ini Result := inherited ReadString(Section, Ident, Default); @@ -1010,7 +1021,7 @@ function TIniDataReader.TUTF8IniFileEx.ReadString(const Section, Ident, Result := Copy(Result, 2, Length(Result) - 2); end; -procedure TIniDataReader.TUTF8IniFileEx.SetStrings( +procedure TDCSCV2VaultStorageReader.TUTF8IniFileEx.SetStrings( const AStrings: TStringDynArray); var SL: TStringList; @@ -1026,9 +1037,9 @@ procedure TIniDataReader.TUTF8IniFileEx.SetStrings( end; end; -{ TIniDataReader.TIniFileCache } +{ TDCSCV2VaultStorageReader.TIniFileCache } -constructor TIniDataReader.TIniFileCache.Create; +constructor TDCSCV2VaultStorageReader.TIniFileCache.Create; begin inherited Create; // fCache owns and frees the ini file objects @@ -1037,13 +1048,13 @@ constructor TIniDataReader.TIniFileCache.Create; ); end; -destructor TIniDataReader.TIniFileCache.Destroy; +destructor TDCSCV2VaultStorageReader.TIniFileCache.Destroy; begin fCache.Free; // frees owned .Values[] objects inherited; end; -function TIniDataReader.TIniFileCache.GetIniFile( +function TDCSCV2VaultStorageReader.TIniFileCache.GetIniFile( const PathToFile: string): TCustomIniFile; begin if not fCache.ContainsKey(PathToFile) then @@ -1051,27 +1062,28 @@ function TIniDataReader.TIniFileCache.GetIniFile( Result := fCache[PathToFile]; end; -{ TIniDataWriter } +{ TDCSCV2VaultStorageWriter } -function TIniDataWriter.ActiveTextToREML(AActiveText: IActiveText): string; +function TDCSCV2VaultStorageWriter.ActiveTextToREML(AActiveText: IActiveText): + string; begin Result := TREMLWriter.Render(AActiveText, False); end; -constructor TIniDataWriter.Create(const AOutDir: string); +constructor TDCSCV2VaultStorageWriter.Create(const AOutDir: string); begin inherited Create; fOutDir := AOutDir; fCache := TUTF8IniFileCache.Create; end; -destructor TIniDataWriter.Destroy; +destructor TDCSCV2VaultStorageWriter.Destroy; begin fCache.Free; // frees owned ini file objects inherited; end; -procedure TIniDataWriter.Finalise; +procedure TDCSCV2VaultStorageWriter.Finalise; var IniInfo: TPair; begin @@ -1083,7 +1095,7 @@ procedure TIniDataWriter.Finalise; end; end; -procedure TIniDataWriter.HandleException(const EObj: TObject); +procedure TDCSCV2VaultStorageWriter.HandleException(const EObj: TObject); begin if (EObj is EFileStreamError) or (EObj is ECodeSnip) or (EObj is EDirectoryNotFoundException) then @@ -1091,7 +1103,7 @@ procedure TIniDataWriter.HandleException(const EObj: TObject); raise EObj; end; -procedure TIniDataWriter.Initialise; +procedure TDCSCV2VaultStorageWriter.Initialise; begin try // Make sure database folder exists @@ -1116,22 +1128,22 @@ procedure TIniDataWriter.Initialise; end; end; -function TIniDataWriter.MakeCatIniName(const ACatID: string): string; +function TDCSCV2VaultStorageWriter.MakeCatIniName(const ACatID: string): string; begin Result := ACatID + '.ini'; end; -function TIniDataWriter.MakeCatIniPath(const ACatID: string): string; +function TDCSCV2VaultStorageWriter.MakeCatIniPath(const ACatID: string): string; begin Result := MakePath(MakeCatIniName(ACatID)); end; -function TIniDataWriter.MakePath(const AFileName: string): string; +function TDCSCV2VaultStorageWriter.MakePath(const AFileName: string): string; begin Result := TPath.Combine(fOutDir, AFileName); end; -procedure TIniDataWriter.WriteCatProps(const CatID: string; +procedure TDCSCV2VaultStorageWriter.WriteCatProps(const CatID: string; const Props: TCategoryData); var Master: TUTF8IniFile; @@ -1142,13 +1154,13 @@ procedure TIniDataWriter.WriteCatProps(const CatID: string; Master.WriteString(CatId, cMasterIniName, MakeCatIniName(CatID)); end; -procedure TIniDataWriter.WriteCatSnippets(const CatID: string; +procedure TDCSCV2VaultStorageWriter.WriteCatSnippets(const CatID: string; const SnipList: IStringList); begin // Do nothing end; -procedure TIniDataWriter.WriteMetaData(const AMetaData: TMetaData); +procedure TDCSCV2VaultStorageWriter.WriteMetaData(const AMetaData: TMetaData); var VersionStr: string; KVPairs: TStringList; @@ -1180,15 +1192,15 @@ procedure TIniDataWriter.WriteMetaData(const AMetaData: TMetaData); WriteTextFile(AcknowledgementsFileName, AMetaData.Acknowledgements); end; -procedure TIniDataWriter.WriteSnippetDepends(const SnippetKey: string; - const Depends: IStringList); +procedure TDCSCV2VaultStorageWriter.WriteSnippetDepends( + const SnippetKey: string; const Depends: IStringList); begin fCurrentCatIni.WriteString( SnippetKey, cDependsName, Depends.GetText(',', False) ); end; -procedure TIniDataWriter.WriteSnippetProps(const SnippetKey: string; +procedure TDCSCV2VaultStorageWriter.WriteSnippetProps(const SnippetKey: string; const Props: TSnippetData); const Kinds: array[TSnippetKind] of string = ( @@ -1229,7 +1241,9 @@ procedure TIniDataWriter.WriteSnippetProps(const SnippetKey: string; Inc(fFileNumber); SourceFileName := IntToStr(fFileNumber) + '.dat'; SourceFilePath := MakePath(SourceFileName); - TFileIO.WriteAllText(SourceFilePath, Props.SourceCode, TEncoding.UTF8, True); + TFileIO.WriteAllText( + SourceFilePath, Props.SourceCode, TEncoding.UTF8, True + ); // snippet kind fCurrentCatIni.WriteString(SnippetKey, cKindName, Kinds[Props.Kind]); @@ -1290,7 +1304,7 @@ procedure TIniDataWriter.WriteSnippetProps(const SnippetKey: string; end; -procedure TIniDataWriter.WriteSnippetUnits(const SnippetKey: string; +procedure TDCSCV2VaultStorageWriter.WriteSnippetUnits(const SnippetKey: string; const Units: IStringList); begin fCurrentCatIni.WriteString( @@ -1298,7 +1312,7 @@ procedure TIniDataWriter.WriteSnippetUnits(const SnippetKey: string; ); end; -procedure TIniDataWriter.WriteSnippetXRefs(const SnippetKey: string; +procedure TDCSCV2VaultStorageWriter.WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); begin fCurrentCatIni.WriteString( @@ -1306,12 +1320,13 @@ procedure TIniDataWriter.WriteSnippetXRefs(const SnippetKey: string; ); end; -procedure TIniDataWriter.WriteTextFile(const AFileName, AText: string); +procedure TDCSCV2VaultStorageWriter.WriteTextFile(const AFileName, + AText: string); begin TFileIO.WriteAllText(MakePath(AFileName), AText, TEncoding.UTF8, True); end; -procedure TIniDataWriter.WriteTextFile(const AFileName: string; +procedure TDCSCV2VaultStorageWriter.WriteTextFile(const AFileName: string; const ALines: IStringList); var Content: string; @@ -1322,9 +1337,9 @@ procedure TIniDataWriter.WriteTextFile(const AFileName: string; WriteTextFile(AFileName, Content); end; -{ TIniDataWriter.TUTF8IniFile } +{ TDCSCV2VaultStorageWriter.TUTF8IniFile } -procedure TIniDataWriter.TUTF8IniFile.Save; +procedure TDCSCV2VaultStorageWriter.TUTF8IniFile.Save; var Data: TStringList; begin @@ -1337,16 +1352,16 @@ procedure TIniDataWriter.TUTF8IniFile.Save; end; end; -{ TIniDataWriter.TUTF8IniFileCache } +{ TDCSCV2VaultStorageWriter.TUTF8IniFileCache } -procedure TIniDataWriter.TUTF8IniFileCache.AddIniFile( +procedure TDCSCV2VaultStorageWriter.TUTF8IniFileCache.AddIniFile( const APathToFile: string); begin if not fCache.ContainsKey(APathToFile) then InternalAddIniFile(APathToFile); end; -constructor TIniDataWriter.TUTF8IniFileCache.Create; +constructor TDCSCV2VaultStorageWriter.TUTF8IniFileCache.Create; begin inherited Create; // fCache owns and frees the ini file objects @@ -1355,19 +1370,19 @@ constructor TIniDataWriter.TUTF8IniFileCache.Create; ); end; -destructor TIniDataWriter.TUTF8IniFileCache.Destroy; +destructor TDCSCV2VaultStorageWriter.TUTF8IniFileCache.Destroy; begin fCache.Free; // frees all owned ini file objects in .Values[] inherited; end; -function TIniDataWriter.TUTF8IniFileCache.GetEnumerator: +function TDCSCV2VaultStorageWriter.TUTF8IniFileCache.GetEnumerator: TObjectDictionary.TPairEnumerator; begin Result := fCache.GetEnumerator; end; -function TIniDataWriter.TUTF8IniFileCache.GetIniFile( +function TDCSCV2VaultStorageWriter.TUTF8IniFileCache.GetIniFile( const APathToFile: string): TUTF8IniFile; begin if not fCache.ContainsKey(APathToFile) then @@ -1376,7 +1391,7 @@ function TIniDataWriter.TUTF8IniFileCache.GetIniFile( Result := fCache[APathToFile]; end; -function TIniDataWriter.TUTF8IniFileCache.InternalAddIniFile( +function TDCSCV2VaultStorageWriter.TUTF8IniFileCache.InternalAddIniFile( const APathToFile: string): TUTF8IniFile; begin Result := TUTF8IniFile.Create(APathToFile, TEncoding.UTF8); diff --git a/Src/DB.IO.Vault.Native.pas b/Src/DB.IO.Vault.Native.pas index e7325ab42..fbd1263f8 100644 --- a/Src/DB.IO.Vault.Native.pas +++ b/Src/DB.IO.Vault.Native.pas @@ -31,8 +31,8 @@ interface type /// Base class for classes that read and write vault data in the - /// native data format. - TNativeDataRW = class abstract(TInterfacedObject) + /// CodeSnip Vault native data format. + TNativeVaultStorage = class abstract(TInterfacedObject) strict private var /// Value of DataDirectory property. @@ -178,10 +178,11 @@ TNativeDataRW = class abstract(TInterfacedObject) end; - /// Class that performs the low level reading of vault data in - /// CodeSnip Vault native format from an XML file and linked data files. - /// - TNativeDataReader = class sealed(TNativeDataRW, IDataReader) + /// Reads a vault's data from storage in the CodeSnip Vault native + /// format. + TNativeVaultStorageReader = class sealed(TNativeVaultStorage, + IVaultStorageReader + ) strict private var /// Flag that indicates if unit & depends-upon lists are @@ -315,10 +316,11 @@ TNativeDataReader = class sealed(TNativeDataRW, IDataReader) function GetMetaData: TMetaData; end; - /// Class that performs the low level writing of vault data in - /// CodeSnip Vault native format to an XML file and linked data files. - /// - TNativeDataWriter = class sealed(TNativeDataRW, IDataWriter) + /// Writes a vault's data to storage in the CodeSnip Vault native + /// format. + TNativeVaultStorageWriter = class sealed(TNativeVaultStorage, + IVaultStorageWriter + ) strict private var /// Reference to root node. @@ -472,7 +474,7 @@ implementation resourcestring // TNativeDataRW error message sMissingNode = 'Document has no %s node.'; - // TNativeDataReader error messages + // TNativeVaultStorageReader error messages sParseError = 'Error parsing XML file'; sBadDataFormat = 'Invalid native vault data format: %s'; sNoRootNode = 'Invalid document: no root element present'; @@ -487,9 +489,9 @@ implementation sBadTestInfo = 'Invalid test information for snippet "%s"'; sMissingLicenseText = 'License text file "%s" is missing'; -{ TNativeDataRW } +{ TNativeVaultStorage } -constructor TNativeDataRW.Create(const ADataDirectory: string); +constructor TNativeVaultStorage.Create(const ADataDirectory: string); begin inherited Create; fDataDirectory := ADataDirectory; @@ -499,12 +501,12 @@ constructor TNativeDataRW.Create(const ADataDirectory: string); fXMLDoc := TXMLDocHelper.CreateXMLDoc; end; -function TNativeDataRW.FilePath(const AFileName: string): string; +function TNativeVaultStorage.FilePath(const AFileName: string): string; begin Result := TPath.Combine(DataDirectory, AFileName); end; -function TNativeDataRW.FindCategoryNode(const ACatID: string): IXMLNode; +function TNativeVaultStorage.FindCategoryNode(const ACatID: string): IXMLNode; var CatListNode: IXMLNode; // node that contains category nodes begin @@ -519,7 +521,8 @@ function TNativeDataRW.FindCategoryNode(const ACatID: string): IXMLNode; ) end; -function TNativeDataRW.FindSnippetNode(const ASnippetKey: string): IXMLNode; +function TNativeVaultStorage.FindSnippetNode(const ASnippetKey: string): + IXMLNode; var SnippetListNode: IXMLNode; // list node that contains snippets nodes begin @@ -534,7 +537,7 @@ function TNativeDataRW.FindSnippetNode(const ASnippetKey: string): IXMLNode; ); end; -function TNativeDataRW.InitXMLDocAndRootNode: IXMLNode; +function TNativeVaultStorage.InitXMLDocAndRootNode: IXMLNode; begin XMLDoc.Active := True; TXMLDocHelper.CreateXMLProcInst(XMLDoc); @@ -547,14 +550,14 @@ function TNativeDataRW.InitXMLDocAndRootNode: IXMLNode; XMLDoc.ChildNodes.Add(Result); end; -function TNativeDataRW.PathToXMLFile: string; +function TNativeVaultStorage.PathToXMLFile: string; begin Result := FilePath(XMLFileName); end; -{ TNativeDataReader } +{ TNativeVaultStorageReader } -constructor TNativeDataReader.Create(const ADirectory: string); +constructor TNativeVaultStorageReader.Create(const ADirectory: string); var RootNode: IXMLNode; // reference to document's root node begin @@ -579,12 +582,12 @@ constructor TNativeDataReader.Create(const ADirectory: string); end; end; -function TNativeDataReader.DatabaseExists: Boolean; +function TNativeVaultStorageReader.DatabaseExists: Boolean; begin Result := TFile.Exists(PathToXMLFile); end; -function TNativeDataReader.GetAllCatIDs: IStringList; +function TNativeVaultStorageReader.GetAllCatIDs: IStringList; var CatListNode: IXMLNode; // node containing list of categories CatNodes: IXMLSimpleNodeList; // list of all category nodes of categories @@ -603,7 +606,7 @@ function TNativeDataReader.GetAllCatIDs: IStringList; end; end; -procedure TNativeDataReader.GetCatProps(const CatID: string; +procedure TNativeVaultStorageReader.GetCatProps(const CatID: string; var Props: TCategoryData); var CatNode: IXMLNode; // reference to node for required category @@ -622,7 +625,8 @@ procedure TNativeDataReader.GetCatProps(const CatID: string; end; end; -function TNativeDataReader.GetCatSnippets(const CatID: string): IStringList; +function TNativeVaultStorageReader.GetCatSnippets(const CatID: string): + IStringList; var CatNode: IXMLNode; // reference to required category node begin @@ -642,8 +646,9 @@ function TNativeDataReader.GetCatSnippets(const CatID: string): IStringList; end; end; -function TNativeDataReader.GetEnclosedListItems(const AParentNode: IXMLNode; - const AListNodeName, AItemNodeName: string): IStringList; +function TNativeVaultStorageReader.GetEnclosedListItems( + const AParentNode: IXMLNode; const AListNodeName, AItemNodeName: string): + IStringList; var ListNode: IXMLNode; ItemNode: IXMLNode; @@ -661,7 +666,7 @@ function TNativeDataReader.GetEnclosedListItems(const AParentNode: IXMLNode; Result.Add(ItemNode.Text); end; -function TNativeDataReader.GetMetaData: TMetaData; +function TNativeVaultStorageReader.GetMetaData: TMetaData; var RootNode: IXMLNode; LicenseNode: IXMLNode; @@ -718,7 +723,7 @@ function TNativeDataReader.GetMetaData: TMetaData; ); end; -function TNativeDataReader.GetSnippetDepends(const SnippetKey: string): +function TNativeVaultStorageReader.GetSnippetDepends(const SnippetKey: string): IStringList; begin if fCanReadRequiredLists then @@ -729,7 +734,7 @@ function TNativeDataReader.GetSnippetDepends(const SnippetKey: string): Result := TIStringList.Create; end; -procedure TNativeDataReader.GetSnippetProps(const SnippetKey: string; +procedure TNativeVaultStorageReader.GetSnippetProps(const SnippetKey: string; var Props: TSnippetData); var SnippetNode: IXMLNode; // node for required snippet @@ -954,7 +959,7 @@ procedure TNativeDataReader.GetSnippetProps(const SnippetKey: string; end; end; -function TNativeDataReader.GetSnippetReferences(const ASnippetKey, +function TNativeVaultStorageReader.GetSnippetReferences(const ASnippetKey, AListNodeName, AListItemName: string): IStringList; var SnippetNode: IXMLNode; @@ -966,7 +971,7 @@ function TNativeDataReader.GetSnippetReferences(const ASnippetKey, Result := GetEnclosedListItems(SnippetNode, AListNodeName, AListItemName); end; -function TNativeDataReader.GetSnippetUnits(const SnippetKey: string): +function TNativeVaultStorageReader.GetSnippetUnits(const SnippetKey: string): IStringList; begin if fCanReadRequiredLists then @@ -977,7 +982,7 @@ function TNativeDataReader.GetSnippetUnits(const SnippetKey: string): Result := TIStringList.Create; end; -function TNativeDataReader.GetSnippetXRefs(const SnippetKey: string): +function TNativeVaultStorageReader.GetSnippetXRefs(const SnippetKey: string): IStringList; begin Result := GetSnippetReferences( @@ -985,7 +990,7 @@ function TNativeDataReader.GetSnippetXRefs(const SnippetKey: string): ) end; -procedure TNativeDataReader.HandleException(const EObj: TObject); +procedure TNativeVaultStorageReader.HandleException(const EObj: TObject); begin {TODO -cVault: Query whether database files should be deleted on error. This is not being done while debugging} @@ -1006,7 +1011,7 @@ procedure TNativeDataReader.HandleException(const EObj: TObject); raise EObj; end; -procedure TNativeDataReader.ValidateDoc; +procedure TNativeVaultStorageReader.ValidateDoc; var RootNode: IXMLNode; Version: TVersionNumber; @@ -1029,9 +1034,9 @@ procedure TNativeDataReader.ValidateDoc; raise EDataIO.CreateFmt(sBadVersion, [Version.V1, Version.V2]); end; -{ TNativeDataWriter } +{ TNativeVaultStorageWriter } -procedure TNativeDataWriter.Finalise; +procedure TNativeVaultStorageWriter.Finalise; var FS: TFileStream; // stream onto output file begin @@ -1052,14 +1057,14 @@ procedure TNativeDataWriter.Finalise; end; end; -procedure TNativeDataWriter.HandleException(const EObj: TObject); +procedure TNativeVaultStorageWriter.HandleException(const EObj: TObject); begin if (EObj is EFileStreamError) or (EObj is ECodeSnip) then raise EDataIO.Create(EObj as Exception); raise EObj; end; -procedure TNativeDataWriter.Initialise; +procedure TNativeVaultStorageWriter.Initialise; //var // RootNode: IXMLNode; // document root node begin @@ -1078,7 +1083,7 @@ procedure TNativeDataWriter.Initialise; end; end; -procedure TNativeDataWriter.WriteCatProps(const CatID: string; +procedure TNativeVaultStorageWriter.WriteCatProps(const CatID: string; const Props: TCategoryData); var CatNode: IXMLNode; // referenced to required category node @@ -1093,7 +1098,7 @@ procedure TNativeDataWriter.WriteCatProps(const CatID: string; end; end; -procedure TNativeDataWriter.WriteCatSnippets(const CatID: string; +procedure TNativeVaultStorageWriter.WriteCatSnippets(const CatID: string; const SnipList: IStringList); var CatNode: IXMLNode; // reference to required category node @@ -1118,7 +1123,7 @@ procedure TNativeDataWriter.WriteCatSnippets(const CatID: string; end; end; -procedure TNativeDataWriter.WriteEnclosedList(const AParent: IXMLNode; +procedure TNativeVaultStorageWriter.WriteEnclosedList(const AParent: IXMLNode; const AListNodeName, AItemNodeName: string; const AItems: IStringList); var ListNode: IXMLNode; // reference to enclosing list node @@ -1129,7 +1134,7 @@ procedure TNativeDataWriter.WriteEnclosedList(const AParent: IXMLNode; XMLDoc.CreateElement(ListNode, AItemNodeName, Item); end; -procedure TNativeDataWriter.WriteMetaData(const AMetaData: TMetaData); +procedure TNativeVaultStorageWriter.WriteMetaData(const AMetaData: TMetaData); var LicenseNode: IXMLNode; CopyrightNode: IXMLNode; @@ -1178,7 +1183,7 @@ procedure TNativeDataWriter.WriteMetaData(const AMetaData: TMetaData); end; -procedure TNativeDataWriter.WriteReferenceList(const ASnippetKey, +procedure TNativeVaultStorageWriter.WriteReferenceList(const ASnippetKey, AListNodeName, AItemNodeName: string; const AItems: IStringList); var SnippetNode: IXMLNode; // reference to snippet's node @@ -1198,8 +1203,8 @@ procedure TNativeDataWriter.WriteReferenceList(const ASnippetKey, end; end; -procedure TNativeDataWriter.WriteSnippetDepends(const SnippetKey: string; - const Depends: IStringList); +procedure TNativeVaultStorageWriter.WriteSnippetDepends( + const SnippetKey: string; const Depends: IStringList); begin if not fCanWriteRequiredLists then Exit; @@ -1211,7 +1216,7 @@ procedure TNativeDataWriter.WriteSnippetDepends(const SnippetKey: string; ); end; -procedure TNativeDataWriter.WriteSnippetProps(const SnippetKey: string; +procedure TNativeVaultStorageWriter.WriteSnippetProps(const SnippetKey: string; const Props: TSnippetData); var SnippetNode: IXMLNode; // snippet's node @@ -1309,7 +1314,7 @@ procedure TNativeDataWriter.WriteSnippetProps(const SnippetKey: string; end; end; -procedure TNativeDataWriter.WriteSnippetUnits(const SnippetKey: string; +procedure TNativeVaultStorageWriter.WriteSnippetUnits(const SnippetKey: string; const Units: IStringList); begin if not fCanWriteRequiredLists then @@ -1322,7 +1327,7 @@ procedure TNativeDataWriter.WriteSnippetUnits(const SnippetKey: string; ); end; -procedure TNativeDataWriter.WriteSnippetXRefs(const SnippetKey: string; +procedure TNativeVaultStorageWriter.WriteSnippetXRefs(const SnippetKey: string; const XRefs: IStringList); begin WriteReferenceList( diff --git a/Src/DB.IO.Vault.Null.pas b/Src/DB.IO.Vault.Null.pas index ee166df74..c650f16a3 100644 --- a/Src/DB.IO.Vault.Null.pas +++ b/Src/DB.IO.Vault.Null.pas @@ -26,12 +26,10 @@ interface type - { - TNulDataReader: - A do nothing data reader used when a database does not exist. - } - TNulDataReader = class(TInterfacedObject, - IDataReader + /// A do nothing vault data reader used when no vaults exist. + /// + TNullVaultStorageReader = class(TInterfacedObject, + IVaultStorageReader ) public { IDataReader methods } @@ -87,9 +85,9 @@ TNulDataReader = class(TInterfacedObject, implementation -{ TNulDataReader } +{ TNullVaultStorageReader } -function TNulDataReader.DatabaseExists: Boolean; +function TNullVaultStorageReader.DatabaseExists: Boolean; {Checks if the database exists. This method is always called first. No other methods are called if this method returns false. @return Always returns True. It always can read a do-nothing database. @@ -98,7 +96,7 @@ function TNulDataReader.DatabaseExists: Boolean; Result := True; end; -function TNulDataReader.GetAllCatIDs: IStringList; +function TNullVaultStorageReader.GetAllCatIDs: IStringList; {Gets ids of all categories in database. @return Empty string list. } @@ -106,7 +104,7 @@ function TNulDataReader.GetAllCatIDs: IStringList; Result := TIStringList.Create; end; -procedure TNulDataReader.GetCatProps(const CatID: string; +procedure TNullVaultStorageReader.GetCatProps(const CatID: string; var Props: TCategoryData); {Gets properties of a category. @param CatID [in] Id of required category. @@ -116,7 +114,8 @@ procedure TNulDataReader.GetCatProps(const CatID: string; // Do nothing end; -function TNulDataReader.GetCatSnippets(const CatID: string): IStringList; +function TNullVaultStorageReader.GetCatSnippets(const CatID: string): + IStringList; {Gets keys of all snippets in a category. @param CatID [in] Id of category containing snippets. @return Empty snippey key list. @@ -125,12 +124,12 @@ function TNulDataReader.GetCatSnippets(const CatID: string): IStringList; Result := TIStringList.Create; end; -function TNulDataReader.GetMetaData: TMetaData; +function TNullVaultStorageReader.GetMetaData: TMetaData; begin Result := TMetaData.CreateNull; end; -function TNulDataReader.GetSnippetDepends(const SnippetKey: string): +function TNullVaultStorageReader.GetSnippetDepends(const SnippetKey: string): IStringList; {Gets list of all snippets on which a given snippet depends. @param SnippetKey [in] Key of required snippet. @@ -140,7 +139,7 @@ function TNulDataReader.GetSnippetDepends(const SnippetKey: string): Result := TIStringList.Create; end; -procedure TNulDataReader.GetSnippetProps(const SnippetKey: string; +procedure TNullVaultStorageReader.GetSnippetProps(const SnippetKey: string; var Props: TSnippetData); {Gets properties of a snippet. These are the fields of the snippet's record in the snippets "table". @@ -151,7 +150,8 @@ procedure TNulDataReader.GetSnippetProps(const SnippetKey: string; // Do nothing end; -function TNulDataReader.GetSnippetUnits(const SnippetKey: string): IStringList; +function TNullVaultStorageReader.GetSnippetUnits(const SnippetKey: string): + IStringList; {Gets list of all units referenced by a snippet. @param SnippetKey [in] Key of required snippet. @return Empty unit name list. @@ -160,7 +160,8 @@ function TNulDataReader.GetSnippetUnits(const SnippetKey: string): IStringList; Result := TIStringList.Create; end; -function TNulDataReader.GetSnippetXRefs(const SnippetKey: string): IStringList; +function TNullVaultStorageReader.GetSnippetXRefs(const SnippetKey: string): + IStringList; {Gets list of all snippets that are cross referenced by a snippet. @param SnippetKey [in] Key of snippet we need cross references for. @return Empty snippet key list. diff --git a/Src/DB.IO.Vault.pas b/Src/DB.IO.Vault.pas index 85ed52a53..3a445b79f 100644 --- a/Src/DB.IO.Vault.pas +++ b/Src/DB.IO.Vault.pas @@ -27,14 +27,9 @@ interface type - { - IDataReader: - Interface that defines operations that must be implemented by objects that - read the CodeSnip and/or user database. - NOTE: Any object that is to be used to read a database must implement this - interface. - } - IDataReader = interface(IInterface) + /// Interface that defines operations that must be implemented by + /// objects that read vault data from storage. + IVaultStorageReader = interface(IInterface) ['{72A8EAD4-05CE-41BF-AE0F-33495757BBFC}'] function DatabaseExists: Boolean; {Check if the database exists. This method is always called first. No @@ -56,7 +51,8 @@ interface @param CatID [in] Id of category containing snippets. @return List of snippet IDs. } - procedure GetSnippetProps(const SnippetKey: string; var Props: TSnippetData); + procedure GetSnippetProps(const SnippetKey: string; + var Props: TSnippetData); {Get properties of a snippet. These are the fields of the snippet's record in the snippets "table". @param SnippetKey [in] Snippet's key. @@ -85,14 +81,9 @@ interface function GetMetaData: TMetaData; end; - { - IDataWriter: - Interface that defines operations that must be implemented by objects that - write user database. - NOTE: Any object that is to be used to write the user database must - implement this interface. - } - IDataWriter = interface(IInterface) + /// Interface that defines operations that must be implemented by + /// objects that write vault data to storage. + IVaultStorageWriter = interface(IInterface) ['{71E892C4-6E0F-480A-9DF4-70835F83A0CA}'] procedure Initialise; {Initialise the database. Always called before any other methods. diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index d702d3914..a3b8b9dda 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -164,7 +164,7 @@ TDatabaseLoaderClass = class of TDatabaseLoader; } TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) strict private - fReader: IDataReader; // Object used to read data from storage + fReader: IVaultStorageReader; // Object used to read data from storage fSnipList: TSnippetList; // Receives list of snippets fCategories: TCategoryList; // Receives list of categories fFactory: IDBDataItemFactory; // Object creates new categories and snippets @@ -184,7 +184,7 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) @except Exception always raised. } strict protected - function CreateReader: IDataReader; virtual; abstract; + function CreateReader: IVaultStorageReader; virtual; abstract; {Creates reader object for the database. If database doesn't exist a nul reader must be created. @return Reader object instance. @@ -242,7 +242,7 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) } TDCSCV2FormatLoader = class(TDatabaseLoader, IDataFormatLoader) strict protected - function CreateReader: IDataReader; override; + function CreateReader: IVaultStorageReader; override; {Creates reader object. If main database doesn't exist a nul reader is created. @return Reader object instance. @@ -259,7 +259,7 @@ TDCSCV2FormatLoader = class(TDatabaseLoader, IDataFormatLoader) } TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) strict protected - function CreateReader: IDataReader; override; + function CreateReader: IVaultStorageReader; override; {Creates reader object. If user database doesn't exist a nul reader is created. @return Reader object instance. @@ -272,7 +272,7 @@ TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) TNativeVaultFormatLoader = class(TDatabaseLoader, IDataFormatLoader) strict protected - function CreateReader: IDataReader; override; + function CreateReader: IVaultStorageReader; override; {Creates reader object. If user database doesn't exist a nul reader is created. @return Reader object instance. @@ -296,7 +296,7 @@ TFormatSaver = class abstract (TInterfacedObject, ) strict private var - fWriter: IDataWriter; // Object used to write to storage + fWriter: IVaultStorageWriter; // Object used to write to storage fSnipList: TSnippetList; // List of snippets to be written fCategories: TCategoryList; // List of categories to be written fProvider: IDBDataProvider; // Object used to get data to be written @@ -329,8 +329,8 @@ TFormatSaver = class abstract (TInterfacedObject, /// Creates an object that can write data to storage in the /// required format. - /// IDataWriter. Required writer object. - function CreateWriter: IDataWriter; virtual; abstract; + /// IVaultStorageWriter. Required writer object. + function CreateWriter: IVaultStorageWriter; virtual; abstract; /// Vault being saved. property Vault: TVault read fVault; @@ -371,8 +371,8 @@ TDCSCV2FormatSaver = class(TFormatSaver, /// Creates an object that can write data to storage in /// DelphiDabbler Code Snippets v2 data format. - /// IDataWriter. Required writer object. - function CreateWriter: IDataWriter; override; + /// IVaultStorageWriter. Required writer object. + function CreateWriter: IVaultStorageWriter; override; public @@ -401,8 +401,8 @@ TNativeV4FormatSaver = class(TFormatSaver, /// Creates an object that can write data to storage in /// CodeSnip's native v4 data format. - /// IDataWriter. Required writer object. - function CreateWriter: IDataWriter; override; + /// IVaultStorageWriter. Required writer object. + function CreateWriter: IVaultStorageWriter; override; public @@ -426,8 +426,8 @@ TNativeVaultFormatSaver = class(TFormatSaver, /// Creates an object that can write data to storage in /// CodeSnip's native v4 data format. - /// IDataWriter. Required writer object. - function CreateWriter: IDataWriter; override; + /// IVaultStorageWriter. Required writer object. + function CreateWriter: IVaultStorageWriter; override; public @@ -629,7 +629,6 @@ procedure TDatabaseLoader.LoadReferences(const Snippet: TSnippet); @param Snippet [in] Snippet for which references are required. } - // --------------------------------------------------------------------------- procedure LoadSnippetReferences(const RefList: TSnippetList; const RefKeys: IStringList); {Creates a snippet list from keys of snippets in a string list. If no @@ -649,7 +648,6 @@ procedure TDatabaseLoader.LoadReferences(const Snippet: TSnippet); RefList.Add(Reference); end; end; - // --------------------------------------------------------------------------- begin LoadSnippetReferences( @@ -695,15 +693,15 @@ procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); { TDCSCV2FormatLoader } -function TDCSCV2FormatLoader.CreateReader: IDataReader; +function TDCSCV2FormatLoader.CreateReader: IVaultStorageReader; {Creates reader object. If main database doesn't exist a nul reader is created. @return Reader object instance. } begin - Result := TIniDataReader.Create(Vault.Storage.Directory); + Result := TDCSCV2VaultStorageReader.Create(Vault.Storage.Directory); if not Result.DatabaseExists then - Result := TNulDataReader.Create; + Result := TNullVaultStorageReader.Create; end; function TDCSCV2FormatLoader.ErrorMessageHeading: string; @@ -718,15 +716,15 @@ function TDCSCV2FormatLoader.ErrorMessageHeading: string; { TNativeV4FormatLoader } -function TNativeV4FormatLoader.CreateReader: IDataReader; +function TNativeV4FormatLoader.CreateReader: IVaultStorageReader; {Creates reader object. If user database doesn't exist a nul reader is created. @return Reader object instance. } begin - Result := TXMLDataReader.Create(Vault.Storage.Directory); + Result := TCS4VaultStorageReader.Create(Vault.Storage.Directory); if not Result.DatabaseExists then - Result := TNulDataReader.Create; + Result := TNullVaultStorageReader.Create; end; function TNativeV4FormatLoader.ErrorMessageHeading: string; @@ -741,11 +739,11 @@ function TNativeV4FormatLoader.ErrorMessageHeading: string; { TNativeVaultFormatLoader } -function TNativeVaultFormatLoader.CreateReader: IDataReader; +function TNativeVaultFormatLoader.CreateReader: IVaultStorageReader; begin - Result := TNativeDataReader.Create(Vault.Storage.Directory); + Result := TNativeVaultStorageReader.Create(Vault.Storage.Directory); if not Result.DatabaseExists then - Result := TNulDataReader.Create; + Result := TNullVaultStorageReader.Create; end; function TNativeVaultFormatLoader.ErrorMessageHeading: string; @@ -862,9 +860,9 @@ constructor TDCSCV2FormatSaver.Create(const AVault: TVault); until not TFile.Exists(fBakFile); end; -function TDCSCV2FormatSaver.CreateWriter: IDataWriter; +function TDCSCV2FormatSaver.CreateWriter: IVaultStorageWriter; begin - Result := TIniDataWriter.Create(Vault.Storage.Directory); + Result := TDCSCV2VaultStorageWriter.Create(Vault.Storage.Directory); end; procedure TDCSCV2FormatSaver.Restore; @@ -897,9 +895,9 @@ procedure TDCSCV2FormatSaver.Save(const SnipList: TSnippetList; { TNativeV4FormatSaver } -function TNativeV4FormatSaver.CreateWriter: IDataWriter; +function TNativeV4FormatSaver.CreateWriter: IVaultStorageWriter; begin - Result := TXMLDataWriter.Create(Vault.Storage.Directory); + Result := TCS4VaultStorageWriter.Create(Vault.Storage.Directory); end; procedure TNativeV4FormatSaver.Save(const SnipList: TSnippetList; @@ -911,9 +909,9 @@ procedure TNativeV4FormatSaver.Save(const SnipList: TSnippetList; { TNativeVaultFormatSaver } -function TNativeVaultFormatSaver.CreateWriter: IDataWriter; +function TNativeVaultFormatSaver.CreateWriter: IVaultStorageWriter; begin - Result := TNativeDataWriter.Create(Vault.Storage.Directory); + Result := TNativeVaultStorageWriter.Create(Vault.Storage.Directory); end; procedure TNativeVaultFormatSaver.Save(const SnipList: TSnippetList; @@ -927,13 +925,13 @@ procedure TNativeVaultFormatSaver.Save(const SnipList: TSnippetList; procedure TGlobalCategoryLoader.Load(const Categories: TCategoryList; const DBDataItemFactory: IDBDataItemFactory); var - Reader: TCategoryReader; - CatInfo: TCategoryReader.TCategoryIDAndData; + Reader: TCategoryStorageReader; + CatInfo: TCategoryStorageReader.TCategoryIDAndData; Cat: TCategory; begin if not TFile.Exists(TAppInfo.UserCategoriesFileName) then Exit; - Reader := TCategoryReader.Create(TAppInfo.UserCategoriesFileName); + Reader := TCategoryStorageReader.Create(TAppInfo.UserCategoriesFileName); try for CatInfo in Reader.Read do begin @@ -959,9 +957,9 @@ procedure TGlobalCategoryLoader.Load(const Categories: TCategoryList; procedure TGlobalCategorySaver.Save(const Categories: TCategoryList); var - Writer: TCategoryWriter; + Writer: TCategoryStorageWriter; begin - Writer := TCategoryWriter.Create(TAppInfo.UserCategoriesFileName); + Writer := TCategoryStorageWriter.Create(TAppInfo.UserCategoriesFileName); try Writer.Write(Categories); finally diff --git a/Src/FmCodeExportDlg.pas b/Src/FmCodeExportDlg.pas index 36bc924f8..085c561eb 100644 --- a/Src/FmCodeExportDlg.pas +++ b/Src/FmCodeExportDlg.pas @@ -243,7 +243,7 @@ procedure TCodeExportDlg.WriteOutputFile; var OutData: TEncodedData; // receives export file content begin - OutData := TCodeExporter.ExportSnippets(frmSnippets.SelectedSnippets); + OutData := TCS4SnippetExporter.ExportSnippets(frmSnippets.SelectedSnippets); TFileIO.WriteAllBytes(StrTrim(edFile.Text), OutData.Data); end; diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index 55fd332d3..a41552a49 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -193,11 +193,11 @@ procedure TCodeImportMgr.Import(const FileName: string); fImportInfoList.Clear; try Data := TFileIO.ReadAllBytes(FileName); - TCodeImporter.ImportData(fSnippetInfoList, Data); + TCS4SnippetImporter.ImportData(fSnippetInfoList, Data); except on E: EStreamError do raise ECodeImportMgr.Create(E); - on E: ECodeImporter do + on E: ECS4SnippetImporter do raise ECodeImportMgr.Create(E); end; InitImportInfoList; From 8a26915aef8281142435fd599678dd5d775999e4 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 6 Mar 2025 17:17:33 +0000 Subject: [PATCH 211/222] Refactor UXMLDocHelper & UXMLDocConsts TXMLDocHelper in UXMLDocHelper contained some code that provided support for working with any XML document while other code was specified to CodeSnip 4 XML formats. The CS4 specific code was moved into a new DB.IO.Common.CS4 unit in as class TCS4FormatHelper that descends from TXMLDocHelper. Similarly, UXMLDocConsts contained some constants that apply to all XML docuements while some was shared between CS4 Vault & Import/Export file formats and yet others were specific to one CS4 file format. Shared constants were moved into TCS4FormatHelper. CS4 vault specific constants were moved into a new, private, TCS4VaultFormatHelper class that descends from TCS4FormatHelper. CS4 import / export specific constants were likewise moved in the new TCS4ImportExportDocHelper that also descends from TCS4FormatHelper. UXMLDocConsts was then redundant and was removed. a class that descends from TXMLDocHelper --- Src/CodeSnip.dpr | 4 +- Src/CodeSnip.dproj | 2 +- Src/DB.IO.Common.CS4.pas | 430 +++++++++++++++++++++++++++++++++ Src/DB.IO.ImportExport.CS4.pas | 194 ++++++++++----- Src/DB.IO.Vault.CS4.pas | 278 ++++++++++++++------- Src/UXMLDocConsts.pas | 79 ------ Src/UXMLDocHelper.pas | 415 ++----------------------------- 7 files changed, 779 insertions(+), 623 deletions(-) create mode 100644 Src/DB.IO.Common.CS4.pas delete mode 100644 Src/UXMLDocConsts.pas diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index a8148b507..2600e25ac 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -362,7 +362,6 @@ uses UWBExternal in 'UWBExternal.pas', UWBPopupMenus in 'UWBPopupMenus.pas', UWindowSettings in 'UWindowSettings.pas', - UXMLDocConsts in 'UXMLDocConsts.pas', UXMLDocHelper in 'UXMLDocHelper.pas', UXMLDocumentEx in 'UXMLDocumentEx.pas', UI.Forms.DeleteVaultDlg in 'UI.Forms.DeleteVaultDlg.pas' {DeleteVaultDlg}, @@ -378,7 +377,8 @@ uses UI.Forms.BackupVaultDlg in 'UI.Forms.BackupVaultDlg.pas' {VaultBackupDlg}, DB.DataFormats in 'DB.DataFormats.pas', DB.IO.Vault.Native in 'DB.IO.Vault.Native.pas', - DB.MetaData in 'DB.MetaData.pas'; + DB.MetaData in 'DB.MetaData.pas', + DB.IO.Common.CS4 in 'DB.IO.Common.CS4.pas'; // Include resources {$Resource ExternalObj.tlb} // Type library file diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 532176c87..4b0d4b04b 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -564,7 +564,6 @@ - @@ -587,6 +586,7 @@ + Base diff --git a/Src/DB.IO.Common.CS4.pas b/Src/DB.IO.Common.CS4.pas new file mode 100644 index 000000000..2c028752f --- /dev/null +++ b/Src/DB.IO.Common.CS4.pas @@ -0,0 +1,430 @@ +{ + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/ + * + * Copyright (C) 2025, Peter Johnson (gravatar.com/delphidabbler). + * + * Implements a static class that helps with input and output that is common to + * more than one supported CodeSnip v4 XML data format. +} + + +unit DB.IO.Common.CS4; + +interface + +uses + // Delphi + XMLIntf, + // Project + Compilers.UGlobals, + DB.USnippetKind, + UIStringList, + UStructs, + UXMLDocHelper, + UXMLDocumentEx; + +type + /// Static class that helps with input and output that is common to + /// more than one supported CodeSnip v4 XML data format. + TCS4FormatHelper = class(TXMLDocHelper) + strict private + const + RootWatermarkAttr = 'watermark'; + SnippetKindNodeName = 'kind'; + CompilerResultsNodeName = 'compiler-results'; + CompilerResultNodeName = 'compiler-result'; + CompilerResultIdAttr = 'id'; + StandardFormatNodeName = 'standard-format'; + CompilerIDValues: array[TCompilerID] of string = ( + 'd2', 'd3', 'd4', 'd5', 'd6', 'd7', + 'd2005', 'd2006', 'd2007', 'd2009', 'd2010', + 'dXE', 'dXE2', 'dXE3', 'dDX4' {error, but in use so can't fix}, + 'dXE5', 'dXE6', 'dXE7', 'dXE8', + 'd10s', 'd101b', 'd102t', 'd103r', 'd104s', 'd11a', 'd12y', + 'fpc' + ); + SnippetKindValues: array[TSnippetKind] of string = ( + 'freeform', 'routine', 'const', 'type', 'unit', 'class' + ); + public + const + RootVersionAttr = 'version'; + HighlightSourceNodeName = 'highlight-source'; + ExtraNodeName = 'extra'; + {TODO -cRefactor: Remove support for old file formats that used + credits, credits URL & comments nodes} + CommentsNodeName = 'comments'; + CreditsNodeName = 'credits'; + CreditsUrlNodeName = 'credits-url'; + DependsNodeName = 'depends'; + UnitsNodeName = 'units'; + DescriptionNodeName = 'description'; + SnippetNodeName = 'routine'; + SnippetNodeNameAttr = 'name'; + SnippetsNodeName = 'routines'; + DisplayNameNodeName = 'display-name'; + PascalNameNodeName = 'pascal-name'; + public + /// Creates an XML document root node. + /// IXMLDocumentEx [in] Document in which to + /// insert root node. + /// string [in] Name of root node. + /// string [in] Value of root node's + /// watermark attribute. + /// Integer [in] Value of root node's version + /// attribute. + /// IXMLNode. Reference to new root node. + class function CreateRootNode(const AXMLDoc: IXMLDocumentEx; + const ANodeName, AWatermark: string; const AVersion: Integer): IXMLNode; + + /// Validates the root node of an XML document. + /// IXMLDocumentEx [in] XML document to be + /// validated. + /// string> [in] Name of root mode. + /// string [in] Required value of root + /// node's watermark attribute. + /// TRange [in] Range of acceptable file + /// version numbers. + /// Integer. Document version. + /// ECodeSnipXML is raised if validation fails. + /// + class function ValidateRootNode(const AXMLDoc: IXMLDocumentEx; + const ANodeName, AWatermark: string; const AVersions: TRange): Integer; + + /// Creates a comment at the top level of an XML document. + /// + /// IXMLDocumentEx [in] XML document in which + /// comment is inserted. + /// string [in] Comment to be inserted. + /// + class procedure CreateComment(const AXMLDoc: IXMLDocumentEx; + const AComment: string); + + {TODO -cVault: query whether GetStandardFormat is needed if support dropped + for early CS4 XML formats.} + /// Gets value of a <standard-format> node of a snippet in + /// an XML document. + /// IXMLDocumentEx [in] XML document + /// containing snippet. + /// IXMLNode [in] Snippet node that + /// contains the <standard-format> tag. + /// Boolean [in] Value to use if node doesn't + /// exist or has a non-standard value. + /// Boolean. Value of node, or default value. + class function GetStandardFormat(const AXMLDoc: IXMLDocumentEx; + const ASnippetNode: IXMLNode; const ADefault: Boolean): Boolean; + + /// Sets value of a <highlight-source> node of a snippet in + /// an XML document. + /// IXMLDocumentEx [in] XML document + /// containing snippet. + /// IXMLNode [in] Snippet node that + /// contains the <highlight-source> tag. + /// Boolean [in] Value to use if node doesn't + /// exist or has a non-standard value. + /// Boolean. Value of node, or default value. + class function GetHiliteSource(const AXMLDoc: IXMLDocumentEx; + const ASnippetNode: IXMLNode; const ADefault: Boolean): Boolean; + + /// Gets value of <kind> node of a snippet in an XML + /// document. + /// IXMLDocumentEx [in] XML document + /// containing snippet. + /// IXMLNode [in] Snippet node that + /// contains the <kind> tag. + /// TSnippetKind [in] Value to use if node + /// doesn't exist or has a non-standard value. + /// TSnippetKind. Required snippet kind. + class function GetSnippetKind(const AXMLDoc: IXMLDocumentEx; + const ASnippetNode: IXMLNode; const ADefault: TSnippetKind): TSnippetKind; + + /// Writes a <kind> node to a an XML document. + /// IXMLDocumentEx [in] XML document that will + /// be updated. + /// IXMLNode [in] Snippet node that will + /// contain the <kind> tag. + /// TSnippetKind [in] Value of the <kind> + /// node. + class procedure WriteSnippetKind(const AXMLDoc: IXMLDocumentEx; + const ASnippetNode: IXMLNode; const AValue: TSnippetKind); + + /// Gets compile results for a snippet in an XML document. + /// + /// IXMLDocumentEx [in] XML document + /// containing snippet. + /// IXMLNode [in] Snippet node that + /// contains compile results. + /// TCompileResults. Array of compile results. Includes + /// default results for missing compilers. + class function GetCompilerResults(const AXMLDoc: IXMLDocumentEx; + const ASnippetNode: IXMLNode): TCompileResults; + + /// Writes compile results for a snippet to an XML document. + /// + /// IXMLDocumentEx [in] XML document that will + /// be updated. + /// IXMLNode [in] Snippet node that will + /// contain the compile results. + /// TCompileResults [in] Array of compile + /// results. + class procedure WriteCompilerResults(const AXMLDoc: IXMLDocumentEx; + const ASnippetNode: IXMLNode; const ACompRes: TCompileResults); + + /// Gets a list of names from <pascal-name> elements in an + /// XML document. + /// IXMLDocumentEx [in] XML document + /// containing the name list. + /// IXMLNode [in] XML node that contains all + /// the list nodes. + /// IStringList [in] Receives text of all + /// the <pascal-name> elements in the list. + class procedure GetPascalNameList(const AXMLDoc: IXMLDocumentEx; + const AListNode: IXMLNode; const ANameList: IStringList); + + /// Writes a Pascal name list to an XML document. + /// IXMLDocumentEx [in] XML document into + /// which the list is written. + /// IXMLNode [in] Parent node that is to + /// contain the list. + /// string [in] Name of new list node that + /// is to be the parent of the list. + /// IStringList [in] List of Pascal names + /// to be written. + class procedure WritePascalNameList(const AXMLDoc: IXMLDocumentEx; + const AParent: IXMLNode; const AListName: string; + const ANameList: IStringList); + end; + +implementation + +uses + // Project + UStrUtils; + +{ TCS4FormatHelper } + +class procedure TCS4FormatHelper.CreateComment(const AXMLDoc: IXMLDocumentEx; + const AComment: string); +begin + AXMLDoc.ChildNodes.Add(AXMLDoc.CreateNode(' ' + AComment + ' ', ntComment)); +end; + +class function TCS4FormatHelper.CreateRootNode(const AXMLDoc: IXMLDocumentEx; + const ANodeName, AWatermark: string; const AVersion: Integer): IXMLNode; +begin + Result := AXMLDoc.CreateNode(ANodeName); + Result.SetAttribute(RootWatermarkAttr, AWatermark); + Result.SetAttribute(RootVersionAttr, AVersion); + AXMLDoc.ChildNodes.Add(Result); +end; + +class function TCS4FormatHelper.GetCompilerResults( + const AXMLDoc: IXMLDocumentEx; const ASnippetNode: IXMLNode): TCompileResults; + + // Converts an identifier string to a compiler ID. Returns True if AIDStr is + // valid, False if not. + function IDStrToCompID(AIDStr: string; out AMatch: TCompilerID): Boolean; + var + CompID: TCompilerID; // loops thru all compiler IDs + begin + {TODO -cVault: drop support for detecting CodeSnip v3 entries} + // 'dXE4' can be encountered when reading files written by CodeSnip 3, which + // uses correct 'dXE4' symbol for Delphi XE4 instead of 'dDX4' used + // (erroneously) by CodeSnip 4. So the following two lines convert the + // CodeSnip 3 value to the CodeSnip 4 value before testing. + if AIDStr = 'dXE4' then + AIDStr := CompilerIDValues[ciDXE4]; + Result := False; + for CompID := Low(TCompilerID) to High(TCompilerID) do + begin + if CompilerIDValues[CompID] = AIDStr then + begin + Result := True; + AMatch := CompID; + Break; + end; + end; + end; + +var + ListNode: IXMLNode; // node that enclose compiler result nodes + ResultsNodes: IXMLSimpleNodeList; // list of compiler-result nodes + ResultNode: IXMLNode; // a compiler-result node + CompID: TCompilerID; // loops thru compiler IDs + CompResultStr: string; // compiler id string from result node +begin + // Initialise all results to unknown (query) + for CompID := Low(TCompilerID) to High(TCompilerID) do + Result[CompID] := crQuery; + + // Find enclosing node: valid if this is not present + ListNode := AXMLDoc.FindFirstChildNode(ASnippetNode, CompilerResultsNodeName); + if not Assigned(ListNode) then + Exit; + + // Get list of compiler result nodes contained in list and process each one + ResultsNodes := AXMLDoc.FindChildNodes(ListNode, CompilerResultNodeName); + for ResultNode in ResultsNodes do + begin + if ResultNode.IsTextElement then + begin + // get compile result identifier + CompResultStr := ResultNode.Text; + if CompResultStr = '' then + CompResultStr := '?'; + // add specified result to returned array + if IDStrToCompID( + ResultNode.Attributes[CompilerResultIdAttr], CompID + ) then + begin + {TODO -cRefactor: Use a lookup table instead of case statement} + case CompResultStr[1] of + 'Y': Result[CompID] := crSuccess; + 'N': Result[CompID] := crError; + 'W': Result[CompiD] := crWarning; + else Result[CompID] := crQuery; + end; + end; + end; + end; +end; + +class function TCS4FormatHelper.GetHiliteSource(const AXMLDoc: IXMLDocumentEx; + const ASnippetNode: IXMLNode; const ADefault: Boolean): Boolean; +var + ValueText: string; +begin + ValueText := GetSubTagText(AXMLDoc, ASnippetNode, HighlightSourceNodeName); + if ValueText <> '' then + Result := ValueText <> '0' + else + Result := ADefault; +end; + +class procedure TCS4FormatHelper.GetPascalNameList(const AXMLDoc: IXMLDocumentEx; + const AListNode: IXMLNode; const ANameList: IStringList); +var + NameNode: IXMLNode; + NodeList: IXMLSimpleNodeList; +begin + ANameList.Clear; + if not Assigned(AListNode) then + Exit; // this is permitted since Pascal name lists may be empty or missing + NodeList := AXMLDoc.FindChildNodes(AListNode, PascalNameNodeName); + for NameNode in NodeList do + if NameNode.IsTextElement then + ANameList.Add(NameNode.Text); +end; + +class function TCS4FormatHelper.GetSnippetKind(const AXMLDoc: IXMLDocumentEx; + const ASnippetNode: IXMLNode; const ADefault: TSnippetKind): TSnippetKind; +var + ValueText: string; +begin + {TODO -cRefactor: Use a lookup table instead of if ... else if .. else tests} + ValueText := GetSubTagText(AXMLDoc, ASnippetNode, SnippetKindNodeName); + if StrSameText(ValueText, SnippetKindValues[skFreeform]) then + Result := skFreeform + else if StrSameText(ValueText, SnippetKindValues[skRoutine]) then + Result := skRoutine + else if StrSameText(ValueText, SnippetKindValues[skConstant]) then + Result := skConstant + else if StrSameText(ValueText, SnippetKindValues[skTypeDef]) then + Result := skTypeDef + else if StrSameText(ValueText, SnippetKindValues[skUnit]) then + Result := skUnit + else if StrSameText(ValueText, SnippetKindValues[skClass]) then + Result := skClass + else + Result := ADefault; +end; + +class function TCS4FormatHelper.GetStandardFormat(const AXMLDoc: IXMLDocumentEx; + const ASnippetNode: IXMLNode; const ADefault: Boolean): Boolean; +var + ValueText: string; +begin + ValueText := GetSubTagText(AXMLDoc, ASnippetNode, StandardFormatNodeName); + if ValueText <> '' then + Result := ValueText <> '0' + else + Result := ADefault; +end; + +class function TCS4FormatHelper.ValidateRootNode(const AXMLDoc: IXMLDocumentEx; + const ANodeName, AWatermark: string; const AVersions: TRange): Integer; +var + RootNode: IXMLNode; // document root node +resourcestring + // Error messages + sNoRootNode = 'Invalid document: no root element present'; + sBadRootName = 'Invalid document: root element must be named <%s>'; + sBadWatermark = 'Invalid document: watermark is incorrect'; + sBadVersion = 'Invalid document: unsupported document version %d'; +begin + RootNode := AXMLDoc.DocumentElement; + // There must be a root node + if not Assigned(RootNode) then + raise ECodeSnipXML.Create(sNoRootNode); + // Correct root node must be present, with valid watermark and version + if RootNode.NodeName <> ANodeName then + raise ECodeSnipXML.CreateFmt(sBadRootName, [ANodeName]); + if RootNode.Attributes[RootWatermarkAttr] <> AWatermark then + raise ECodeSnipXML.Create(sBadWatermark); + Result := RootNode.Attributes[RootVersionAttr]; + if not AVersions.Contains(Result) then + raise ECodeSnipXML.CreateFmt(sBadVersion, [Result]); +end; + +class procedure TCS4FormatHelper.WriteCompilerResults( + const AXMLDoc: IXMLDocumentEx; const ASnippetNode: IXMLNode; + const ACompRes: TCompileResults); +const + {TODO -cRefactor: Move this map to private class consts to make available to + GetCompilerResults.} + {TODO -cVault: Make CompResMap comply with CS4 XML doc specs - ? should be Q} + // Map of compiler results onto character representation store in XML file. + CompResMap: array[TCompileResult] of Char = ('Y', 'W', 'N', '?'); +var + CompResultsNode: IXMLNode; // node that stores all compiler results + CompResultNode: IXMLNode; // each compiler result node + CompID: TCompilerID; // loops thru all supported compilers +begin + // compiler results value: only write known results + CompResultsNode := AXMLDoc.CreateElement(ASnippetNode, CompilerResultsNodeName); + for CompID := Low(TCompilerID) to High(TCompilerID) do + begin + if ACompRes[CompID] <> crQuery then + begin + CompResultNode := AXMLDoc.CreateElement( + CompResultsNode, CompilerResultNodeName, CompResMap[ACompRes[CompID]] + ); + CompResultNode.Attributes[CompilerResultIdAttr] := + CompilerIDValues[CompID]; + end; + end; +end; + +class procedure TCS4FormatHelper.WritePascalNameList( + const AXMLDoc: IXMLDocumentEx; const AParent: IXMLNode; + const AListName: string; const ANameList: IStringList); +var + ListNode: IXMLNode; + Name: string; +begin + ListNode := AXMLDoc.CreateElement(AParent, AListName); + for Name in ANameList do + AXMLDoc.CreateElement(ListNode, PascalNameNodeName, Name); +end; + +class procedure TCS4FormatHelper.WriteSnippetKind(const AXMLDoc: IXMLDocumentEx; + const ASnippetNode: IXMLNode; const AValue: TSnippetKind); +begin + AXMLDoc.CreateElement( + ASnippetNode, SnippetKindNodeName, SnippetKindValues[AValue] + ); +end; + +end. diff --git a/Src/DB.IO.ImportExport.CS4.pas b/Src/DB.IO.ImportExport.CS4.pas index 00608cd91..e9f3cc47e 100644 --- a/Src/DB.IO.ImportExport.CS4.pas +++ b/Src/DB.IO.ImportExport.CS4.pas @@ -183,23 +183,29 @@ implementation XMLDom, // Project ActiveText.UMain, + DB.IO.Common.CS4, DB.UMain, DB.USnippetKind, DB.Vaults, UAppInfo, USnippetExtraHelper, UStructs, - UStrUtils, - UXMLDocConsts; + UStrUtils; - -const - // XML file markers: attributes of root node - // watermark (never changes for all versions) - cWatermark = 'B46969D4-D367-4F5F-833E-F165FBA78631'; - // file version numbers - cEarliestVersion = 1; // earliest file version supported by importer - cLatestVersion = 7; // current file version written by exporter +type + TCS4ImportExportDocHelper = class(TCS4FormatHelper) + public + const + // watermark (never changes for all versions) + Watermark = 'B46969D4-D367-4F5F-833E-F165FBA78631'; + // file version numbers + EarliestVersion = 1; // earliest file version supported by importer + LatestVersion = 7; // current file version written by exporter + // XML node names + ExportRootNodeName = 'codesnip-export'; + ProgVersionNodeName = 'prog-version'; + SourceCodeTextNodeName= 'source-code-text'; + end; { TCS4SnippetExporter } @@ -218,15 +224,18 @@ function TCS4SnippetExporter.Execute: TEncodedData; sFileComment = 'This file was generated by CodeSnip. Do not edit.'; begin // Create and configure XML document - fXMLDoc := TXMLDocHelper.CreateXMLDoc; + fXMLDoc := TCS4ImportExportDocHelper.CreateXMLDoc; try fXMLDoc.Active := True; // Add XML root nodes - TXMLDocHelper.CreateXMLProcInst(fXMLDoc); - TXMLDocHelper.CreateComment(fXMLDoc, sFileComment); - RootNode := TXMLDocHelper.CreateRootNode( - fXMLDoc, cExportRootNode, cWatermark, cLatestVersion + TCS4ImportExportDocHelper.CreateXMLProcInst(fXMLDoc); + TCS4ImportExportDocHelper.CreateComment(fXMLDoc, sFileComment); + RootNode := TCS4ImportExportDocHelper.CreateRootNode( + fXMLDoc, + TCS4ImportExportDocHelper.ExportRootNodeName, + TCS4ImportExportDocHelper.Watermark, + TCS4ImportExportDocHelper.LatestVersion ); // Write document content @@ -292,7 +301,9 @@ function TCS4SnippetExporter.SnippetKeys(const SnipList: TSnippetList): procedure TCS4SnippetExporter.WriteProgInfo(const ParentNode: IXMLNode); begin fXMLDoc.CreateElement( - ParentNode, cProgVersionNode, TAppInfo.ProgramReleaseVersion + ParentNode, + TCS4ImportExportDocHelper.ProgVersionNodeName, + TAppInfo.ProgramReleaseVersion ); end; @@ -303,7 +314,7 @@ procedure TCS4SnippetExporter.WriteReferenceList(const ParentNode: IXMLNode; if PasNames.Count = 0 then Exit; // Write the list - TXMLDocHelper.WritePascalNameList( + TCS4ImportExportDocHelper.WritePascalNameList( fXMLDoc, ParentNode, ListNodeName, PasNames ); end; @@ -318,46 +329,69 @@ procedure TCS4SnippetExporter.WriteSnippet(const ParentNode: IXMLNode; // Since no vault information is saved, we need choose one vault in order // to generate the key, and the Default vault is the only one guaranteed to be // present. - SnippetNode := fXMLDoc.CreateElement(ParentNode, cSnippetNode); - SnippetNode.Attributes[cSnippetNameAttr] := fSnippetKeyMap[Snippet.ID]; + SnippetNode := fXMLDoc.CreateElement( + ParentNode, TCS4ImportExportDocHelper.SnippetNodeName + ); + SnippetNode.Attributes[ + TCS4ImportExportDocHelper.SnippetNodeNameAttr + ] := fSnippetKeyMap[Snippet.ID]; // Add nodes for properties: (ignore category and xrefs) // description node is written even if empty (which it shouldn't be) fXMLDoc.CreateElement( SnippetNode, - cDescriptionNode, + TCS4ImportExportDocHelper.DescriptionNodeName, TSnippetExtraHelper.BuildREMLMarkup(Snippet.Description) ); // Snippet's display name always written: if display name is specified we use // it, otherwise we use the original snippet key. if not StrIsEmpty(Snippet.DisplayName, True) then - fXMLDoc.CreateElement(SnippetNode, cDisplayNameNode, Snippet.DisplayName) + fXMLDoc.CreateElement( + SnippetNode, + TCS4ImportExportDocHelper.DisplayNameNodeName, + Snippet.DisplayName + ) else - fXMLDoc.CreateElement(SnippetNode, cDisplayNameNode, Snippet.Key); + fXMLDoc.CreateElement( + SnippetNode, TCS4ImportExportDocHelper.DisplayNameNodeName, Snippet.Key + ); // source code is stored directly in XML, not in external file - fXMLDoc.CreateElement(SnippetNode, cSourceCodeTextNode, Snippet.SourceCode); + fXMLDoc.CreateElement( + SnippetNode, + TCS4ImportExportDocHelper.SourceCodeTextNodeName, + Snippet.SourceCode + ); // write highlight source flag + {TODO -cRefactor: Move following method call into TCS4FormatHelper} fXMLDoc.CreateElement( - SnippetNode, cHighlightSource, IntToStr(Ord(Snippet.HiliteSource)) + SnippetNode, + TCS4ImportExportDocHelper.HighlightSourceNodeName, + IntToStr(Ord(Snippet.HiliteSource)) ); + {TODO -cRefactor: Move code that writes Extra into TCS4FormatHelper} // extra info is written only if present if Snippet.Extra.HasContent then fXMLDoc.CreateElement( SnippetNode, - cExtraNode, + TCS4ImportExportDocHelper.ExtraNodeName, TSnippetExtraHelper.BuildREMLMarkup(Snippet.Extra) ); // write kind - TXMLDocHelper.WriteSnippetKind(fXMLDoc, SnippetNode, Snippet.Kind); + TCS4ImportExportDocHelper.WriteSnippetKind(fXMLDoc, SnippetNode, Snippet.Kind); // compiler results value: only write known results - TXMLDocHelper.WriteCompilerResults( + TCS4ImportExportDocHelper.WriteCompilerResults( fXMLDoc, SnippetNode, Snippet.Compatibility ); // depends and units lists + {TODO -cRefactor: Pull writing Depends node into TCS4FormatHelper} WriteReferenceList( - SnippetNode, cDependsNode, SnippetKeys(Snippet.Depends) + SnippetNode, + TCS4ImportExportDocHelper.DependsNodeName, + SnippetKeys(Snippet.Depends) ); WriteReferenceList( - SnippetNode, cUnitsNode, TIStringList.Create(Snippet.Units) + SnippetNode, + TCS4ImportExportDocHelper.UnitsNodeName, + TIStringList.Create(Snippet.Units) ); end; @@ -367,7 +401,9 @@ procedure TCS4SnippetExporter.WriteSnippets(const ParentNode: IXMLNode); Snippet: TSnippet; // refers to each exported snippet begin // Add snippets list node - Node := fXMLDoc.CreateElement(ParentNode, cSnippetsNode); + Node := fXMLDoc.CreateElement( + ParentNode, TCS4ImportExportDocHelper.SnippetsNodeName + ); // Add child node for each exported snippet for Snippet in fSnippets do WriteSnippet(Node, Snippet); @@ -403,13 +439,16 @@ procedure TCS4SnippetImporter.Execute(const Data: TBytes); var UnitNode: IXMLNode; // unit list node: nil if no list begin - UnitNode := fXMLDoc.FindFirstChildNode(SnippetNode, cUnitsNode); + UnitNode := fXMLDoc.FindFirstChildNode( + SnippetNode, TCS4ImportExportDocHelper.UnitsNodeName + ); Units.Clear; - TXMLDocHelper.GetPascalNameList(fXMLDoc, UnitNode, Units); + TCS4ImportExportDocHelper.GetPascalNameList(fXMLDoc, UnitNode, Units); end; /// Reads list of a snippet's required snippets from under SnippetNode into /// Depends list. + {TODO -cRefactor: Pull reading Depends node into TCS4FormatHelper ???} procedure GetDepends(const SnippetNode: IXMLNode; const Depends: ISnippetIDList); var @@ -417,9 +456,11 @@ procedure TCS4SnippetImporter.Execute(const Data: TBytes); SnippetNames: IStringList; // list of names of snippets in depends list SnippetName: string; // each snippet name in SnippetNames begin - DependsNode := fXMLDoc.FindFirstChildNode(SnippetNode, cDependsNode); + DependsNode := fXMLDoc.FindFirstChildNode( + SnippetNode, TCS4ImportExportDocHelper.DependsNodeName + ); SnippetNames := TIStringList.Create; - TXMLDocHelper.GetPascalNameList(fXMLDoc, DependsNode, SnippetNames); + TCS4ImportExportDocHelper.GetPascalNameList(fXMLDoc, DependsNode, SnippetNames); Depends.Clear; for SnippetName in SnippetNames do // Note: in building snippet ID list we assume each snippet is from the @@ -432,7 +473,9 @@ procedure TCS4SnippetImporter.Execute(const Data: TBytes); var Desc: string; // text read from description node begin - Desc := TXMLDocHelper.GetSubTagText(fXMLDoc, SnippetNode, cDescriptionNode); + Desc := TCS4ImportExportDocHelper.GetSubTagText( + fXMLDoc, SnippetNode, TCS4ImportExportDocHelper.DescriptionNodeName + ); if Desc <> '' then begin if fVersion < 6 then @@ -469,34 +512,45 @@ procedure TCS4SnippetImporter.Execute(const Data: TBytes); begin // Read a snippet node SnippetNode := SnippetNodes[Idx]; - fSnippetInfo[Idx].Key := SnippetNode.Attributes[cSnippetNameAttr]; + fSnippetInfo[Idx].Key := SnippetNode.Attributes[ + TCS4ImportExportDocHelper.SnippetNodeNameAttr + ]; fSnippetInfo[Idx].Data := (Database as IDatabaseEdit).GetEditableSnippetInfo; fSnippetInfo[Idx].Data.Props.Cat := ImportCatID; fSnippetInfo[Idx].Data.Props.Desc := GetDescription(SnippetNode); - fSnippetInfo[Idx].Data.Props.DisplayName := TXMLDocHelper.GetSubTagText( - fXMLDoc, SnippetNode, cDisplayNameNode - ); + fSnippetInfo[Idx].Data.Props.DisplayName := + TCS4ImportExportDocHelper.GetSubTagText( + fXMLDoc, SnippetNode, TCS4ImportExportDocHelper.DisplayNameNodeName + ); if fSnippetInfo[Idx].Data.Props.DisplayName = '' then fSnippetInfo[Idx].Data.Props.DisplayName := fSnippetInfo[Idx].Key; - fSnippetInfo[Idx].Data.Props.SourceCode := TXMLDocHelper.GetSubTagText( - fXMLDoc, SnippetNode, cSourceCodeTextNode + fSnippetInfo[Idx].Data.Props.SourceCode := TCS4ImportExportDocHelper.GetSubTagText( + fXMLDoc, SnippetNode, TCS4ImportExportDocHelper.SourceCodeTextNodeName ); fSnippetInfo[Idx].Data.Props.HiliteSource := - TXMLDocHelper.GetHiliteSource(fXMLDoc, SnippetNode, True); + TCS4ImportExportDocHelper.GetHiliteSource(fXMLDoc, SnippetNode, True); // how we read extra property depends on version of file case fVersion of 1: fSnippetInfo[Idx].Data.Props.Extra := TSnippetExtraHelper.BuildActiveText( - TXMLDocHelper.GetSubTagText(fXMLDoc, SnippetNode, cCommentsNode), - TXMLDocHelper.GetSubTagText(fXMLDoc, SnippetNode, cCreditsNode), - TXMLDocHelper.GetSubTagText(fXMLDoc, SnippetNode, cCreditsUrlNode) + TCS4ImportExportDocHelper.GetSubTagText( + fXMLDoc, SnippetNode, TCS4ImportExportDocHelper.CommentsNodeName + ), + TCS4ImportExportDocHelper.GetSubTagText( + fXMLDoc, SnippetNode, TCS4ImportExportDocHelper.CreditsNodeName + ), + TCS4ImportExportDocHelper.GetSubTagText( + fXMLDoc, SnippetNode, TCS4ImportExportDocHelper.CreditsUrlNodeName + ) ); else // later versions fSnippetInfo[Idx].Data.Props.Extra := TSnippetExtraHelper.BuildActiveText( - TXMLDocHelper.GetSubTagText(fXMLDoc, SnippetNode, cExtraNode) + TCS4ImportExportDocHelper.GetSubTagText( + fXMLDoc, SnippetNode, TCS4ImportExportDocHelper.ExtraNodeName + ) ); end; // how we read kind property depends on version of file @@ -504,18 +558,18 @@ procedure TCS4SnippetImporter.Execute(const Data: TBytes); 1, 2: // for version 1 and 2, we have StandardFormat instead of Kind: // map standard format value onto a kind - if TXMLDocHelper.GetStandardFormat(fXMLDoc, SnippetNode, False) then + if TCS4ImportExportDocHelper.GetStandardFormat(fXMLDoc, SnippetNode, False) then fSnippetInfo[Idx].Data.Props.Kind := skRoutine else fSnippetInfo[Idx].Data.Props.Kind := skFreeform; else // later versions // for later versions we have Kind value: use Freeform if missing - fSnippetInfo[Idx].Data.Props.Kind := TXMLDocHelper.GetSnippetKind( + fSnippetInfo[Idx].Data.Props.Kind := TCS4ImportExportDocHelper.GetSnippetKind( fXMLDoc, SnippetNode, skFreeForm ); end; fSnippetInfo[Idx].Data.Props.CompilerResults := - TXMLDocHelper.GetCompilerResults( + TCS4ImportExportDocHelper.GetCompilerResults( fXMLDoc, SnippetNode ); GetUnits(SnippetNode, fSnippetInfo[Idx].Data.Refs.Units); @@ -536,8 +590,14 @@ function TCS4SnippetImporter.GetAllSnippetNodes: IXMLSimpleNodeList; var SnippetsNode: IXMLNode; // node under which all snippets are stored begin - SnippetsNode := fXMLDoc.FindNode(cExportRootNode + '\' + cSnippetsNode); - Result := fXMLDoc.FindChildNodes(SnippetsNode, cSnippetNode); + SnippetsNode := fXMLDoc.FindNode( + TCS4ImportExportDocHelper.ExportRootNodeName + + '\' + + TCS4ImportExportDocHelper.SnippetsNodeName + ); + Result := fXMLDoc.FindChildNodes( + SnippetsNode, TCS4ImportExportDocHelper.SnippetNodeName + ); end; class procedure TCS4SnippetImporter.ImportData( @@ -561,7 +621,7 @@ constructor TCS4SnippetImporter.InternalCreate; begin inherited InternalCreate; OleInitialize(nil); - fXMLDoc := TXMLDocHelper.CreateXMLDoc; + fXMLDoc := TCS4ImportExportDocHelper.CreateXMLDoc; SetLength(fSnippetInfo, 0); EnsureImportCategoryExists; end; @@ -574,21 +634,33 @@ function TCS4SnippetImporter.ValidateDoc: Integer; // Error message sMissingNode = 'Invalid document: no <%s> node present'; begin - TXMLDocHelper.ValidateProcessingInstr(fXMLDoc); - Result := TXMLDocHelper.ValidateRootNode( + TCS4ImportExportDocHelper.ValidateProcessingInstr(fXMLDoc); + Result := TCS4ImportExportDocHelper.ValidateRootNode( fXMLDoc, - cExportRootNode, - cWatermark, - TRange.Create(cEarliestVersion, cLatestVersion) + TCS4ImportExportDocHelper.ExportRootNodeName, + TCS4ImportExportDocHelper.Watermark, + TRange.Create( + TCS4ImportExportDocHelper.EarliestVersion, TCS4ImportExportDocHelper.LatestVersion + ) ); // Must be a snippets node - SnippetsNode := fXMLDoc.FindNode(cExportRootNode + '\' + cSnippetsNode); + SnippetsNode := fXMLDoc.FindNode( + TCS4ImportExportDocHelper.ExportRootNodeName + + '\' + + TCS4ImportExportDocHelper.SnippetsNodeName + ); if not Assigned(SnippetsNode) then - raise ECS4SnippetImporter.CreateFmt(sMissingNode, [cSnippetsNode]); + raise ECS4SnippetImporter.CreateFmt( + sMissingNode, [TCS4ImportExportDocHelper.SnippetsNodeName] + ); // Must be at least one snippet node - SnippetNodes := fXMLDoc.FindChildNodes(SnippetsNode, cSnippetNode); + SnippetNodes := fXMLDoc.FindChildNodes( + SnippetsNode, TCS4ImportExportDocHelper.SnippetNodeName + ); if SnippetNodes.Count = 0 then - raise ECS4SnippetImporter.CreateFmt(sMissingNode, [cSnippetNode]); + raise ECS4SnippetImporter.CreateFmt( + sMissingNode, [TCS4ImportExportDocHelper.SnippetNodeName] + ); end; { TSnippetInfo } diff --git a/Src/DB.IO.Vault.CS4.pas b/Src/DB.IO.Vault.CS4.pas index e60380594..2c71c0aa1 100644 --- a/Src/DB.IO.Vault.CS4.pas +++ b/Src/DB.IO.Vault.CS4.pas @@ -35,8 +35,9 @@ interface /// CodeSnip 4 user data format. TCS4VaultStorage = class(TInterfacedObject) strict protected - fDBDir: string; // Database directory - fXMLDoc: IXMLDocumentEx; // Extended XML document object + var + fDBDir: string; // Database directory + fXMLDoc: IXMLDocumentEx; // Extended XML document object function PathToXMLFile: string; {Gets fully specified path to the XML file. Path depends on which database is being accessed. @@ -257,21 +258,45 @@ implementation uses // Delphi - SysUtils, Classes, ActiveX, XMLDom, + SysUtils, + Classes, + ActiveX, + XMLDom, // Project - ActiveText.UMain, DB.USnippetKind, UConsts, UExceptions, UIOUtils, - USnippetExtraHelper, UStructs, UUtils, UXMLDocConsts, UXMLDocHelper; + ActiveText.UMain, + DB.IO.Common.CS4, + DB.USnippetKind, + UConsts, + UExceptions, + UIOUtils, + USnippetExtraHelper, + UStructs, + UUtils, + UXMLDocHelper; -const - // Database file name - cDatabaseFileName = 'database.xml'; - // File markers: attributes of root node - // watermark (never changes for all versions) - cWatermark = '531257EA-1EE3-4B0F-8E46-C6E7F7140106'; - // supported file format versions - cEarliestVersion = 1; - cLatestVersion = 6; +type + TCS4VaultFormatHelper = class(TCS4FormatHelper) + public + const + // Database file name + DatabaseFileName = 'database.xml'; + // File markers: attributes of root node + // watermark (never changes for all versions) + Watermark = '531257EA-1EE3-4B0F-8E46-C6E7F7140106'; + // supported file format versions + EarliestVersion = 1; + LatestVersion = 6; + // node & attribute names + CatIdNodeName = 'cat-id'; + UserDataRootNodeName = 'codesnip-data'; + CategoriesNodeName = 'categories'; + CategoryNodeName = 'category'; + CategoryNodeIdAttrName = 'id'; + CatSnippetsNodeName = 'cat-routines'; + SourceCodeNodeName = 'source-code'; + XRefNodeName = 'xref'; + end; { Support routines } @@ -311,7 +336,7 @@ constructor TCS4VaultStorage.Create(const DBDir: string); // For some reason we must call OleInitialize here rather than in // initialization section OleInitialize(nil); - fXMLDoc := TXMLDocHelper.CreateXMLDoc; + fXMLDoc := TCS4VaultFormatHelper.CreateXMLDoc; end; function TCS4VaultStorage.DataDir: string; @@ -353,12 +378,19 @@ function TCS4VaultStorage.FindCategoryNode(const CatID: string): IXMLNode; begin Result := nil; // Find node - CatListNode := fXMLDoc.FindNode(cUserDataRootNode + '\' + cCategoriesNode); + CatListNode := fXMLDoc.FindNode( + TCS4VaultFormatHelper.UserDataRootNodeName + + '\' + + TCS4VaultFormatHelper.CategoriesNodeName + ); if not Assigned(CatListNode) then - Error(sMissingNode, [cCategoriesNode]); + Error(sMissingNode, [TCS4VaultFormatHelper.CategoriesNodeName]); // Find required node Result := fXMLDoc.FindFirstChildNode( - CatListNode, cCategoryNode, cCategoryIdAttr, CatID + CatListNode, + TCS4VaultFormatHelper.CategoryNodeName, + TCS4VaultFormatHelper.CategoryNodeIdAttrName, + CatID ) end; @@ -372,12 +404,19 @@ function TCS4VaultStorage.FindSnippetNode(const SnippetKey: string): IXMLNode; begin Result := nil; // Find snippets node - SnippetListNode := fXMLDoc.FindNode(cUserDataRootNode + '\' + cSnippetsNode); + SnippetListNode := fXMLDoc.FindNode( + TCS4VaultFormatHelper.UserDataRootNodeName + + '\' + + TCS4VaultFormatHelper.SnippetsNodeName + ); if not Assigned(SnippetListNode) then - Error(sMissingNode, [cSnippetsNode]); + Error(sMissingNode, [TCS4VaultFormatHelper.SnippetsNodeName]); // Find required snippet node Result := fXMLDoc.FindFirstChildNode( - SnippetListNode, cSnippetNode, cSnippetNameAttr, SnippetKey + SnippetListNode, + TCS4VaultFormatHelper.SnippetNodeName, + TCS4VaultFormatHelper.SnippetNodeNameAttr, + SnippetKey ); end; @@ -387,7 +426,7 @@ function TCS4VaultStorage.PathToXMLFile: string; @return Required path. } begin - Result := DataFile(cDatabaseFileName); + Result := DataFile(TCS4VaultFormatHelper.DatabaseFileName); end; { TCS4VaultStorageReader } @@ -424,12 +463,15 @@ constructor TCS4VaultStorageReader.Create(const DBDir: string); begin // Database doesn't exist: create sufficient nodes for main code to find fXMLDoc.Active := True; - TXMLDocHelper.CreateXMLProcInst(fXMLDoc); - RootNode := TXMLDocHelper.CreateRootNode( - fXMLDoc, cUserDataRootNode, cWatermark, cLatestVersion + TCS4VaultFormatHelper.CreateXMLProcInst(fXMLDoc); + RootNode := TCS4VaultFormatHelper.CreateRootNode( + fXMLDoc, + TCS4VaultFormatHelper.UserDataRootNodeName, + TCS4VaultFormatHelper.Watermark, + TCS4VaultFormatHelper.LatestVersion ); - fXMLDoc.CreateElement(RootNode, cCategoriesNode); - fXMLDoc.CreateElement(RootNode, cSnippetsNode); + fXMLDoc.CreateElement(RootNode, TCS4VaultFormatHelper.CategoriesNodeName); + fXMLDoc.CreateElement(RootNode, TCS4VaultFormatHelper.SnippetsNodeName); end; end; @@ -453,12 +495,20 @@ function TCS4VaultStorageReader.GetAllCatIDs: IStringList; begin try Result := TIStringList.Create; - CatListNode := fXMLDoc.FindNode(cUserDataRootNode + '\' + cCategoriesNode); + CatListNode := fXMLDoc.FindNode( + TCS4VaultFormatHelper.UserDataRootNodeName + + '\' + + TCS4VaultFormatHelper.CategoriesNodeName + ); if not Assigned(CatListNode) then Error(sNoCategoriesNode); - CatNodes := fXMLDoc.FindChildNodes(CatListNode, cCategoryNode); + CatNodes := fXMLDoc.FindChildNodes( + CatListNode, TCS4VaultFormatHelper.CategoryNodeName + ); for CatNode in CatNodes do - Result.Add(CatNode.Attributes[cCategoryIdAttr]); + Result.Add( + CatNode.Attributes[TCS4VaultFormatHelper.CategoryNodeIdAttrName] + ); except HandleCorruptDatabase(ExceptObject); end; @@ -480,8 +530,8 @@ procedure TCS4VaultStorageReader.GetCatProps(const CatID: string; // Properties will not be requested for a category that doesn't exist in // this database, so this should never happen Error(sCatNotFound); - Props.Desc := TXMLDocHelper.GetSubTagText( - fXMLDoc, CatNode, cDescriptionNode + Props.Desc := TCS4VaultFormatHelper.GetSubTagText( + fXMLDoc, CatNode, TCS4VaultFormatHelper.DescriptionNodeName ); except HandleCorruptDatabase(ExceptObject); @@ -504,8 +554,11 @@ function TCS4VaultStorageReader.GetCatSnippets(const CatID: string): // This is not an error since it is possible that a category exists in // another database and loader will request info from here also Exit; - TXMLDocHelper.GetPascalNameList( - fXMLDoc, fXMLDoc.FindFirstChildNode(CatNode, cCatSnippetsNode), Result + TCS4VaultFormatHelper.GetPascalNameList( + fXMLDoc, fXMLDoc.FindFirstChildNode( + CatNode, TCS4VaultFormatHelper.CatSnippetsNodeName + ), + Result ); except HandleCorruptDatabase(ExceptObject); @@ -525,7 +578,9 @@ function TCS4VaultStorageReader.GetSnippetDepends(const SnippetKey: string): @return List of snippet keys. } begin - Result := GetSnippetReferences(SnippetKey, cDependsNode); + Result := GetSnippetReferences( + SnippetKey, TCS4VaultFormatHelper.DependsNodeName + ); end; procedure TCS4VaultStorageReader.GetSnippetProps(const SnippetKey: string; @@ -544,7 +599,9 @@ procedure TCS4VaultStorageReader.GetSnippetProps(const SnippetKey: string; @return Property value from tag's text. } begin - Result := TXMLDocHelper.GetSubTagText(fXMLDoc, SnippetNode, PropTagName); + Result := TCS4VaultFormatHelper.GetSubTagText( + fXMLDoc, SnippetNode, PropTagName + ); end; function GetSourceCodePropertyText: string; @@ -554,7 +611,7 @@ procedure TCS4VaultStorageReader.GetSnippetProps(const SnippetKey: string; var DataFileName: string; // name of file containing source code begin - DataFileName := GetPropertyText(cSourceCodeFileNode); + DataFileName := GetPropertyText(TCS4VaultFormatHelper.SourceCodeNodeName); if DataFileName = '' then Error(sMissingSource, [SnippetKey]); try @@ -582,7 +639,7 @@ procedure TCS4VaultStorageReader.GetSnippetProps(const SnippetKey: string; @return True if standard format, False if not. } begin - Result := TXMLDocHelper.GetStandardFormat( + Result := TCS4VaultFormatHelper.GetStandardFormat( fXMLDoc, SnippetNode, False ); end; @@ -601,7 +658,9 @@ procedure TCS4VaultStorageReader.GetSnippetProps(const SnippetKey: string; Default := skRoutine else Default := skFreeform; - Result := TXMLDocHelper.GetSnippetKind(fXMLDoc, SnippetNode, Default); + Result := TCS4VaultFormatHelper.GetSnippetKind( + fXMLDoc, SnippetNode, Default + ); end; function GetExtraProperty: IActiveText; @@ -615,14 +674,14 @@ procedure TCS4VaultStorageReader.GetSnippetProps(const SnippetKey: string; // version 1: build extra data from comments, credits and credits URL // nodes Result := TSnippetExtraHelper.BuildActiveText( - GetPropertyText(cCommentsNode), - GetPropertyText(cCreditsNode), - GetPropertyText(cCreditsUrlNode) + GetPropertyText(TCS4VaultFormatHelper.CommentsNodeName), + GetPropertyText(TCS4VaultFormatHelper.CreditsNodeName), + GetPropertyText(TCS4VaultFormatHelper.CreditsUrlNodeName) ) else // version 2 & later: build extra data from REML in extra node Result := TSnippetExtraHelper.BuildActiveText( - GetPropertyText(cExtraNode) + GetPropertyText(TCS4VaultFormatHelper.ExtraNodeName) ); except // error: provide an empty property value @@ -634,7 +693,7 @@ procedure TCS4VaultStorageReader.GetSnippetProps(const SnippetKey: string; var Desc: string; // text read from description node begin - Desc := GetPropertyText(cDescriptionNode); + Desc := GetPropertyText(TCS4VaultFormatHelper.DescriptionNodeName); if Desc <> '' then begin if fVersion < 6 then @@ -655,16 +714,16 @@ procedure TCS4VaultStorageReader.GetSnippetProps(const SnippetKey: string; if not Assigned(SnippetNode) then Error(sSnippetNotFound, [SnippetKey]); // Snippet found: read properties - Props.Cat := GetPropertyText(cCatIdNode); - Props.DisplayName := GetPropertyText(cDisplayNameNode); + Props.Cat := GetPropertyText(TCS4VaultFormatHelper.CatIdNodeName); + Props.DisplayName := GetPropertyText(TCS4VaultFormatHelper.DisplayNameNodeName); Props.Kind := GetKindProperty; Props.Desc := GetDescriptionProperty; Props.Extra := GetExtraProperty; Props.SourceCode := GetSourceCodePropertyText; - Props.HiliteSource := TXMLDocHelper.GetHiliteSource( + Props.HiliteSource := TCS4VaultFormatHelper.GetHiliteSource( fXMLDoc, SnippetNode, True ); - Props.CompilerResults := TXMLDocHelper.GetCompilerResults( + Props.CompilerResults := TCS4VaultFormatHelper.GetCompilerResults( fXMLDoc, SnippetNode ); except @@ -682,13 +741,14 @@ function TCS4VaultStorageReader.GetSnippetReferences(const SnippetKey, var SnippetNode: IXMLNode; // node for required snippet begin - try + {TODO -cRefactor: Pull reading snippet references into TCS4VaultFormatHelper ???} + try Result := TIStringList.Create; SnippetNode := FindSnippetNode(SnippetKey); if not Assigned(SnippetNode) then Error(sSnippetNotFound, [SnippetKey]); // References are contained in a list of contained nodes - TXMLDocHelper.GetPascalNameList( + TCS4VaultFormatHelper.GetPascalNameList( fXMLDoc, fXMLDoc.FindFirstChildNode(SnippetNode, RefName), Result ); except @@ -703,7 +763,7 @@ function TCS4VaultStorageReader.GetSnippetUnits(const SnippetKey: string): @return List of unit keys. } begin - Result := GetSnippetReferences(SnippetKey, cUnitsNode); + Result := GetSnippetReferences(SnippetKey, TCS4VaultFormatHelper.UnitsNodeName); end; function TCS4VaultStorageReader.GetSnippetXRefs(const SnippetKey: string): @@ -713,7 +773,9 @@ function TCS4VaultStorageReader.GetSnippetXRefs(const SnippetKey: string): @return List of snippet keys. } begin - Result := GetSnippetReferences(SnippetKey, cXRefNode); + Result := GetSnippetReferences( + SnippetKey, TCS4VaultFormatHelper.XRefNodeName + ); end; procedure TCS4VaultStorageReader.HandleCorruptDatabase(const EObj: TObject); @@ -745,18 +807,28 @@ function TCS4VaultStorageReader.ValidateDoc: Integer; @except EDataIO raised if XML is not valid. } begin - TXMLDocHelper.ValidateProcessingInstr(fXMLDoc); - Result := TXMLDocHelper.ValidateRootNode( + TCS4VaultFormatHelper.ValidateProcessingInstr(fXMLDoc); + Result := TCS4VaultFormatHelper.ValidateRootNode( fXMLDoc, - cUserDataRootNode, - cWatermark, - TRange.Create(cEarliestVersion, cLatestVersion) + TCS4VaultFormatHelper.UserDataRootNodeName, + TCS4VaultFormatHelper.Watermark, + TRange.Create( + TCS4VaultFormatHelper.EarliestVersion, TCS4VaultFormatHelper.LatestVersion + ) ); // Both a categories and a snippets node must exist - if fXMLDoc.FindNode(cUserDataRootNode + '\' + cCategoriesNode) = nil then - Error(sMissingNode, [cCategoriesNode]); - if fXMLDoc.FindNode(cUserDataRootNode + '\' + cSnippetsNode) = nil then - Error(sMissingNode, [cSnippetsNode]); + if fXMLDoc.FindNode( + TCS4VaultFormatHelper.UserDataRootNodename + + '\' + + TCS4VaultFormatHelper.CategoriesNodeName + ) = nil then + Error(sMissingNode, [TCS4VaultFormatHelper.CategoriesNodeName]); + if fXMLDoc.FindNode( + TCS4VaultFormatHelper.UserDataRootNodeName + + '\' + + TCS4VaultFormatHelper.SnippetsNodeName + ) = nil then + Error(sMissingNode, [TCS4VaultFormatHelper.SnippetsNodeName]); end; { TCS4VaultStorageWriter } @@ -767,7 +839,9 @@ procedure TCS4VaultStorageWriter.Finalise; var FS: TFileStream; // stream onto output file begin - fXMLDoc.DocumentElement.SetAttribute(cRootVersionAttr, cLatestVersion); + fXMLDoc.DocumentElement.SetAttribute( + TCS4VaultFormatHelper.RootVersionAttr, TCS4VaultFormatHelper.LatestVersion + ); // We use a TFileStream and TXMLDocument.SaveToStream rather than calling // TXMLDocument.SaveToFile so that any problem creating file is reported via // a known Delphi exception that can be handled. @@ -820,16 +894,23 @@ procedure TCS4VaultStorageWriter.Initialise; // methods fXMLDoc.Active := True; // xml processing instruction: id file as XML - TXMLDocHelper.CreateXMLProcInst(fXMLDoc); + TCS4VaultFormatHelper.CreateXMLProcInst(fXMLDoc); // comments - TXMLDocHelper.CreateComment(fXMLDoc, sFileComment); + TCS4VaultFormatHelper.CreateComment(fXMLDoc, sFileComment); // root node - RootNode := TXMLDocHelper.CreateRootNode( - fXMLDoc, cUserDataRootNode, cWatermark, cLatestVersion + RootNode := TCS4VaultFormatHelper.CreateRootNode( + fXMLDoc, + TCS4VaultFormatHelper.UserDataRootNodeName, + TCS4VaultFormatHelper.Watermark, + TCS4VaultFormatHelper.LatestVersion ); // empty categories and snippets nodes - fCategoriesNode := fXMLDoc.CreateElement(RootNode, cCategoriesNode); - fSnippetsNode := fXMLDoc.CreateElement(RootNode, cSnippetsNode); + fCategoriesNode := fXMLDoc.CreateElement( + RootNode, TCS4VaultFormatHelper.CategoriesNodeName + ); + fSnippetsNode := fXMLDoc.CreateElement( + RootNode, TCS4VaultFormatHelper.SnippetsNodeName + ); except HandleException(ExceptObject); end; @@ -847,9 +928,13 @@ procedure TCS4VaultStorageWriter.WriteCatProps(const CatID: string; begin try // Create node - CatNode := fXMLDoc.CreateElement(fCategoriesNode, cCategoryNode); - CatNode.Attributes[cCategoryIdAttr] := CatID; - fXMLDoc.CreateElement(CatNode, cDescriptionNode, Props.Desc); + CatNode := fXMLDoc.CreateElement( + fCategoriesNode, TCS4VaultFormatHelper.CategoryNodeName + ); + CatNode.Attributes[TCS4VaultFormatHelper.CategoryNodeIdAttrName] := CatID; + fXMLDoc.CreateElement( + CatNode, TCS4VaultFormatHelper.DescriptionNodeName, Props.Desc + ); except HandleException(ExceptObject); end; @@ -874,7 +959,15 @@ procedure TCS4VaultStorageWriter.WriteCatSnippets(const CatID: string; Assert(Assigned(CatNode), ClassName + '.WriteCatSnippets: Can''t find category node'); // Write the list - WriteNameList(CatNode, cCatSnippetsNode, cPascalNameNode, SnipList); + {TODO -cRefactor: Call TCS4VaultFormatHelper.WritePascalNameList instead? If this + is done then TCS4VaultFormatHelper.PascalNameNodeName can be made private + again.} + WriteNameList( + CatNode, + TCS4VaultFormatHelper.CatSnippetsNodeName, + TCS4VaultFormatHelper.PascalNameNodeName, + SnipList + ); except HandleException(ExceptObject); end; @@ -922,7 +1015,7 @@ procedure TCS4VaultStorageWriter.WriteReferenceList(const SnippetKey, Assert(Assigned(SnippetNode), ClassName + '.WriteReferenceList: Can''t find snippet node'); // Write the list - TXMLDocHelper.WritePascalNameList( + TCS4VaultFormatHelper.WritePascalNameList( fXMLDoc, SnippetNode, ListName, Items ); except @@ -937,7 +1030,8 @@ procedure TCS4VaultStorageWriter.WriteSnippetDepends(const SnippetKey: string; @param Depends [in] List of snippet keys. } begin - WriteReferenceList(SnippetKey, cDependsNode, Depends); + {TODO -cRefactor: Pull writing Depends node into TCS4VaultFormatHelper} + WriteReferenceList(SnippetKey, TCS4VaultFormatHelper.DependsNodeName, Depends); end; procedure TCS4VaultStorageWriter.WriteSnippetProps(const SnippetKey: string; @@ -957,14 +1051,18 @@ procedure TCS4VaultStorageWriter.WriteSnippetProps(const SnippetKey: string; begin try // Create snippet node - SnippetNode := fXMLDoc.CreateElement(fSnippetsNode, cSnippetNode); - SnippetNode.Attributes[cSnippetNameAttr] := SnippetKey; + SnippetNode := fXMLDoc.CreateElement( + fSnippetsNode, TCS4VaultFormatHelper.SnippetNodeName + ); + SnippetNode.Attributes[TCS4VaultFormatHelper.SnippetNodeNameAttr] := SnippetKey; // Add properties - fXMLDoc.CreateElement(SnippetNode, cCatIdNode, Props.Cat); + fXMLDoc.CreateElement( + SnippetNode, TCS4VaultFormatHelper.CatIdNodeName, Props.Cat + ); // description node is written even if empty (which it shouldn't be) fXMLDoc.CreateElement( SnippetNode, - cDescriptionNode, + TCS4VaultFormatHelper.DescriptionNodeName, TSnippetExtraHelper.BuildREMLMarkup(Props.Desc) ); // source code is written to a UTF-8 encoded file with no BOM and filename @@ -974,23 +1072,31 @@ procedure TCS4VaultStorageWriter.WriteSnippetProps(const SnippetKey: string; TFileIO.WriteAllText( DataFile(FileName), Props.SourceCode, TEncoding.UTF8, False ); - fXMLDoc.CreateElement(SnippetNode, cSourceCodeFileNode, FileName); fXMLDoc.CreateElement( - SnippetNode, cHighlightSource, IntToStr(Ord(Props.HiliteSource)) + SnippetNode, TCS4VaultFormatHelper.SourceCodeNodeName, FileName + ); + {TODO -cRefactor: Move following method call into TCS4VaultFormatHelper} + fXMLDoc.CreateElement( + SnippetNode, + TCS4VaultFormatHelper.HighlightSourceNodeName, + IntToStr(Ord(Props.HiliteSource)) + ); + fXMLDoc.CreateElement( + SnippetNode, TCS4VaultFormatHelper.DisplayNameNodeName, Props.DisplayName ); - fXMLDoc.CreateElement(SnippetNode, cDisplayNameNode, Props.DisplayName); + {TODO -cRefactor: Move code that writes Extra into TCS4VaultFormatHelper} // extra node is only written if extra property has a value if Props.Extra.HasContent then begin fXMLDoc.CreateElement( SnippetNode, - cExtraNode, + TCS4VaultFormatHelper.ExtraNodeName, TSnippetExtraHelper.BuildREMLMarkup(Props.Extra) ); end; - TXMLDocHelper.WriteSnippetKind(fXMLDoc, SnippetNode, Props.Kind); + TCS4VaultFormatHelper.WriteSnippetKind(fXMLDoc, SnippetNode, Props.Kind); // only known compiler results are written - TXMLDocHelper.WriteCompilerResults( + TCS4VaultFormatHelper.WriteCompilerResults( fXMLDoc, SnippetNode, Props.CompilerResults ); except @@ -1005,7 +1111,7 @@ procedure TCS4VaultStorageWriter.WriteSnippetUnits(const SnippetKey: string; @param Units [in] List of names of required units. } begin - WriteReferenceList(SnippetKey, cUnitsNode, Units); + WriteReferenceList(SnippetKey, TCS4VaultFormatHelper.UnitsNodeName, Units); end; procedure TCS4VaultStorageWriter.WriteSnippetXRefs(const SnippetKey: string; @@ -1015,7 +1121,7 @@ procedure TCS4VaultStorageWriter.WriteSnippetXRefs(const SnippetKey: string; @param XRefs [in] List of cross references snippets. } begin - WriteReferenceList(SnippetKey, cXRefNode, XRefs); + WriteReferenceList(SnippetKey, TCS4VaultFormatHelper.XRefNodeName, XRefs); end; end. diff --git a/Src/UXMLDocConsts.pas b/Src/UXMLDocConsts.pas deleted file mode 100644 index 122d13322..000000000 --- a/Src/UXMLDocConsts.pas +++ /dev/null @@ -1,79 +0,0 @@ -{ - * This Source Code Form is subject to the terms of the Mozilla Public License, - * v. 2.0. If a copy of the MPL was not distributed with this file, You can - * obtain one at https://mozilla.org/MPL/2.0/ - * - * Copyright (C) 2008-2023, Peter Johnson (gravatar.com/delphidabbler). - * - * Constants defined node names and attributes used in the various XML documents - * used by CodeSnip. -} - - -unit UXMLDocConsts; - - -interface - - -uses - // Project - Compilers.UGlobals; - - -const - // XML processing instruction node with version - cXMLNode = 'xml'; - cXMLNodeText = 'version="1.0"'; - - // Document nodes and attribute names - // user-database XML only - cUserDataRootNode = 'codesnip-data'; - cCategoriesNode = 'categories'; - cCategoryNode = 'category'; - cCategoryIdAttr = 'id'; - cCatSnippetsNode = 'cat-routines'; - cSourceCodeFileNode = 'source-code'; - cXRefNode = 'xref'; - // export XML only - cExportRootNode = 'codesnip-export'; - cProgVersionNode = 'prog-version'; - cSourceCodeTextNode = 'source-code-text'; - // common to user-database and export XML - cRootVersionAttr = 'version'; - cRootWatermarkAttr = 'watermark'; - cPascalNameNode = 'pascal-name'; - cDisplayNameNode = 'display-name'; - cSnippetsNode = 'routines'; - cSnippetNode = 'routine'; - cSnippetNameAttr = 'name'; - cCatIdNode = 'cat-id'; - cDescriptionNode = 'description'; - cUnitsNode = 'units'; - cDependsNode = 'depends'; - cCommentsNode = 'comments'; - cCreditsNode = 'credits'; - cCreditsUrlNode = 'credits-url'; - cExtraNode = 'extra'; - cKindNode = 'kind'; - cHighlightSource = 'highlight-source'; - cStandardFormatNode = 'standard-format'; - cCompilerResultsNode = 'compiler-results'; - cCompilerResultNode = 'compiler-result'; - cCompilerResultIdAttr = 'id'; - - // ID values: common to user-database and export XML - cCompilerIDs: array[TCompilerID] of string = ( - 'd2', 'd3', 'd4', 'd5', 'd6', 'd7', - 'd2005', 'd2006', 'd2007', 'd2009', 'd2010', - 'dXE', 'dXE2', 'dXE3', 'dDX4' {error, but in use so can't fix}, - 'dXE5', 'dXE6', 'dXE7', 'dXE8', - 'd10s', 'd101b', 'd102t', 'd103r', 'd104s', 'd11a', 'd12y', - 'fpc' - ); - - -implementation - -end. - diff --git a/Src/UXMLDocHelper.pas b/Src/UXMLDocHelper.pas index fabe3f1ea..9ebb91700 100644 --- a/Src/UXMLDocHelper.pas +++ b/Src/UXMLDocHelper.pas @@ -5,7 +5,7 @@ * * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * - * Implements a static class that helps with input and output to CodeSnip XML + * Implements a static class that helps with input and output to any XML * documents. } @@ -20,19 +20,28 @@ interface // Delphi XMLIntf, // Project - Compilers.UGlobals, DB.USnippetKind, UExceptions, UIStringList, UStructs, + Compilers.UGlobals, + DB.USnippetKind, + UBaseObjects, + UExceptions, + UIStringList, + UStructs, UXMLDocumentEx; type - { - TXMLDocHelper: - Static class that helps with input and output to CodeSnip XML documents. - Provides functionality common to two or more XML read/write classes. - } - TXMLDocHelper = class(TObject) + /// Static class that helps with input and output to any XML + /// documents. + /// Do not contruct instances of this class. + TXMLDocHelper = class(TNoConstructObject) strict private + const + // XML processing instruction node + XMLNodeName = 'xml'; + // XML processing node version attribute + XMLNodeVersionAttr = 'version="1.0"'; + class function FindRootNodeType(const XMLDoc: IXMLDocumentEx; const ANodeType: TNodeType): IXMLNode; {Finds a specified type of root node. @@ -49,21 +58,6 @@ TXMLDocHelper = class(TObject) {Creates xml processing instruction in document. @param XMLDoc [in] Document in which processing instruction is inserted. } - class procedure CreateComment(const XMLDoc: IXMLDocumentEx; - const Comment: string); - {Creates a comment at the top level of an XML document. - @param XMLDoc [in] Document in which comment is inserted. - @param Comment [in] Comment to be inserted. - } - class function CreateRootNode(const XMLDoc: IXMLDocumentEx; - const NodeName, Watermark: string; const Version: Integer): IXMLNode; - {Creates a root in XML document. - @param XMLDoc [in] Document in which to insert root node. - @param NodeName [in] Name of root node. - @param Watermark [in] Value of root node's "watermark" attribute. - @param Version [in] Value of root node's "version" attribute. - @return Reference to new root node. - } class function GetSubTagText(const XMLDoc: IXMLDocumentEx; const ParentNode: IXMLNode; const SubTagName: string): string; {Gets text of subtag of a parent node in an XML document. @@ -73,84 +67,6 @@ TXMLDocHelper = class(TObject) @return Sub tag's text if sub tag exists and is a text node, '' otherwise. } - class procedure GetPascalNameList(const XMLDoc: IXMLDocumentEx; - const ListNode: IXMLNode; const NameList: IStringList); - {Gets a list of names in elements with a list. - @param XMLDoc [in] XML document containing name list. - @param ListNode [in] Node that contains list. - @param NameList [in] Receives text of all elements in - list. - } - class function GetCompilerResults(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode): TCompileResults; - {Gets compiler results for a snippet in an XML document. - @param XMLDoc [in] XML document containing snippet. - @param SnippetNode [in] Document node that contains compiler results - tag. - @return Array of compiler results. Provides defaults for missing - compilers. - } - class function GetStandardFormat(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode; const Default: Boolean): Boolean; - {Gets value of a node of a snippet in an XML document. - @param XMLDoc [in] XML document containing snippet. - @param SnippetNode [in] Snippet node that contains standard format tag. - @param Default [in] Value to use if node doesn't exist or has - non-standard value. - @return Value of node, or default value. - } - class function GetSnippetKind(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode; const Default: TSnippetKind): TSnippetKind; - {Gets value of node of a snippet in an XML document. - @param XMLDoc [in] XML document containing snippet. - @param SnippetNode [in] Snippet node that contains kind tag. - @param Default [in] Value to use if node doesn't exist or has - non-standard value. - @return Required snippet kind. - } - class function GetHiliteSource(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode; const Default: Boolean): Boolean; - {Gets value of a node of a snippet in an XML document. - @param XMLDoc [in] XML document containing snippet. - @param SnippetNode [in] Snippet node that contains highlight source tag. - @param Default [in] Value to use if node doesn't exist or has - non-standard value. - @return Value of node, or default value. - } - class procedure WriteCompilerResults(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode; const CompRes: TCompileResults); - {Writes compile results for a snippet to XML document. - @param XMLDoc [in] XML document to receive compile results. - @param SnippetNode [in] Node containing snippet that received compile - results. - @param CompRes [in] Array of compiler results. - } - class procedure WritePascalNameList(const XMLDoc: IXMLDocumentEx; - const Parent: IXMLNode; const ListName: string; const Names: IStringList); - {Writes a Pascal name list to an XML document. - @param XMLDoc [in] XML document to which list is written. - @param Parent [in] Parent node that is to contain name list. - @param ListName [in] Name of new list node that is parent of list. - @param Names [in] List of Pascal names. - } - class procedure WriteSnippetKind(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode; const Value: TSnippetKind); - {Writes a node to a an XML document. - @param XMLDoc [in] XML document to receive the node. - @param SnippetNode [in] Node containing snippet that receives kind node. - @param Value [in] Value of node. - } - class function ValidateRootNode(const XMLDoc: IXMLDocumentEx; - const ANodeName, AWatermark: string; const AVersions: TRange): Integer; - {Validates the root node of an XML document. - @param XMLDoc [in] XML document to be validated. - @param ANodeName [in] Name of root mode. - @param AWatermark [in] Required value of root node's "watermark" - attribute. - @param AVersions [in] Range of acceptable file version numbers. - @return Document version. - @except ECodeSnipXML raised on error. - } class procedure ValidateProcessingInstr(const XMLDoc: IXMLDocumentEx); {Checks that an XML document has a valid xml processing instruction. @param XMLDoc [in] Document to be checked. @@ -158,6 +74,7 @@ TXMLDocHelper = class(TObject) } end; + {TODO -cVault: Replace ECodeSnipXML with EDataIO} { ECodeSnipXML: Class of exception raised by TXMLDocHelper validation methods. @@ -172,37 +89,11 @@ implementation // Delphi Windows {for inlining}, // Project - UStrUtils, UXMLDocConsts; + UStrUtils; { TXMLDocHelper } -class procedure TXMLDocHelper.CreateComment(const XMLDoc: IXMLDocumentEx; - const Comment: string); - {Creates a comment at the top level of an XML document. - @param XMLDoc [in] Document in which comment is inserted. - @param Comment [in] Comment to be inserted. - } -begin - XMLDoc.ChildNodes.Add(XMLDoc.CreateNode(' ' + Comment + ' ', ntComment)); -end; - -class function TXMLDocHelper.CreateRootNode(const XMLDoc: IXMLDocumentEx; - const NodeName, Watermark: string; const Version: Integer): IXMLNode; - {Creates a root in XML document. - @param XMLDoc [in] Document in which to insert root node. - @param NodeName [in] Name of root node. - @param Watermark [in] Value of root node's "watermark" attribute. - @param Version [in] Value of root node's "version" attribute. - @return Reference to new root node. - } -begin - Result := XMLDoc.CreateNode(NodeName); - Result.SetAttribute(cRootWatermarkAttr, Watermark); - Result.SetAttribute(cRootVersionAttr, Version); - XMLDoc.ChildNodes.Add(Result); -end; - class function TXMLDocHelper.CreateXMLDoc: IXMLDocumentEx; {Creates a new XML document object with required properties. @return New XML document object. @@ -219,7 +110,7 @@ class procedure TXMLDocHelper.CreateXMLProcInst(const XMLDoc: IXMLDocumentEx); } begin XMLDoc.ChildNodes.Add( - XMLDoc.CreateNode(cXMLNode, ntProcessingInstr, cXMLNodeText) + XMLDoc.CreateNode(XMLNodeName, ntProcessingInstr, XMLNodeVersionAttr) ); end; @@ -244,174 +135,6 @@ class function TXMLDocHelper.FindRootNodeType(const XMLDoc: IXMLDocumentEx; end; end; -class function TXMLDocHelper.GetCompilerResults(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode): TCompileResults; - {Gets compiler results for a snippet in an XML document. - @param XMLDoc [in] XML document containing snippet. - @param SnippetNode [in] Document node that contains compiler results tag. - @return Array of compiler results. Provides defaults for missing compilers. - } - - // ------------------------------------------------------------------------- - function IDStrToCompID(IDStr: string; - out Match: TCompilerID): Boolean; - {Converts an identifier string to a compiler ID. - @param IDStr [in] Identifier string. - @param Match [out] Set to compiler ID that matches IDStr. Undefined if - IDStr not recognised. - @return True if IDStr is recognised, False if not. - } - var - CompID: TCompilerID; // loops thru all compiler IDs - begin - // 'dXE4' can be encountered when reading files written by CodeSnip 3, which - // uses correct 'dXE4' symbol for Delphi XE4 instead of 'dDX4' used - // (erroneously) by CodeSnip 4. So the following two lines convert the - // CodeSnip 3 value to the CodeSnip 4 value before testing. - if IDStr = 'dXE4' then - IDStr := cCompilerIDs[ciDXE4]; - Result := False; - for CompID := Low(TCompilerID) to High(TCompilerID) do - begin - if cCompilerIDs[CompID] = IDStr then - begin - Result := True; - Match := CompID; - Break; - end; - end; - end; - // ------------------------------------------------------------------------- - -var - ListNode: IXMLNode; // node that enclose compiler result nodes - ResultsNodes: IXMLSimpleNodeList; // list of compiler-result nodes - ResultNode: IXMLNode; // a compiler-result node - CompID: TCompilerID; // loops thru compiler IDs - CompResultStr: string; // compiler id string from result node -begin - // Initialise all results to unknown (query) - for CompID := Low(TCompilerID) to High(TCompilerID) do - Result[CompID] := crQuery; - - // Find enclosing node: valid if this is not present - ListNode := XMLDoc.FindFirstChildNode(SnippetNode, cCompilerResultsNode); - if not Assigned(ListNode) then - Exit; - - // Get list of compiler-result nodes contained in list and process each one - ResultsNodes := XMLDoc.FindChildNodes(ListNode, cCompilerResultNode); - for ResultNode in ResultsNodes do - begin - if ResultNode.IsTextElement then - begin - // get compile result identifier - CompResultStr := ResultNode.Text; - if CompResultStr = '' then - CompResultStr := '?'; - // add specified result function result - if IDStrToCompID( - ResultNode.Attributes[cCompilerResultIdAttr], CompID - ) then - begin - case CompResultStr[1] of - 'Y': Result[CompID] := crSuccess; - 'N': Result[CompID] := crError; - 'W': Result[CompiD] := crWarning; - else Result[CompID] := crQuery; - end; - end; - end; - end; -end; - -class function TXMLDocHelper.GetHiliteSource(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode; const Default: Boolean): Boolean; - {Gets value of a node of a snippet in an XML document. - @param XMLDoc [in] XML document containing snippet. - @param SnippetNode [in] Snippet node that contains highlight source tag. - @param Default [in] Value to use if node doesn't exist or has non-standard - value. - @return Value of node, or default value. - } -var - Value: string; // text value of HiliteSource node -begin - Value := GetSubTagText(XMLDoc, SnippetNode, cHighlightSource); - if Value <> '' then - Result := Value <> '0' - else - Result := Default; -end; - -class procedure TXMLDocHelper.GetPascalNameList(const XMLDoc: IXMLDocumentEx; - const ListNode: IXMLNode; const NameList: IStringList); - {Gets a list of names in elements with a list. - @param XMLDoc [in] XML document containing name list. - @param ListNode [in] Node that contains list. - @param NameList [in] Receives text of all elements in list. - } -var - NameNode: IXMLNode; // name of a node in the list - NodeList: IXMLSimpleNodeList; // list of matching child nodes if ListNode -begin - NameList.Clear; - if not Assigned(ListNode) then - Exit; // this is permitted since snippet lists can be empty or missing - NodeList := XMLDoc.FindChildNodes(ListNode, cPascalNameNode); - for NameNode in NodeList do - if NameNode.IsTextElement then - NameList.Add(NameNode.Text); -end; - -class function TXMLDocHelper.GetSnippetKind(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode; const Default: TSnippetKind): TSnippetKind; - {Gets value of node of a snippet in an XML document. - @param XMLDoc [in] XML document containing snippet. - @param SnippetNode [in] Snippet node that contains kind tag. - @param Default [in] Value to use if node doesn't exist or has non-standard - value. - @return Required snippet kind. - } -var - Value: string; // text value of Kind node -begin - Value := GetSubTagText(XMLDoc, SnippetNode, cKindNode); - if StrSameText(Value, 'freeform') then - Result := skFreeform - else if StrSameText(Value, 'routine') then - Result := skRoutine - else if StrSameText(Value, 'const') then - Result := skConstant - else if StrSameText(Value, 'type') then - Result := skTypeDef - else if StrSameText(Value, 'unit') then - Result := skUnit - else if StrSameText(Value, 'class') then - Result := skClass - else - Result := Default; -end; - -class function TXMLDocHelper.GetStandardFormat(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode; const Default: Boolean): Boolean; - {Gets value of a node of a snippet in an XML document. - @param XMLDoc [in] XML document containing snippet. - @param SnippetNode [in] Snippet node that contains standard format tag. - @param Default [in] Value to use if node doesn't exist or has non-standard - value. - @return Value of node, or default value. - } -var - Value: string; // text value of Kind node -begin - Value := GetSubTagText(XMLDoc, SnippetNode, cStandardFormatNode); - if Value <> '' then - Result := Value <> '0' - else - Result := Default; -end; - class function TXMLDocHelper.GetSubTagText(const XMLDoc: IXMLDocumentEx; const ParentNode: IXMLNode; const SubTagName: string): string; {Gets text of subtag of a parent node in an XML document. @@ -444,106 +167,10 @@ class procedure TXMLDocHelper.ValidateProcessingInstr( begin // Must have correct processing instruction () XMLNode := FindRootNodeType(XMLDoc, ntProcessingInstr); - if not Assigned(XMLNode) or (XMLNode.NodeName <> cXMLNode) + if not Assigned(XMLNode) or (XMLNode.NodeName <> XMLNodeName) or (XMLNode.NodeType <> ntProcessingInstr) then raise ECodeSnipXML.Create(sNoXMLProcInst); end; -class function TXMLDocHelper.ValidateRootNode(const XMLDoc: IXMLDocumentEx; - const ANodeName, AWatermark: string; const AVersions: TRange): Integer; - {Validates the root node of an XML document. - @param XMLDoc [in] XML document to be validated. - @param ANodeName [in] Name of root mode. - @param AWatermark [in] Required value of root node's "watermark" attribute. - @param AVersions [in] Range of acceptable file version numbers. - @return Document version. - @except ECodeSnipXML raised on error. - } -var - RootNode: IXMLNode; // document root node -resourcestring - // Error messages - sNoRootNode = 'Invalid document: no root element present'; - sBadRootName = 'Invalid document: root element must be named <%s>'; - sBadWatermark = 'Invalid document: watermark is incorrect'; - sBadVersion = 'Invalid document: unsupported document version %d'; -begin - RootNode := XMLDoc.DocumentElement; - // There must be a root node - if not Assigned(RootNode) then - raise ECodeSnipXML.Create(sNoRootNode); - // Correct root node must be present, with valid watermark and version - if RootNode.NodeName <> ANodeName then - raise ECodeSnipXML.CreateFmt(sBadRootName, [ANodeName]); - if RootNode.Attributes[cRootWatermarkAttr] <> AWatermark then - raise ECodeSnipXML.Create(sBadWatermark); - Result := RootNode.Attributes[cRootVersionAttr]; - if not AVersions.Contains(Result) then - raise ECodeSnipXML.CreateFmt(sBadVersion, [Result]); -end; - -class procedure TXMLDocHelper.WriteCompilerResults(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode; const CompRes: TCompileResults); - {Writes compile results for a snippet to XML document. - @param XMLDoc [in] XML document to receive compile results. - @param SnippetNode [in] Node containing snippet that received compile - results. - @param CompRes [in] Array of compiler results. - } -const - // map of compiler results onto character representation store in XML file. - cCompResMap: array[TCompileResult] of Char = ('Y', 'W', 'N', '?'); -var - CompResultsNode: IXMLNode; // node that stores all compiler results - CompResultNode: IXMLNode; // each compiler result node - CompID: TCompilerID; // loops thru all supported compilers -begin - // compiler results value: only write known results - CompResultsNode := XMLDoc.CreateElement(SnippetNode, cCompilerResultsNode); - for CompID := Low(TCompilerID) to High(TCompilerID) do - begin - if CompRes[CompID] <> crQuery then - begin - CompResultNode := XMLDoc.CreateElement( - CompResultsNode, cCompilerResultNode, - cCompResMap[CompRes[CompID]] - ); - CompResultNode.Attributes[cCompilerResultIdAttr] := cCompilerIDs[CompID]; - end; - end; -end; - -class procedure TXMLDocHelper.WritePascalNameList(const XMLDoc: IXMLDocumentEx; - const Parent: IXMLNode; const ListName: string; const Names: IStringList); - {Writes a Pascal name list to an XML document. - @param XMLDoc [in] XML document to which list is written. - @param Parent [in] Parent node that is to contain name list. - @param ListName [in] Name of new list node that is parent of list. - @param Names [in] List of Pascal names. - } -var - ListNode: IXMLNode; // reference to enclosing list node - Name: string; // a name item in list -begin - ListNode := XMLDoc.CreateElement(Parent, ListName); - for Name in Names do - XMLDoc.CreateElement(ListNode, cPascalNameNode, Name); -end; - -class procedure TXMLDocHelper.WriteSnippetKind(const XMLDoc: IXMLDocumentEx; - const SnippetNode: IXMLNode; const Value: TSnippetKind); - {Writes a node to a an XML document. - @param XMLDoc [in] XML document to receive the node. - @param SnippetNode [in] Node containing snippet that receives kind node. - @param Value [in] Value of node. - } -const - cValues: array[TSnippetKind] of string = ( - 'freeform', 'routine', 'const', 'type', 'unit', 'class' - ); -begin - XMLDoc.CreateElement(SnippetNode, cKindNode, cValues[Value]); -end; - end. From 809725db0d4259b2623b381696ec8493fe7e9bf6 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 6 Mar 2025 17:59:21 +0000 Subject: [PATCH 212/222] Rename refactorings in DB.UDatabaseIO Renamed numerous interfaces and classes to make names more closely describe their purpose and to standardise them. Made abstract loader and saver classes explicitly abstract and concrete descendants explicitly sealed. Modified code in DB.UMain that was affected by the renamings. --- Src/DB.UDatabaseIO.pas | 237 ++++++++++++++++++----------------------- Src/DB.UMain.pas | 8 +- 2 files changed, 107 insertions(+), 138 deletions(-) diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.UDatabaseIO.pas index a3b8b9dda..fb42b053f 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.UDatabaseIO.pas @@ -33,7 +33,7 @@ interface /// Interface to objects that can load data into a vault within the /// database from storage in a supported data format. - IDataFormatLoader = interface(IInterface) + IVaultLoader = interface(IInterface) ['{C6AF94FC-F56F-44AE-9E79-3B0CD0BB21D4}'] /// Loads data from storage into a vault within the database. /// @@ -50,7 +50,7 @@ interface /// Interface to objects that can save data from a vault within the /// database into storage in a supported data format. - IDataFormatSaver = interface(IInterface) + IVaultSaver = interface(IInterface) ['{F46EE2E3-68A7-4877-9E04-192D15D29BB1}'] /// Saves data to storage. /// TSnippetList [in] Contains information @@ -86,22 +86,20 @@ interface procedure Save(const Categories: TCategoryList); end; - { - TDatabaseIOFactory: - Factory class that can create instances of writer and loader objects for the - Database object. - } + /// Factory class that can create instances of objects that can be + /// used to load and save vaults and global category information into and + /// from the database. TDatabaseIOFactory = class(TNoConstructObject) public /// Creates and returns an object to be used to load the given /// vault's data in the correct format. Nil is returned if no loader object /// is supported. - class function CreateDBLoader(const AVault: TVault): IDataFormatLoader; + class function CreateVaultLoader(const AVault: TVault): IVaultLoader; /// Creates and returns an object to be used to save the given /// vaults's data in the correct format. Nil is return if no saver object /// is supported. - class function CreateDBSaver(const AVault: TVault): IDataFormatSaver; + class function CreateVaultSaver(const AVault: TVault): IVaultSaver; /// Creates and returns an object to be used to load a list of /// globally stored categories. @@ -113,11 +111,9 @@ TDatabaseIOFactory = class(TNoConstructObject) end; - { - EDatabaseLoader: - Class of exception raised by database loader objects. - } - EDatabaseLoader = class(ECodeSnip); + /// Class of exception raised by TVaultLoader objects. + /// + EVaultLoader = class(ECodeSnip); implementation @@ -145,24 +141,14 @@ implementation type - { - TDatabaseLoaderClass: - Class reference to TDatabaseLoader descendants. - } - TDatabaseLoaderClass = class of TDatabaseLoader; - - {TODO -cRefactoring: Would a better method be to have a single TDatabaseLoader + {TODO -cRefactoring: Would a better method be to have a single TVaultLoader class that is passed a reader object in its constructor, rather than have sub-classes that simply create the required reader object?} - {TODO -cRefactoring: Rename TDatabaseLoader to TFormatLoader or similar} - { - TDatabaseLoader: - Abstract base class for objects that can load data into the Database object - from storage. - } - TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) + /// Abstract base class for objects that can load data from storage + /// into a vault within the database. + TVaultLoader = class abstract (TInterfacedObject, IVaultLoader) strict private fReader: IVaultStorageReader; // Object used to read data from storage fSnipList: TSnippetList; // Receives list of snippets @@ -197,8 +183,7 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) @return Reference to required snippet object or nil if snippet is not found. } - function IsNativeSnippet(const Snippet: TSnippet): Boolean; - virtual; + function IsNativeSnippet(const Snippet: TSnippet): Boolean; virtual; {Checks if a snippet is native (belongs) to the database being read. @param Snippet [in] Snippet to test. @return True if snippet is native, False if not. @@ -210,8 +195,7 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) procedure LoadCategories; {Loads all categories from storage. } - procedure CreateCategory(const CatID: string; - const CatData: TCategoryData); + procedure CreateCategory(const CatID: string; const CatData: TCategoryData); {Creates a new category and adds it to the categories list. @param CatID [in] ID of category. @param CatData [in] Properties of category. @@ -222,7 +206,7 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) property Vault: TVault read fVault; public constructor Create(const AVault: TVault); - { IDataFormatLoader method } + { IVaultLoader method } procedure Load(const SnipList: TSnippetList; const Categories: TCategoryList; const DBDataItemFactory: IDBDataItemFactory); @@ -236,11 +220,9 @@ TDatabaseLoader = class(TInterfacedObject, IDataFormatLoader) } end; - { - TDCSCV2FormatLoader: - Class that updates Database object with data read from main database. - } - TDCSCV2FormatLoader = class(TDatabaseLoader, IDataFormatLoader) + /// Class that loads data into the database from a vault stored in + /// DelphiDabbler Code Snippets Collection v2 data format. + TDCSCV2VaultLoader = class sealed (TVaultLoader, IVaultLoader) strict protected function CreateReader: IVaultStorageReader; override; {Creates reader object. If main database doesn't exist a nul reader is @@ -253,11 +235,9 @@ TDCSCV2FormatLoader = class(TDatabaseLoader, IDataFormatLoader) } end; - { - TNativeV4FormatLoader: - Class that updates Database object with data read from user database. - } - TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) + /// Class that loads data into the database from a vault stored in + /// CodeSnip 4 user data format. + TCS4VaultLoader = class sealed (TVaultLoader, IVaultLoader) strict protected function CreateReader: IVaultStorageReader; override; {Creates reader object. If user database doesn't exist a nul reader is @@ -270,7 +250,9 @@ TNativeV4FormatLoader = class(TDatabaseLoader, IDataFormatLoader) } end; - TNativeVaultFormatLoader = class(TDatabaseLoader, IDataFormatLoader) + /// Class that loads data into the database from a vault stored in + /// the native CodeSnip Vault data format. + TNativeVaultLoader = class sealed (TVaultLoader, IVaultLoader) strict protected function CreateReader: IVaultStorageReader; override; {Creates reader object. If user database doesn't exist a nul reader is @@ -283,16 +265,17 @@ TNativeVaultFormatLoader = class(TDatabaseLoader, IDataFormatLoader) } end; - {TODO -cRefactoring: Would a better method be to have a single TFormatSaver + {TODO -cRefactoring: Would a better method be to have a single TVaultSaver class that is passed a writer object in its constructor, rather than have sub-classes that simply create the required writer object? Would need to make sure all .Save methods in sub-classes are identical first. } - /// Base for classes that save a vault to storage. - TFormatSaver = class abstract (TInterfacedObject, - IDataFormatSaver + /// Abstract base class for objects that can save data to storage + /// from a vault within the database. + TVaultSaver = class abstract (TInterfacedObject, + IVaultSaver ) strict private var @@ -323,8 +306,7 @@ TFormatSaver = class abstract (TInterfacedObject, /// IDBDataProvider [in] Object used to /// obtain details of the data to be stored. procedure DoSave(const SnipList: TSnippetList; - const Categories: TCategoryList; - const Provider: IDBDataProvider + const Categories: TCategoryList; const Provider: IDBDataProvider ); /// Creates an object that can write data to storage in the @@ -346,39 +328,32 @@ TFormatSaver = class abstract (TInterfacedObject, /// categories in the database. /// IDBDataProvider [in] Object used to /// obtain details of the data to be stored. - /// Method of IDataFormatSaver. + /// Method of IVaultSaver. procedure Save(const SnipList: TSnippetList; - const Categories: TCategoryList; - const Provider: IDBDataProvider); virtual; abstract; + const Categories: TCategoryList; const Provider: IDBDataProvider); + virtual; abstract; end; - /// Class used to write data from a vault to storage in the + /// Class used to write data from a vault to storage using the /// DelphiDabbler Code Snippets v2 data format. - TDCSCV2FormatSaver = class(TFormatSaver, - IDataFormatSaver + TDCSCV2VaultSaver = class sealed (TVaultSaver, + IVaultSaver ) strict private var fBakFile: string; // Backup file used in case of failure - /// Backup current data. procedure Backup; - /// Restore current data. procedure Restore; - strict protected - /// Creates an object that can write data to storage in /// DelphiDabbler Code Snippets v2 data format. /// IVaultStorageWriter. Required writer object. function CreateWriter: IVaultStorageWriter; override; - public - /// Creates object that can save the given vault. constructor Create(const AVault: TVault); - /// Saves data to storage. /// TSnippetList [in] List of all snippets /// in the database. @@ -386,26 +361,23 @@ TDCSCV2FormatSaver = class(TFormatSaver, /// categories in the database. /// IDBDataProvider [in] Object used to /// obtain details of the data to be stored. - /// Method of IDataFormatSaver. + /// Method of IVaultSaver. procedure Save(const SnipList: TSnippetList; - const Categories: TCategoryList; - const Provider: IDBDataProvider); override; + const Categories: TCategoryList; const Provider: IDBDataProvider); + override; end; - /// Class used to write data from a vault to storage in CodeSnip's - /// native v4 data format. - TNativeV4FormatSaver = class(TFormatSaver, - IDataFormatSaver + /// Class used to write data from a vault to storage using the + /// CodeSnip 4 user data format. + TCS4VaultSaver = class sealed (TVaultSaver, + IVaultSaver ) strict protected - /// Creates an object that can write data to storage in /// CodeSnip's native v4 data format. /// IVaultStorageWriter. Required writer object. function CreateWriter: IVaultStorageWriter; override; - public - /// Saves data to storage. /// TSnippetList [in] List of all snippets /// in the database. @@ -413,24 +385,23 @@ TNativeV4FormatSaver = class(TFormatSaver, /// categories in the database. /// IDBDataProvider [in] Object used to /// obtain details of the data to be stored. - /// Method of IDataFormatSaver. + /// Method of IVaultSaver. procedure Save(const SnipList: TSnippetList; - const Categories: TCategoryList; - const Provider: IDBDataProvider); override; + const Categories: TCategoryList; const Provider: IDBDataProvider); + override; end; - TNativeVaultFormatSaver = class(TFormatSaver, - IDataFormatSaver + /// Class that saves data from a vault within the database to + /// storage using the native CodeSnip Vault data format. + TNativeVaultSaver = class sealed (TVaultSaver, + IVaultSaver ) strict protected - /// Creates an object that can write data to storage in /// CodeSnip's native v4 data format. /// IVaultStorageWriter. Required writer object. function CreateWriter: IVaultStorageWriter; override; - public - /// Saves data to storage. /// TSnippetList [in] List of all snippets /// in the database. @@ -438,10 +409,10 @@ TNativeVaultFormatSaver = class(TFormatSaver, /// categories in the database. /// IDBDataProvider [in] Object used to /// obtain details of the data to be stored. - /// Method of IDataFormatSaver. + /// Method of IVaultSaver. procedure Save(const SnipList: TSnippetList; - const Categories: TCategoryList; - const Provider: IDBDataProvider); override; + const Categories: TCategoryList; const Provider: IDBDataProvider); + override; end; /// Class used to save global category information, regardless of @@ -471,33 +442,31 @@ TGlobalCategorySaver = class(TInterfacedObject, IGlobalCategorySaver) { TDatabaseIOFactory } -class function TDatabaseIOFactory.CreateDBLoader(const AVault: TVault): - IDataFormatLoader; +class function TDatabaseIOFactory.CreateVaultLoader(const AVault: TVault): + IVaultLoader; begin - {TODO -cUDatabaseIO: Revise database loaders to get file path and other - info from vault instead of hard wiring it.} case AVault.Storage.Format of TDataFormatKind.DCSC_v2: - Result := TDCSCV2FormatLoader.Create(AVault); + Result := TDCSCV2VaultLoader.Create(AVault); TDataFormatKind.Native_v4: - Result := TNativeV4FormatLoader.Create(AVault); + Result := TCS4VaultLoader.Create(AVault); TDataFormatKind.Native_Vault: - Result := TNativeVaultFormatLoader.Create(AVault); + Result := TNativeVaultLoader.Create(AVault); else Result := nil; end; end; -class function TDatabaseIOFactory.CreateDBSaver(const AVault: TVault): - IDataFormatSaver; +class function TDatabaseIOFactory.CreateVaultSaver(const AVault: TVault): + IVaultSaver; begin case AVault.Storage.Format of TDataFormatKind.DCSC_v2: - Result := TDCSCV2FormatSaver.Create(AVault); + Result := TDCSCV2VaultSaver.Create(AVault); TDataFormatKind.Native_v4: - Result := TNativeV4FormatSaver.Create(AVault); + Result := TCS4VaultSaver.Create(AVault); TDataFormatKind.Native_Vault: - Result := TNativeVaultFormatSaver.Create(AVault); + Result := TNativeVaultSaver.Create(AVault); else Result := nil; end; @@ -515,15 +484,15 @@ class function TDatabaseIOFactory.CreateGlobalCategorySaver: Result := TGlobalCategorySaver.Create; end; -{ TDatabaseLoader } +{ TVaultLoader } -constructor TDatabaseLoader.Create(const AVault: TVault); +constructor TVaultLoader.Create(const AVault: TVault); begin inherited Create; fVault := AVault; end; -procedure TDatabaseLoader.CreateCategory(const CatID: string; +procedure TVaultLoader.CreateCategory(const CatID: string; const CatData: TCategoryData); {Creates a new category and adds it to the categories list. @param CatID [in] ID of category. @@ -533,13 +502,13 @@ procedure TDatabaseLoader.CreateCategory(const CatID: string; fCategories.Add(fFactory.CreateCategory(CatID, CatData)); end; -function TDatabaseLoader.FindSnippet(const SnippetKey: string; +function TVaultLoader.FindSnippet(const SnippetKey: string; const SnipList: TSnippetList): TSnippet; begin Result := SnipList.Find(SnippetKey, Vault.UID); end; -procedure TDatabaseLoader.HandleException(const E: Exception); +procedure TVaultLoader.HandleException(const E: Exception); {Handles exceptions generated by loader and converts ECodeSnip and descendant exceptions into EDatabaseLoader exceptions. @param E [in] Exception to be handled. @@ -548,17 +517,17 @@ procedure TDatabaseLoader.HandleException(const E: Exception); begin if E is ECodeSnip then // add message header identifying database to existing message - raise EDatabaseLoader.Create(ErrorMessageHeading + EOL2 + E.Message) + raise EVaultLoader.Create(ErrorMessageHeading + EOL2 + E.Message) else raise E; end; -function TDatabaseLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; +function TVaultLoader.IsNativeSnippet(const Snippet: TSnippet): Boolean; begin Result := Snippet.VaultID = Vault.UID; end; -procedure TDatabaseLoader.Load(const SnipList: TSnippetList; +procedure TVaultLoader.Load(const SnipList: TSnippetList; const Categories: TCategoryList; const DBDataItemFactory: IDBDataItemFactory); {Loads data from storage and updates database object. @param SnipList [in] Receives information about each snippet in the @@ -600,7 +569,7 @@ procedure TDatabaseLoader.Load(const SnipList: TSnippetList; end; end; -procedure TDatabaseLoader.LoadCategories; +procedure TVaultLoader.LoadCategories; {Loads all categories from storage } var @@ -624,7 +593,7 @@ procedure TDatabaseLoader.LoadCategories; end; end; -procedure TDatabaseLoader.LoadReferences(const Snippet: TSnippet); +procedure TVaultLoader.LoadReferences(const Snippet: TSnippet); {Loads all of a snippet's references. @param Snippet [in] Snippet for which references are required. } @@ -659,7 +628,7 @@ procedure TDatabaseLoader.LoadReferences(const Snippet: TSnippet); fReader.GetSnippetUnits(Snippet.Key).CopyTo(Snippet.Units); end; -procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); +procedure TVaultLoader.LoadSnippets(const Cat: TCategory); {Loads all snippets in a category. @param Cat [in] Category to be loaded. } @@ -691,9 +660,9 @@ procedure TDatabaseLoader.LoadSnippets(const Cat: TCategory); end; end; -{ TDCSCV2FormatLoader } +{ TDCSCV2VaultLoader } -function TDCSCV2FormatLoader.CreateReader: IVaultStorageReader; +function TDCSCV2VaultLoader.CreateReader: IVaultStorageReader; {Creates reader object. If main database doesn't exist a nul reader is created. @return Reader object instance. @@ -704,7 +673,7 @@ function TDCSCV2FormatLoader.CreateReader: IVaultStorageReader; Result := TNullVaultStorageReader.Create; end; -function TDCSCV2FormatLoader.ErrorMessageHeading: string; +function TDCSCV2VaultLoader.ErrorMessageHeading: string; {Returns heading to use in error messages. Identifies main database. @return Required heading. } @@ -714,9 +683,9 @@ function TDCSCV2FormatLoader.ErrorMessageHeading: string; Result := sError; end; -{ TNativeV4FormatLoader } +{ TCS4VaultLoader } -function TNativeV4FormatLoader.CreateReader: IVaultStorageReader; +function TCS4VaultLoader.CreateReader: IVaultStorageReader; {Creates reader object. If user database doesn't exist a nul reader is created. @return Reader object instance. @@ -727,7 +696,7 @@ function TNativeV4FormatLoader.CreateReader: IVaultStorageReader; Result := TNullVaultStorageReader.Create; end; -function TNativeV4FormatLoader.ErrorMessageHeading: string; +function TCS4VaultLoader.ErrorMessageHeading: string; {Returns heading to use in error messages. Identifies main database. @return Required heading. } @@ -737,16 +706,16 @@ function TNativeV4FormatLoader.ErrorMessageHeading: string; Result := sError; end; -{ TNativeVaultFormatLoader } +{ TNativeVaultLoader } -function TNativeVaultFormatLoader.CreateReader: IVaultStorageReader; +function TNativeVaultLoader.CreateReader: IVaultStorageReader; begin Result := TNativeVaultStorageReader.Create(Vault.Storage.Directory); if not Result.DatabaseExists then Result := TNullVaultStorageReader.Create; end; -function TNativeVaultFormatLoader.ErrorMessageHeading: string; +function TNativeVaultLoader.ErrorMessageHeading: string; resourcestring sError = 'Error loading the vault %0:s using the %1:s data format:'; begin @@ -756,15 +725,15 @@ function TNativeVaultFormatLoader.ErrorMessageHeading: string; ); end; -{ TFormatSaver } +{ TVaultSaver } -constructor TFormatSaver.Create(const AVault: TVault); +constructor TVaultSaver.Create(const AVault: TVault); begin inherited Create; fVault := AVault; end; -procedure TFormatSaver.DoSave(const SnipList: TSnippetList; +procedure TVaultSaver.DoSave(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); begin fSnipList := SnipList; @@ -778,7 +747,7 @@ procedure TFormatSaver.DoSave(const SnipList: TSnippetList; fWriter.Finalise; end; -procedure TFormatSaver.WriteCategories; +procedure TVaultSaver.WriteCategories; var Cat: TCategory; // loops through each category Props: TCategoryData; // category properties @@ -797,12 +766,12 @@ procedure TFormatSaver.WriteCategories; end; end; -procedure TFormatSaver.WriteMetaData; +procedure TVaultSaver.WriteMetaData; begin fWriter.WriteMetaData(Vault.MetaData); end; -procedure TFormatSaver.WriteSnippets; +procedure TVaultSaver.WriteSnippets; // Adds snippet keys from IDList to a string list function IDListToStrings(const IDList: ISnippetIDList): IStringList; @@ -835,9 +804,9 @@ procedure TFormatSaver.WriteSnippets; end; end; -{ TDCSCV2FormatSaver } +{ TDCSCV2VaultSaver } -procedure TDCSCV2FormatSaver.Backup; +procedure TDCSCV2VaultSaver.Backup; var FB: TVaultBackup; begin @@ -849,7 +818,7 @@ procedure TDCSCV2FormatSaver.Backup; end; end; -constructor TDCSCV2FormatSaver.Create(const AVault: TVault); +constructor TDCSCV2VaultSaver.Create(const AVault: TVault); begin inherited Create(AVault); // Find a temp file name in system temp directory that doesn't yet exist @@ -860,12 +829,12 @@ constructor TDCSCV2FormatSaver.Create(const AVault: TVault); until not TFile.Exists(fBakFile); end; -function TDCSCV2FormatSaver.CreateWriter: IVaultStorageWriter; +function TDCSCV2VaultSaver.CreateWriter: IVaultStorageWriter; begin Result := TDCSCV2VaultStorageWriter.Create(Vault.Storage.Directory); end; -procedure TDCSCV2FormatSaver.Restore; +procedure TDCSCV2VaultSaver.Restore; var FB: TVaultBackup; begin @@ -877,7 +846,7 @@ procedure TDCSCV2FormatSaver.Restore; end; end; -procedure TDCSCV2FormatSaver.Save(const SnipList: TSnippetList; +procedure TDCSCV2VaultSaver.Save(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); begin Backup; @@ -893,28 +862,28 @@ procedure TDCSCV2FormatSaver.Save(const SnipList: TSnippetList; end; end; -{ TNativeV4FormatSaver } +{ TCS4VaultSaver } -function TNativeV4FormatSaver.CreateWriter: IVaultStorageWriter; +function TCS4VaultSaver.CreateWriter: IVaultStorageWriter; begin Result := TCS4VaultStorageWriter.Create(Vault.Storage.Directory); end; -procedure TNativeV4FormatSaver.Save(const SnipList: TSnippetList; +procedure TCS4VaultSaver.Save(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); begin {TODO -cVault: Backup and restore this vault per the DCSC v2 loader} DoSave(SnipList, Categories, Provider); end; -{ TNativeVaultFormatSaver } +{ TNativeVaultSaver } -function TNativeVaultFormatSaver.CreateWriter: IVaultStorageWriter; +function TNativeVaultSaver.CreateWriter: IVaultStorageWriter; begin Result := TNativeVaultStorageWriter.Create(Vault.Storage.Directory); end; -procedure TNativeVaultFormatSaver.Save(const SnipList: TSnippetList; +procedure TNativeVaultSaver.Save(const SnipList: TSnippetList; const Categories: TCategoryList; const Provider: IDBDataProvider); begin DoSave(SnipList, Categories, Provider); diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index e8cd8ab9d..01883904e 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -1063,7 +1063,7 @@ procedure TDatabase.Load; } var DataItemFactory: IDBDataItemFactory; - VaultLoader: IDataFormatLoader; + VaultLoader: IVaultLoader; Vault: TVault; CatLoader: IGlobalCategoryLoader; begin @@ -1077,7 +1077,7 @@ procedure TDatabase.Load; // Load all vaults for Vault in TVaults.Instance do begin - VaultLoader := TDatabaseIOFactory.CreateDBLoader(Vault); + VaultLoader := TDatabaseIOFactory.CreateVaultLoader(Vault); if Assigned(VaultLoader) then VaultLoader.Load(fSnippets, fCategories, DataItemFactory); end; @@ -1109,7 +1109,7 @@ procedure TDatabase.Save; } var Provider: IDBDataProvider; - VaultSaver: IDataFormatSaver; + VaultSaver: IVaultSaver; Vault: TVault; CatSaver: IGlobalCategorySaver; begin @@ -1122,7 +1122,7 @@ procedure TDatabase.Save; Provider := TVaultDataProvider.Create( Vault.UID, fSnippets, fCategories ); - VaultSaver := TDatabaseIOFactory.CreateDBSaver(Vault); + VaultSaver := TDatabaseIOFactory.CreateVaultSaver(Vault); if Assigned(VaultSaver) then VaultSaver.Save(fSnippets, fCategories, Provider); end; From e96a03dc3736161be299bc15d771beef7900af7c Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 6 Mar 2025 18:05:35 +0000 Subject: [PATCH 213/222] Rename DB.UDatabaseIO unit as DB.IO.Manager Updated DB.UMain uses clause re the change. --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/{DB.UDatabaseIO.pas => DB.IO.Manager.pas} | 9 +++------ Src/DB.UMain.pas | 2 +- 4 files changed, 6 insertions(+), 9 deletions(-) rename Src/{DB.UDatabaseIO.pas => DB.IO.Manager.pas} (99%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 2600e25ac..e9246266c 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -64,7 +64,7 @@ uses Compilers.URunner in 'Compilers.URunner.pas', Compilers.USearchDirs in 'Compilers.USearchDirs.pas', DB.UCategory in 'DB.UCategory.pas', - DB.UDatabaseIO in 'DB.UDatabaseIO.pas', + DB.IO.Manager in 'DB.IO.Manager.pas', DB.UMain in 'DB.UMain.pas', DB.USnippet in 'DB.USnippet.pas', DB.USnippetKind in 'DB.USnippetKind.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 4b0d4b04b..cbf5e8e51 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -67,7 +67,7 @@ - + diff --git a/Src/DB.UDatabaseIO.pas b/Src/DB.IO.Manager.pas similarity index 99% rename from Src/DB.UDatabaseIO.pas rename to Src/DB.IO.Manager.pas index fb42b053f..b9c9aaac1 100644 --- a/Src/DB.UDatabaseIO.pas +++ b/Src/DB.IO.Manager.pas @@ -5,15 +5,12 @@ * * Copyright (C) 2008-2021, Peter Johnson (gravatar.com/delphidabbler). * - * Implements objects that can load data into the Database object from both the - * user and main databases. Also provides a class that can write the user - * database to storage. - * - * Uses file I/O interface implementations to read / write the physical files. + * Manages loading and saving the entire database using the various supported + * data formats. } -unit DB.UDatabaseIO; +unit DB.IO.Manager; interface diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 01883904e..a4a001dfc 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -320,7 +320,7 @@ implementation SysUtils, Generics.Defaults, // Project - DB.UDatabaseIO, + DB.IO.Manager, DB.IO.Categories, IntfCommon, UExceptions, From f780c487c157cb48a417af14536becee0bf7d921 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 6 Mar 2025 20:17:51 +0000 Subject: [PATCH 214/222] Collapse TSnippet class heirachy Deleted TTempSnippet class which was a descendant of TSnippetEx that added no methods, fields or properties. Merged TSnippetEx methods down into TSnippet the deleted TSnippetEx. Updated calling code by substituting TSnippet for TSnippetEx and TTempSnippet references. --- Src/DB.UMain.pas | 35 +++---- Src/DB.USnippet.pas | 231 +++++++++++++++++++------------------------- 2 files changed, 113 insertions(+), 153 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index a4a001dfc..f62d53108 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -771,21 +771,18 @@ function TDatabase.CreateTempSnippet(const Snippet: TSnippet): TSnippet; Data: TSnippetEditData; // data describing snippet's properties and references begin Assert(Assigned(Snippet), ClassName + '.CreateTempSnippet: Snippet is nil'); - Assert(Snippet is TSnippetEx, - ClassName + '.CreateTempSnippet: Snippet is a TSnippetEx'); - Data := (Snippet as TSnippetEx).GetEditData; - Result := TTempSnippet.Create( - Snippet.Key, Snippet.VaultID, (Snippet as TSnippetEx).GetProps); - (Result as TTempSnippet).UpdateRefs( - (Snippet as TSnippetEx).GetReferences, fSnippets - ); +// Assert(Snippet is TSnippetEx, +// ClassName + '.CreateTempSnippet: Snippet is a TSnippetEx'); + Data := Snippet.GetEditData; + Result := TSnippet.Create(Snippet.Key, Snippet.VaultID, Snippet.GetProps); + Result.UpdateRefs(Snippet.GetReferences, fSnippets); end; function TDatabase.CreateTempSnippet(const AKey: string; const AVaultID: TVaultID; const AData: TSnippetEditData): TSnippet; begin - Result := TTempSnippet.Create(AKey, AVaultID, AData.Props); - (Result as TTempSnippet).UpdateRefs(AData.Refs, fSnippets); + Result := TSnippet.Create(AKey, AVaultID, AData.Props); + Result.UpdateRefs(AData.Refs, fSnippets); end; procedure TDatabase.DeleteCategory(const Category: TCategory); @@ -866,7 +863,7 @@ function TDatabase.DuplicateSnippet(const ASnippet: TSnippet; begin {TODO -cVault: Update edit data before calling this method and replace and ANewDisplayName and ACatID with a single AData parameter.} - Data := (ASnippet as TSnippetEx).GetEditData; + Data := ASnippet.GetEditData; Data.Props.Cat := ACatID; Data.Props.DisplayName := ANewDisplayName; Result := AddSnippet(ANewKey, ANewVaultID, Data); @@ -926,8 +923,8 @@ function TDatabase.GetEditableCategoryInfo( Result.Init; end; -function TDatabase.GetEditableSnippetInfo( - const Snippet: TSnippet): TSnippetEditData; +function TDatabase.GetEditableSnippetInfo(const Snippet: TSnippet): + TSnippetEditData; {Provides details of all a snippet's data (properties and references) that may be edited. @param Snippet [in] Snippet for which data is required. May be nil in which @@ -936,7 +933,7 @@ function TDatabase.GetEditableSnippetInfo( } begin if Assigned(Snippet) then - Result := (Snippet as TSnippetEx).GetEditData + Result := Snippet.GetEditData else Result.Init; end; @@ -1026,8 +1023,8 @@ function TDatabase.InternalAddSnippet(const AKey: string; sCatNotFound = 'Category "%0:s" referenced by new snippet with key "%1:s" ' + 'does not exist'; begin - Result := TSnippetEx.Create(AKey, AVaultID, AData.Props); - (Result as TSnippetEx).UpdateRefs(AData.Refs, fSnippets); + Result := TSnippet.Create(AKey, AVaultID, AData.Props); + Result.UpdateRefs(AData.Refs, fSnippets); Cat := fCategories.Find(Result.Category); if not Assigned(Cat) then raise ECodeSnip.CreateFmt(sCatNotFound, [Result.Category, Result.Key]); @@ -1285,7 +1282,7 @@ function TDBDataItemFactory.CreateCategory(const CatID: string; function TDBDataItemFactory.CreateSnippet(const Key: string; const AVaultID: TVaultID; const Props: TSnippetData): TSnippet; begin - Result := TSnippetEx.Create(Key, AVaultID, Props); + Result := TSnippet.Create(Key, AVaultID, Props); end; { TVaultDataProvider } @@ -1319,13 +1316,13 @@ function TVaultDataProvider.GetCategorySnippets( function TVaultDataProvider.GetSnippetProps( const Snippet: TSnippet): TSnippetData; begin - Result := (Snippet as TSnippetEx).GetProps; + Result := Snippet.GetProps; end; function TVaultDataProvider.GetSnippetRefs( const Snippet: TSnippet): TSnippetReferences; begin - Result := (Snippet as TSnippetEx).GetReferences; + Result := Snippet.GetReferences; end; diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 83d651791..ec0c56e6d 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -150,7 +150,7 @@ TDisplayNameComparer = class(TComparer) {Gets snippet's display name, or name if no display name is set @return Required display name. } - strict protected + strict private procedure SetKey(const AKey: string); {Sets Key property. @param AKey [in] New key. @@ -197,8 +197,43 @@ TDisplayNameComparer = class(TComparer) {Checks if snippet can be compiled. @return True if compilation supported and False if not. } + /// Returns the snippets hash code. function Hash: Integer; + + /// Updates the snippet's properties and references. + /// TSnippetEditData [in] Snippet's new property + /// values and references. + /// TSnippetList [in] List of all snippets + /// in the database (for use in validation the new snippet references). + /// + procedure Update(const Data: TSnippetEditData; + const AllSnippets: TSnippetList); + + /// Updates the snippet's references. + /// TSnippetReferences [in] Records all the snippet's + /// references (i.e. XRef, Depends and Units). + /// TSnippetList [in] List of all snippets + /// in the database (used to ensure all references to other snippets are + /// valid). + procedure UpdateRefs(const Refs: TSnippetReferences; + const AllSnippets: TSnippetList); + + /// Get all of a snippet's editable data. + /// TSnippetEditData. The snippet's editable properties and + /// references. + function GetEditData: TSnippetEditData; + + /// Gets all of a snippet's editable properties. + /// TSnippetData. Record containing the required property + /// values. + function GetProps: TSnippetData; + + /// Gets all of a snippet's editable references. + /// TSnippetReferences. Record containing the required + /// references. + function GetReferences: TSnippetReferences; + property Kind: TSnippetKind read fKind; {Kind of snippet represented by this object} property ID: TSnippetID read GetID; @@ -231,48 +266,6 @@ TDisplayNameComparer = class(TComparer) property VaultID: TVaultID read fVaultID; end; - { - TSnippetEx: - Extension of TSnippet for use internally by Snippets object. - } - TSnippetEx = class(TSnippet) - public - procedure UpdateRefs(const Refs: TSnippetReferences; - const AllSnippets: TSnippetList); - {Updates a snippet's references. - @param Refs [in] Stores all snippet's references (XRef, Depends and - Units). - @param AllSnippets [in] List of all snippets in database. - } - procedure Update(const Data: TSnippetEditData; - const AllSnippets: TSnippetList); - {Updates snippet's properties and references. - @param Data [in] New property values and references. - @param AllSnippets [in] List of all snippets in database. - } - function GetEditData: TSnippetEditData; - {Gets details of all editable data of snippet. - @return Required editable properties and references. - } - function GetProps: TSnippetData; - {Gets details of snippet's properties. - @return Record containing property values. - } - function GetReferences: TSnippetReferences; - {Gets details of snippet's references. - @return Information sufficient to define references. - } - end; - - { - TTempSnippet: - Special subclass of TSnippetEx that can't be added to the Snippets object. - Class does nothing, simply provides a class name for testing when a snippet - is added to a TSnippetListEx. TTempSnippet can be added to a normal snippet - list. - } - TTempSnippet = class(TSnippetEx); - { TSnippetList: Class that implements a list of TSnippet objects. @@ -393,7 +386,7 @@ TSnippetList = class(TObject) TSnippetListEx = class(TSnippetList) public function Add(const Snippet: TSnippet): Integer; override; - {Adds a snippet to list. Snippet must not be TTempSnippet class. + {Adds a snippet to list. @param Snippet [in] Snippet to be added. @return Index where snippet was added to list. } @@ -445,8 +438,6 @@ function TSnippet.CompareTo(const Snippet: TSnippet): Integer; constructor TSnippet.Create(const AKey: string; const AVaultID: TVaultID; const Props: TSnippetData); begin - Assert(ClassType <> TSnippet, - ClassName + '.Create: must only be called from descendants.'); Assert(not AVaultID.IsNull, ClassName + '.Create: AVaultID is null'); inherited Create; @@ -487,6 +478,12 @@ function TSnippet.GetDisplayNameValue: string; Result := fDisplayName; end; +function TSnippet.GetEditData: TSnippetEditData; +begin + Result.Props := GetProps; + Result.Refs := GetReferences; +end; + function TSnippet.GetID: TSnippetID; {Gets snippet's unique ID. @return Required ID. @@ -495,6 +492,26 @@ function TSnippet.GetID: TSnippetID; Result := TSnippetID.Create(fKey, fVaultID); end; +function TSnippet.GetProps: TSnippetData; +begin + Result.Cat := Category; + Result.Kind := Kind; + Result.Desc := Description; + Result.SourceCode := SourceCode; + Result.HiliteSource := HiliteSource; + Result.DisplayName := GetDisplayNameValue; + Result.Extra := TActiveTextFactory.CloneActiveText(Extra); + Result.CompilerResults := Compatibility; + Result.TestInfo := TestInfo; +end; + +function TSnippet.GetReferences: TSnippetReferences; +begin + Result.Units := TIStringList.Create(Units); + Result.Depends := TSnippetIDListEx.Create(Depends); + Result.XRef := TSnippetIDListEx.Create(XRef); +end; + function TSnippet.Hash: Integer; begin // Snippet's hash code is the same as the snippet ID's hash code @@ -528,99 +545,21 @@ procedure TSnippet.SetProps(const Data: TSnippetData); fTestInfo := Data.TestInfo; end; -{ TSnippet.TComparer } - -function TSnippet.TComparer.Compare(const Left, Right: TSnippet): Integer; -begin - Result := Left.CompareTo(Right); -end; - -function TSnippet.TComparer.Equals(const Left, Right: TSnippet): Boolean; -begin - Result := Left.IsEqual(Right); -end; - -function TSnippet.TComparer.GetHashCode(const Value: TSnippet): Integer; -begin - Result := Value.Hash; -end; - -{ TSnippet.TDisplayNameComparer } - -function TSnippet.TDisplayNameComparer.Compare(const Left, - Right: TSnippet): Integer; -begin - Result := StrCompareText(Left.DisplayName, Right.DisplayName); - if Result = 0 then - Result := Left.ID.CompareTo(Right.ID); -end; - -{ TSnippetEx } - -function TSnippetEx.GetEditData: TSnippetEditData; - {Gets details of all editable data of snippet. - @return Required editable properties and references. - } -begin - Result.Props := GetProps; - Result.Refs := GetReferences; -end; - -function TSnippetEx.GetProps: TSnippetData; - {Gets details of snippet's properties. - @return Record containing property values. - } -begin - Result.Cat := Category; - Result.Kind := Kind; - Result.Desc := Description; - Result.SourceCode := SourceCode; - Result.HiliteSource := HiliteSource; - Result.DisplayName := GetDisplayNameValue; - Result.Extra := TActiveTextFactory.CloneActiveText(Extra); - Result.CompilerResults := Compatibility; - Result.TestInfo := TestInfo; -end; - -function TSnippetEx.GetReferences: TSnippetReferences; - {Gets details of snippet's references. - @return Information sufficient to define references. - } -begin - Result.Units := TIStringList.Create(Units); - Result.Depends := TSnippetIDListEx.Create(Depends); - Result.XRef := TSnippetIDListEx.Create(XRef); -end; - -procedure TSnippetEx.Update(const Data: TSnippetEditData; +procedure TSnippet.Update(const Data: TSnippetEditData; const AllSnippets: TSnippetList); - {Updates snippet's properties and references. - @param Data [in] New property values and references. - @param AllSnippets [in] List of all snippets in database. - } begin SetProps(Data.Props); UpdateRefs(Data.Refs, AllSnippets); end; -procedure TSnippetEx.UpdateRefs(const Refs: TSnippetReferences; +procedure TSnippet.UpdateRefs(const Refs: TSnippetReferences; const AllSnippets: TSnippetList); - {Updates a snippet's references. - @param Refs [in] Stores all snippet's references (XRef, Depends and - Units). - @param AllSnippets [in] List of all snippets in database. - } - // --------------------------------------------------------------------------- + // Builds a list of snippets, SL, corresponding to the snippets IDs in IDList. + // Any snippet IDs for which there is no match snippet in the database is + // ignored. procedure BuildSnippetList(const SL: TSnippetList; const IDList: ISnippetIDList); - {Creates a snippets list from a snippets ID list. Looks up snippets in list - of all snippets in database. Any snippets in ID list that do not exist in - database are ignored. - @param SL [in] Snippets list object to be updated. - @param IDList [in] Snippets ID list that provides information used to - create snippets list. - } var ID: TSnippetID; // refers to each ID in ID list Snippet: TSnippet; // references each snippet identified by ID @@ -633,7 +572,6 @@ procedure TSnippetEx.UpdateRefs(const Refs: TSnippetReferences; SL.Add(Snippet); end; end; - // --------------------------------------------------------------------------- begin Refs.Units.CopyTo(Self.Units, True); // copy units @@ -641,6 +579,33 @@ procedure TSnippetEx.UpdateRefs(const Refs: TSnippetReferences; BuildSnippetList(Self.XRef, Refs.XRef); // build XRef list end; +{ TSnippet.TComparer } + +function TSnippet.TComparer.Compare(const Left, Right: TSnippet): Integer; +begin + Result := Left.CompareTo(Right); +end; + +function TSnippet.TComparer.Equals(const Left, Right: TSnippet): Boolean; +begin + Result := Left.IsEqual(Right); +end; + +function TSnippet.TComparer.GetHashCode(const Value: TSnippet): Integer; +begin + Result := Value.Hash; +end; + +{ TSnippet.TDisplayNameComparer } + +function TSnippet.TDisplayNameComparer.Compare(const Left, + Right: TSnippet): Integer; +begin + Result := StrCompareText(Left.DisplayName, Right.DisplayName); + if Result = 0 then + Result := Left.ID.CompareTo(Right.ID); +end; + { TSnippetList } function TSnippetList.Add(const Snippet: TSnippet): Integer; @@ -753,7 +718,7 @@ function TSnippetList.Find(const SnippetKey: string; const AVaultID: TVaultID; // We need a temporary snippet object in order to perform binary search using // object list's built in search NullData.Init; - TempSnippet := TTempSnippet.Create(SnippetKey, AVaultID, NullData); + TempSnippet := TSnippet.Create(SnippetKey, AVaultID, NullData); try Result := fList.Find(TempSnippet, Index); finally @@ -839,13 +804,11 @@ function TSnippetList.IsEqual(const AList: TSnippetList): Boolean; { TSnippetListEx } function TSnippetListEx.Add(const Snippet: TSnippet): Integer; - {Adds a snippet to list. Snippet must not be TTempSnippet class. + {Adds a snippet to list. @param Snippet [in] Snippet to be added. @return Index where snippet was added to list. } begin - Assert(not(Snippet is TTempSnippet), - ClassName + '.Add: Can''t add temporary snippets to database'); Result := inherited Add(Snippet); end; From 3dbbb8f73e77f5b8fd3a3f60248a41c9aac1026a Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 6 Mar 2025 20:47:06 +0000 Subject: [PATCH 215/222] Refactor out TSnippetIDListEx TSnippetIDListEx added an extra constructor to TSnippetIDList that extracted snippet IDs from an TSnippetList instance. This was replaced by a new TSnippetList.IDs method that returns an ISnippetIDList instance containing the IDs of all the snippets in the list. Code that used TSnippetIDListEx was changed to use the TSnippetList.IDs method instead. --- Src/DB.UMain.pas | 4 ++-- Src/DB.USnippet.pas | 48 ++++++++++++++------------------------------- 2 files changed, 17 insertions(+), 35 deletions(-) diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index f62d53108..9822c16fa 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -903,7 +903,7 @@ function TDatabase.GetDependents(const Snippet: TSnippet): ISnippetIDList; List := TSnippetList.Create; try GetDependentList(Snippet, List); - Result := TSnippetIDListEx.Create(List); + Result := List.IDs; finally FreeAndNil(List); end; @@ -950,7 +950,7 @@ function TDatabase.GetReferrers(const Snippet: TSnippet): ISnippetIDList; List := TSnippetList.Create; try GetReferrerList(Snippet, List); - Result := TSnippetIDListEx.Create(List); + Result := List.IDs; finally FreeAndNil(List); end; diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index ec0c56e6d..8c9797fbf 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -352,6 +352,10 @@ TSnippetList = class(TObject) @return Required enumerator. } + /// Returns a list the IDs of all snippets in this list. + /// ISnippetIDList. Required list of snippet IDs. + function IDs: ISnippetIDList; + /// Counts number of snippets in list that belong to a specified /// vault. /// TVaultID [in] ID of required vault. @@ -397,21 +401,6 @@ TSnippetListEx = class(TSnippetList) } end; - { - TSnippetIDListEx: - Extension of TSnippetIDList that provides an additional constructor that can - create a snippet ID list from a TSnippetList. - } - TSnippetIDListEx = class(TSnippetIDList) - public - constructor Create(const SnipList: TSnippetList); overload; - {Constructor overload that creates a snippets ID list from a - TSnippetList object. - @param SnipList [in] List of snippets objects for which ID list is - required. - } - end; - implementation uses @@ -508,8 +497,8 @@ function TSnippet.GetProps: TSnippetData; function TSnippet.GetReferences: TSnippetReferences; begin Result.Units := TIStringList.Create(Units); - Result.Depends := TSnippetIDListEx.Create(Depends); - Result.XRef := TSnippetIDListEx.Create(XRef); + Result.Depends := Depends.IDs; + Result.XRef := XRef.IDs; end; function TSnippet.Hash: Integer; @@ -771,6 +760,15 @@ function TSnippetList.IsEmpty: Boolean; Result := Count = 0; end; +function TSnippetList.IDs: ISnippetIDList; +var + Snippet: TSnippet; +begin + Result := TSnippetIDList.Create; + for Snippet in fList do + Result.Add(Snippet.ID); +end; + function TSnippetList.IsEmpty(const AVaultID: TVaultID): Boolean; begin Result := Count(AVaultID) = 0; @@ -905,20 +903,4 @@ procedure TSnippetEditData.Init; Refs.Init; end; -{ TSnippetIDListEx } - -constructor TSnippetIDListEx.Create(const SnipList: TSnippetList); - {Constructor overload that creates a snippets ID list from a TSnippetList - object. - @param SnipList [in] List of snippets objects for which ID list is - required. - } -var - Snippet: TSnippet; // references each snippet in list -begin - inherited Create; - for Snippet in SnipList do - Add(Snippet.ID); -end; - end. From da16d4640c5b8de5c997a386f7e60e551d8cde19 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Thu, 6 Mar 2025 20:54:17 +0000 Subject: [PATCH 216/222] Refactor out TSnippetListEx TSnippetListEx added Add and Delete methods to TSnippetList. The Delete method was pushed down into TSnippetLisy while the Add method was simply deleted because all it did was call the existing TSnippetList.Add method. Code that used TSnippetListEx was changed to use TSnippetList instead. TSnippetListEx was then deleted. --- Src/DB.UCategory.pas | 2 +- Src/DB.UMain.pas | 14 +++++----- Src/DB.USnippet.pas | 62 ++++++++++++-------------------------------- 3 files changed, 25 insertions(+), 53 deletions(-) diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index b9ca3eddc..ae321bcf9 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -248,7 +248,7 @@ constructor TCategory.Create(const CatID: string; const Data: TCategoryData); fID := CatID; fDescription := Data.Desc; // Create list to store snippets in category - fSnippets := TSnippetListEx.Create; + fSnippets := TSnippetList.Create; end; destructor TCategory.Destroy; diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 9822c16fa..b04f332d0 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -755,7 +755,7 @@ constructor TDatabase.Create; } begin inherited Create; - fSnippets := TSnippetListEx.Create(True); + fSnippets := TSnippetList.Create(True); fCategories := TCategoryListEx.Create(True); fChangeEvents := TMultiCastEvents.Create(Self); end; @@ -830,9 +830,9 @@ procedure TDatabase.DeleteSnippet(const Snippet: TSnippet); GetReferrerList(Snippet, Referrers); // Delete snippet for XRef or Depends list of referencing snippets for Referrer in Referrers do - (Referrer.XRef as TSnippetListEx).Delete(Snippet); + Referrer.XRef.Delete(Snippet); for Dependent in Dependents do - (Dependent.Depends as TSnippetListEx).Delete(Snippet); + Dependent.Depends.Delete(Snippet); // Delete snippet itself InternalDeleteSnippet(Snippet); Query.Update; @@ -1050,9 +1050,9 @@ procedure TDatabase.InternalDeleteSnippet(const Snippet: TSnippet); // Delete from category if found Cat := fCategories.Find(Snippet.Category); if Assigned(Cat) then - (Cat.Snippets as TSnippetListEx).Delete(Snippet); + Cat.Snippets.Delete(Snippet); // Delete from "master" list: this frees Snippet - (fSnippets as TSnippetListEx).Delete(Snippet); + fSnippets.Delete(Snippet); end; procedure TDatabase.Load; @@ -1208,9 +1208,9 @@ function TDatabase.UpdateSnippet(const ASnippet: TSnippet; // remove references to pre-update snippet from referring snippets for Referrer in Referrers do - (Referrer.XRef as TSnippetListEx).Delete(ASnippet); + Referrer.XRef.Delete(ASnippet); for Dependent in Dependents do - (Dependent.Depends as TSnippetListEx).Delete(ASnippet); + Dependent.Depends.Delete(ASnippet); // record snippet's key and vault ID for use in re-created updated snippet PreservedSnippetID := ASnippet.ID; diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 8c9797fbf..854625e0a 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -317,6 +317,11 @@ TSnippetList = class(TObject) @return Index where item was inserted in list @except Raised if duplicate snippet added to list. } + procedure Delete(const Snippet: TSnippet); + {Deletes a snippet from list. + @param Snippet [in] Snippet to be deleted. No action taken if snippet + not in list. + } function Find(const SnippetID: TSnippetID): TSnippet; overload; {Finds a specified snippet in list. @param SnippetID [in] ID of snippet to find. @@ -383,24 +388,6 @@ TSnippetList = class(TObject) {List of snippets} end; - { - TSnippetListEx: - Private extension of TSnippetList for use internally by Snippets object. - } - TSnippetListEx = class(TSnippetList) - public - function Add(const Snippet: TSnippet): Integer; override; - {Adds a snippet to list. - @param Snippet [in] Snippet to be added. - @return Index where snippet was added to list. - } - procedure Delete(const Snippet: TSnippet); - {Deletes a snippet from list. - @param Snippet [in] Snippet to be deleted. No action taken if snippet - not in list. - } - end; - implementation uses @@ -436,8 +423,8 @@ constructor TSnippet.Create(const AKey: string; const AVaultID: TVaultID; // Create string list to store required units fUnits := TStringList.Create; // Create snippets lists for Depends and XRef properties - fDepends := TSnippetListEx.Create; - fXRef := TSnippetListEx.Create; + fDepends := TSnippetList.Create; + fXRef := TSnippetList.Create; // The following property added to support multiple snippet vaults fVaultID := AVaultID.Clone; end; @@ -690,6 +677,16 @@ constructor TSnippetList.Create(const OwnsObjects: Boolean = False); fList.PermitDuplicates := False; end; +procedure TSnippetList.Delete(const Snippet: TSnippet); +var + Idx: Integer; // index of snippet in list. +begin + Idx := fList.IndexOf(Snippet); + if Idx = -1 then + Exit; + fList.Delete(Idx); // this frees snippet if list owns objects +end; + destructor TSnippetList.Destroy; {Destructor. Tears down object. } @@ -799,31 +796,6 @@ function TSnippetList.IsEqual(const AList: TSnippetList): Boolean; end; end; -{ TSnippetListEx } - -function TSnippetListEx.Add(const Snippet: TSnippet): Integer; - {Adds a snippet to list. - @param Snippet [in] Snippet to be added. - @return Index where snippet was added to list. - } -begin - Result := inherited Add(Snippet); -end; - -procedure TSnippetListEx.Delete(const Snippet: TSnippet); - {Deletes a snippet from list. - @param Snippet [in] Snippet to be deleted. No action taken if snippet not in - list. - } -var - Idx: Integer; // index of snippet in list. -begin - Idx := fList.IndexOf(Snippet); - if Idx = -1 then - Exit; - fList.Delete(Idx); // this frees snippet if list owns objects -end; - { TSnippetData } procedure TSnippetData.Assign(const Src: TSnippetData); From 03a08c6a85242eb5a6303e825c0b1805dd3f749c Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 7 Mar 2025 08:16:50 +0000 Subject: [PATCH 217/222] Refactor out TCategoryEx Methods of TCategoryEx were merged down into TCategory and TCategoryEx was removed. Code that used TCategoryEx was changed to use TCategory instead. --- Src/DB.UCategory.pas | 64 +++++++++++++++++--------------------------- Src/DB.UMain.pas | 8 +++--- 2 files changed, 29 insertions(+), 43 deletions(-) diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index ae321bcf9..82574ba34 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -64,6 +64,7 @@ TCategory = class(TObject) /// ID of default category. DefaultID = '__default__'; + public /// Object constructor. Sets up category object with given /// property values. /// CatID [in] Category ID. @@ -71,6 +72,10 @@ TCategory = class(TObject) /// constructor Create(const CatID: string; const Data: TCategoryData); + /// Creates the default category with its default description. + /// + class function CreateDefault: TCategory; + destructor Destroy; override; {Destructor. Tears down object. } @@ -80,6 +85,10 @@ TCategory = class(TObject) /// properties. procedure Update(const Data: TCategoryData); + /// Returns a record containing all editable data of a category. + /// + function GetEditData: TCategoryData; + function IsEqual(const Cat: TCategory): Boolean; {Checks if this category is same as another category. Categories are considered equal if they have the same ID. @@ -107,22 +116,6 @@ TCategory = class(TObject) {List of snippets in this category} end; - { - TCategoryEx: - Private extension of TCategory for use internally by Snippets object. - } - TCategoryEx = class(TCategory) - public - /// Creates the default category with its default description. - /// - class function CreateDefault: TCategory; - - function GetEditData: TCategoryData; - {Gets details of all editable data of category. - @return Required editable data. - } - end; - { TCategoryList: Class that implements a list of TCategory objects. @@ -242,8 +235,6 @@ constructor TCategory.Create(const CatID: string; const Data: TCategoryData); {TODO -cVault: Add a simpler contructor that takes only the category ID and description and creates does all the convoluted TCategoryData setting! } - Assert(ClassType <> TCategory, - ClassName + '.Create: must only be called from descendants.'); inherited Create; fID := CatID; fDescription := Data.Desc; @@ -251,6 +242,17 @@ constructor TCategory.Create(const CatID: string; const Data: TCategoryData); fSnippets := TSnippetList.Create; end; +class function TCategory.CreateDefault: TCategory; +var + Data: TCategoryData; +resourcestring + sDefCatDesc = 'My Snippets'; +begin + Data.Init; + Data.Desc := sDefCatDesc; + Result := Create(DefaultID, Data); +end; + destructor TCategory.Destroy; {Destructor. Tears down object. } @@ -259,6 +261,11 @@ destructor TCategory.Destroy; inherited; end; +function TCategory.GetEditData: TCategoryData; +begin + Result.Desc := Self.Description; +end; + function TCategory.IsEqual(const Cat: TCategory): Boolean; {Checks if this category is same as another category. Categories are considered equal if they have the same ID. @@ -274,27 +281,6 @@ procedure TCategory.Update(const Data: TCategoryData); fDescription := Data.Desc; end; -{ TCategoryEx } - -class function TCategoryEx.CreateDefault: TCategory; -var - Data: TCategoryData; -resourcestring - sDefCatDesc = 'My Snippets'; -begin - Data.Init; - Data.Desc := sDefCatDesc; - Result := Create(DefaultID, Data); -end; - -function TCategoryEx.GetEditData: TCategoryData; - {Gets details of all editable data of category. - @return Required editable data. - } -begin - Result.Desc := Self.Description; -end; - { TCategoryList } function TCategoryList.Add(const Category: TCategory): Integer; diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index b04f332d0..5a76b3326 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -918,7 +918,7 @@ function TDatabase.GetEditableCategoryInfo( } begin if Assigned(Category) then - Result := (Category as TCategoryEx).GetEditData + Result := Category.GetEditData else Result.Init; end; @@ -1010,7 +1010,7 @@ function TDatabase.InternalAddCategory(const CatID: string; @return Reference to new category object. } begin - Result := TCategoryEx.Create(CatID, Data); + Result := TCategory.Create(CatID, Data); fCategories.Add(Result); end; @@ -1084,7 +1084,7 @@ procedure TDatabase.Load; CatLoader.Load(fCategories, DataItemFactory); // Ensure that the default category is present, if it's not already loaded if not Assigned(fCategories.Find(TCategory.DefaultID)) then - fCategories.Add(TCategoryEx.CreateDefault); + fCategories.Add(TCategory.CreateDefault); fUpdated := False; except // If an exception occurs clear the database @@ -1276,7 +1276,7 @@ function TDatabase.TEventInfo.GetKind: TDatabaseChangeEventKind; function TDBDataItemFactory.CreateCategory(const CatID: string; const Data: TCategoryData): TCategory; begin - Result := TCategoryEx.Create(CatID, Data); + Result := TCategory.Create(CatID, Data); end; function TDBDataItemFactory.CreateSnippet(const Key: string; From e58d4b48ba4c95c52dd4d48874ad50ca4bb8d5b0 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 7 Mar 2025 08:25:32 +0000 Subject: [PATCH 218/222] Refactor out TCategoryListEx The sole method of TCategoryListEx was merged down into TCategoryList and TCategoryExList was deleted. Code that used TCategoryListEx was changed to use TCategoryList instead. --- Src/DB.UCategory.pas | 43 ++++++++++++++++--------------------------- Src/DB.UMain.pas | 6 ++---- 2 files changed, 18 insertions(+), 31 deletions(-) diff --git a/Src/DB.UCategory.pas b/Src/DB.UCategory.pas index 82574ba34..27c5891e9 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.UCategory.pas @@ -150,6 +150,12 @@ TCategoryList = class(TObject) @param Category [in] Category to be added. @return Index where category inserted in list. } + + /// Deletes a category from the list. + /// TCategory [in] Category to be deleted. + /// + procedure Delete(const Category: TCategory); + function Find(const CatID: string): TCategory; {Finds a named category in list. @param CatID [in] ID of required category. @@ -171,18 +177,6 @@ TCategoryList = class(TObject) {Number of categories in list} end; - { - TCategoryListEx: - Private extension of TCategoryList for use internally by snippets object. - } - TCategoryListEx = class(TCategoryList) - public - procedure Delete(const Category: TCategory); - {Deletes a category from the list. - @param Category [in] Category to be deleted. - } - end; - implementation @@ -320,6 +314,16 @@ constructor TCategoryList.Create(const OwnsObjects: Boolean); fList := TObjectList.Create(OwnsObjects); end; +procedure TCategoryList.Delete(const Category: TCategory); +var + Idx: Integer; // index of snippet in list. +begin + Idx := fList.IndexOf(Category); + if Idx = -1 then + Exit; + fList.Delete(Idx); // this frees category if list owns objects +end; + destructor TCategoryList.Destroy; {Destructor. Tears down object. } @@ -373,21 +377,6 @@ function TCategoryList.GetItem(Idx: Integer): TCategory; Result := fList[Idx]; end; -{ TCategoryListEx } - -procedure TCategoryListEx.Delete(const Category: TCategory); - {Deletes a category from the list. - @param Category [in] Category to be deleted. - } -var - Idx: Integer; // index of snippet in list. -begin - Idx := fList.IndexOf(Category); - if Idx = -1 then - Exit; - fList.Delete(Idx); // this frees category if list owns objects -end; - { TCategoryData } procedure TCategoryData.Assign(const Src: TCategoryData); diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 5a76b3326..620210e78 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -756,7 +756,7 @@ constructor TDatabase.Create; begin inherited Create; fSnippets := TSnippetList.Create(True); - fCategories := TCategoryListEx.Create(True); + fCategories := TCategoryList.Create(True); fChangeEvents := TMultiCastEvents.Create(Self); end; @@ -771,8 +771,6 @@ function TDatabase.CreateTempSnippet(const Snippet: TSnippet): TSnippet; Data: TSnippetEditData; // data describing snippet's properties and references begin Assert(Assigned(Snippet), ClassName + '.CreateTempSnippet: Snippet is nil'); -// Assert(Snippet is TSnippetEx, -// ClassName + '.CreateTempSnippet: Snippet is a TSnippetEx'); Data := Snippet.GetEditData; Result := TSnippet.Create(Snippet.Key, Snippet.VaultID, Snippet.GetProps); Result.UpdateRefs(Snippet.GetReferences, fSnippets); @@ -1037,7 +1035,7 @@ procedure TDatabase.InternalDeleteCategory(const Cat: TCategory); @param Cat [in] Category to delete from database. } begin - (fCategories as TCategoryListEx).Delete(Cat); + fCategories.Delete(Cat); end; procedure TDatabase.InternalDeleteSnippet(const Snippet: TSnippet); From 31075c34547a43a18ab7f3791414002d14f0321c Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 7 Mar 2025 08:34:53 +0000 Subject: [PATCH 219/222] Rename USnippetIDs unit to DB.SnippetIDs Updated uses clauses of all units affected by the renaming. --- Src/CodeSnip.dpr | 2 +- Src/CodeSnip.dproj | 2 +- Src/DB.IO.ImportExport.CS4.pas | 2 +- Src/DB.IO.Manager.pas | 2 +- Src/{USnippetIDs.pas => DB.SnippetIDs.pas} | 2 +- Src/DB.UMain.pas | 4 ++-- Src/DB.USnippet.pas | 4 ++-- Src/Favourites.UFavourites.pas | 3 ++- Src/Favourites.UManager.pas | 5 ++++- Src/Favourites.UPersist.pas | 2 +- Src/FmCompErrorDlg.pas | 19 ++++++++++++++--- Src/FmDependenciesDlg.dfm | 4 ++++ Src/FmDependenciesDlg.pas | 2 +- Src/FmDuplicateSnippetDlg.pas | 2 +- Src/FmFavouritesDlg.pas | 5 ++++- Src/FmSnippetsEditorDlg.dfm | 8 ++++++++ Src/FmSnippetsEditorDlg.pas | 24 ++++++++++++++++++---- Src/UCodeImportMgr.pas | 2 +- Src/UEditSnippetAction.pas | 2 +- Src/UNotifier.pas | 2 +- Src/USearch.pas | 5 ++++- Src/USelectionIOMgr.pas | 14 ++++++++++--- Src/USnippetIDListIOHandler.pas | 4 ++-- Src/USnippetsChkListMgr.pas | 7 +++++-- Src/UUserDBMgr.pas | 2 +- Src/UView.pas | 5 ++++- 26 files changed, 100 insertions(+), 35 deletions(-) rename Src/{USnippetIDs.pas => DB.SnippetIDs.pas} (99%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index e9246266c..8901477b7 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -317,7 +317,7 @@ uses USnippetExtraHelper in 'USnippetExtraHelper.pas', USnippetHTML in 'USnippetHTML.pas', USnippetIDListIOHandler in 'USnippetIDListIOHandler.pas', - USnippetIDs in 'USnippetIDs.pas', + DB.SnippetIDs in 'DB.SnippetIDs.pas', USnippetPageHTML in 'USnippetPageHTML.pas', USnippetPageStructure in 'USnippetPageStructure.pas', USnippetsChkListMgr in 'USnippetsChkListMgr.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index cbf5e8e51..6da770b68 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -519,7 +519,7 @@ - + diff --git a/Src/DB.IO.ImportExport.CS4.pas b/Src/DB.IO.ImportExport.CS4.pas index e9f3cc47e..569366627 100644 --- a/Src/DB.IO.ImportExport.CS4.pas +++ b/Src/DB.IO.ImportExport.CS4.pas @@ -22,12 +22,12 @@ interface XMLIntf, Generics.Collections, // Project + DB.SnippetIDs, DB.UCategory, DB.USnippet, UBaseObjects, UEncodings, UIStringList, - USnippetIDs, UXMLDocHelper, UXMLDocumentEx; diff --git a/Src/DB.IO.Manager.pas b/Src/DB.IO.Manager.pas index b9c9aaac1..09f305ae5 100644 --- a/Src/DB.IO.Manager.pas +++ b/Src/DB.IO.Manager.pas @@ -129,10 +129,10 @@ implementation DB.IO.Vault, DB.IO.Vault.Null, DB.IO.Categories, + DB.SnippetIDs, UAppInfo, UConsts, UIStringList, - USnippetIDs, VaultBackup; diff --git a/Src/USnippetIDs.pas b/Src/DB.SnippetIDs.pas similarity index 99% rename from Src/USnippetIDs.pas rename to Src/DB.SnippetIDs.pas index d1e94eb08..6d0af3b96 100644 --- a/Src/USnippetIDs.pas +++ b/Src/DB.SnippetIDs.pas @@ -10,7 +10,7 @@ } -unit USnippetIDs; +unit DB.SnippetIDs; interface diff --git a/Src/DB.UMain.pas b/Src/DB.UMain.pas index 620210e78..e82d268bd 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.UMain.pas @@ -23,13 +23,13 @@ interface // Project ActiveText.UMain, Compilers.UGlobals, + DB.SnippetIDs, DB.UCategory, DB.USnippet, DB.Vaults, UContainers, UIStringList, - UMultiCastEvents, - USnippetIDs; + UMultiCastEvents; type diff --git a/Src/DB.USnippet.pas b/Src/DB.USnippet.pas index 854625e0a..9b90539ce 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.USnippet.pas @@ -24,11 +24,11 @@ interface // Project ActiveText.UMain, Compilers.UGlobals, + DB.SnippetIDs, DB.USnippetKind, DB.Vaults, UContainers, - UIStringList, - USnippetIDs; + UIStringList; type /// Enumeration providing information about the level to which a diff --git a/Src/Favourites.UFavourites.pas b/Src/Favourites.UFavourites.pas index 0a5154621..b8c35cee5 100644 --- a/Src/Favourites.UFavourites.pas +++ b/Src/Favourites.UFavourites.pas @@ -19,7 +19,8 @@ interface // Delphi Generics.Collections, // Project - UMultiCastEvents, USnippetIDs; + DB.SnippetIDs, + UMultiCastEvents; type diff --git a/Src/Favourites.UManager.pas b/Src/Favourites.UManager.pas index da119c289..9477928dc 100644 --- a/Src/Favourites.UManager.pas +++ b/Src/Favourites.UManager.pas @@ -18,7 +18,10 @@ interface uses // Delphi - Favourites.UFavourites, USnippetIDs, IntfNotifier, UView; + DB.SnippetIDs, + Favourites.UFavourites, + IntfNotifier, + UView; type diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index bacbdb590..3c58d5b09 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -58,13 +58,13 @@ implementation IOUtils, Classes, /// Project + DB.SnippetIDs, DB.UMain, DB.Vaults, UAppInfo, UConsts, UIOUtils, UIStringList, - USnippetIDs, UStrUtils, UTabSeparatedFileIO; diff --git a/Src/FmCompErrorDlg.pas b/Src/FmCompErrorDlg.pas index ed1285957..be6844974 100644 --- a/Src/FmCompErrorDlg.pas +++ b/Src/FmCompErrorDlg.pas @@ -17,11 +17,24 @@ interface uses // Delphi - Forms, StdCtrls, Controls, ExtCtrls, Classes, Tabs, ActnList, ImgList, + Forms, + StdCtrls, + Controls, + ExtCtrls, + Classes, + Tabs, + ActnList, + ImgList, Generics.Collections, // Project - Compilers.UGlobals, DB.USnippet, FmGenericViewDlg, FrBrowserBase, FrHTMLDlg, - FrHTMLTpltDlg, UBaseObjects, USnippetIDs; + Compilers.UGlobals, + DB.SnippetIDs, + DB.USnippet, + FmGenericViewDlg, + FrBrowserBase, + FrHTMLDlg, + FrHTMLTpltDlg, + UBaseObjects; type diff --git a/Src/FmDependenciesDlg.dfm b/Src/FmDependenciesDlg.dfm index e3d882f53..45f0aa78d 100644 --- a/Src/FmDependenciesDlg.dfm +++ b/Src/FmDependenciesDlg.dfm @@ -52,6 +52,10 @@ inherited DependenciesDlg: TDependenciesDlg object tsRequiredBy: TTabSheet Caption = 'Required By' ImageIndex = 1 + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblNoDependents: TLabel Left = 8 Top = 8 diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index bf63872c9..00ee623cd 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -26,12 +26,12 @@ interface Windows, ActnList, // Project + DB.SnippetIDs, DB.USnippet, DB.Vaults, FmGenericViewDlg, UBaseObjects, USearch, - USnippetIDs, USnippetsTVDraw; diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index 613d69346..ed0871e35 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -90,13 +90,13 @@ implementation // Delphi Math, // Project + DB.SnippetIDs, DB.UCategory, DB.UMain, UCtrlArranger, UExceptions, UMessageBox, USettings, - USnippetIDs, USnippetValidator, UStructs, UStrUtils, diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index 746ebdf65..1943c2ccd 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -23,7 +23,10 @@ interface // 3rd party LVEx, // Project - FmGenericNonModalDlg, Favourites.UFavourites, IntfNotifier, USnippetIDs, + DB.SnippetIDs, + FmGenericNonModalDlg, + Favourites.UFavourites, + IntfNotifier, UWindowSettings; diff --git a/Src/FmSnippetsEditorDlg.dfm b/Src/FmSnippetsEditorDlg.dfm index 4cd3888bb..951761e11 100644 --- a/Src/FmSnippetsEditorDlg.dfm +++ b/Src/FmSnippetsEditorDlg.dfm @@ -202,6 +202,10 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg object tsReferences: TTabSheet Caption = 'References' ImageIndex = 1 + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblXRefs: TLabel Left = 3 Top = 3 @@ -331,6 +335,10 @@ inherited SnippetsEditorDlg: TSnippetsEditorDlg object tsCompileResults: TTabSheet Caption = 'Compile Results' ImageIndex = 3 + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object lblCompilers: TLabel Left = 3 Top = 3 diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 5ab6ffb97..0657900ea 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -297,11 +297,27 @@ implementation // Delphi Windows {for inlining}, Graphics, // Project + DB.SnippetIDs, DB.UCategory, - DB.UMain, DB.USnippetKind, FmDependenciesDlg, IntfCommon, UColours, UConsts, - UCSSUtils, UCtrlArranger, UExceptions, UFontHelper, UIStringList, - USnippetExtraHelper, USnippetValidator, UMessageBox, - USnippetIDs, UStructs, UStrUtils, UTestUnitDlgMgr, UThemesEx, UUtils; + DB.UMain, + DB.USnippetKind, + FmDependenciesDlg, + IntfCommon, + UColours, + UConsts, + UCSSUtils, + UCtrlArranger, + UExceptions, + UFontHelper, + UIStringList, + USnippetExtraHelper, + USnippetValidator, + UMessageBox, + UStructs, + UStrUtils, + UTestUnitDlgMgr, + UThemesEx, + UUtils; {$R *.dfm} diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index a41552a49..5dfaf312d 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -157,11 +157,11 @@ implementation Classes, // Project ActiveText.UMain, + DB.SnippetIDs, DB.UMain, DB.USnippet, IntfCommon, UIOUtils, - USnippetIDs, UStrUtils; diff --git a/Src/UEditSnippetAction.pas b/Src/UEditSnippetAction.pas index 54c6f0df5..5862f7a29 100644 --- a/Src/UEditSnippetAction.pas +++ b/Src/UEditSnippetAction.pas @@ -19,7 +19,7 @@ interface // Delphi Classes, // Project - USnippetIDs; + DB.SnippetIDs; type diff --git a/Src/UNotifier.pas b/Src/UNotifier.pas index 35e101359..12cef6df1 100644 --- a/Src/UNotifier.pas +++ b/Src/UNotifier.pas @@ -187,11 +187,11 @@ implementation SysUtils, StdActns, // Project Compilers.UGlobals, + DB.SnippetIDs, UCategoryAction, UDetailTabAction, UEditSnippetAction, USnippetAction, - USnippetIDs, UViewItemAction; diff --git a/Src/USearch.pas b/Src/USearch.pas index 2bb2889a8..dd42b678d 100644 --- a/Src/USearch.pas +++ b/Src/USearch.pas @@ -20,7 +20,10 @@ interface // Delphi Classes, Graphics, // Project - Compilers.UGlobals, DB.USnippet, UBaseObjects, USnippetIDs; + Compilers.UGlobals, + DB.SnippetIDs, + DB.USnippet, + UBaseObjects; type diff --git a/Src/USelectionIOMgr.pas b/Src/USelectionIOMgr.pas index effdd96db..f4e048aec 100644 --- a/Src/USelectionIOMgr.pas +++ b/Src/USelectionIOMgr.pas @@ -43,10 +43,18 @@ implementation uses // Delphi - SysUtils, Dialogs, + SysUtils, + Dialogs, // Project - DB.USnippet, UConsts, UMessageBox, UOpenDialogEx, UOpenDialogHelper, - UQuery, USaveDialogEx, USnippetIDListIOHandler, USnippetIDs; + DB.SnippetIDs, + DB.USnippet, + UConsts, + UMessageBox, + UOpenDialogEx, + UOpenDialogHelper, + UQuery, + USaveDialogEx, + USnippetIDListIOHandler; const /// Watermark for selection files. Uses characters that will be diff --git a/Src/USnippetIDListIOHandler.pas b/Src/USnippetIDListIOHandler.pas index c7dd944cb..b28409751 100644 --- a/Src/USnippetIDListIOHandler.pas +++ b/Src/USnippetIDListIOHandler.pas @@ -19,8 +19,8 @@ interface // Delphi SysUtils, // Project - UExceptions, - USnippetIDs; + DB.SnippetIDs, + UExceptions; type diff --git a/Src/USnippetsChkListMgr.pas b/Src/USnippetsChkListMgr.pas index b9a606cf5..803d737f6 100644 --- a/Src/USnippetsChkListMgr.pas +++ b/Src/USnippetsChkListMgr.pas @@ -18,9 +18,12 @@ interface uses // Delphi - Controls, CheckLst, Windows, + Controls, + CheckLst, + Windows, // Project - DB.USnippet, USnippetIDs; + DB.SnippetIDs, + DB.USnippet; type diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index da2375db7..b0d0895a7 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -21,9 +21,9 @@ interface // Delphi Classes, // Project + DB.SnippetIDs, DB.UCategory, UBaseObjects, - USnippetIDs, UView; diff --git a/Src/UView.pas b/Src/UView.pas index 36e28553d..d533113ad 100644 --- a/Src/UView.pas +++ b/Src/UView.pas @@ -198,7 +198,10 @@ implementation // Delphi SysUtils, // Project - DB.UMain, UExceptions, USnippetIDs, UStrUtils; + DB.SnippetIDs, + DB.UMain, + UExceptions, + UStrUtils; type /// From dc72d0ae4403226da3af84a717b23fb10850b86d Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 7 Mar 2025 09:11:19 +0000 Subject: [PATCH 220/222] Rename units in DB namespace that have "U" prefix All remaining units in the DB namespace that still began with "U" were renamed as follows: DB.UCategory to DB.Categories, DB.UMain to DB.Main, DB.USnippet to DB.Snippets and DB.USnippetKind to DB.SnippetKind. Numerous units had their uses clauses updated re these changes. --- Src/CodeSnip.dpr | 8 +++---- Src/CodeSnip.dproj | 8 +++---- Src/{DB.UCategory.pas => DB.Categories.pas} | 4 ++-- Src/DB.IO.Categories.pas | 2 +- Src/DB.IO.Common.CS4.pas | 2 +- Src/DB.IO.ImportExport.CS4.pas | 10 ++++----- Src/DB.IO.Manager.pas | 6 ++--- Src/DB.IO.Vault.CS4.pas | 6 ++--- Src/DB.IO.Vault.DCSCv2.pas | 6 ++--- Src/DB.IO.Vault.Native.pas | 6 ++--- Src/DB.IO.Vault.Null.pas | 4 ++-- Src/DB.IO.Vault.pas | 4 ++-- Src/{DB.UMain.pas => DB.Main.pas} | 6 ++--- ...DB.USnippetKind.pas => DB.SnippetKind.pas} | 2 +- Src/{DB.USnippet.pas => DB.Snippets.pas} | 4 ++-- Src/Favourites.UManager.pas | 5 ++++- Src/Favourites.UPersist.pas | 2 +- Src/FmAddCategoryDlg.dfm | 4 ---- Src/FmAddCategoryDlg.pas | 4 +++- Src/FmCodeExportDlg.dfm | 4 ++-- Src/FmCodeExportDlg.pas | 15 ++++++++++--- Src/FmCompErrorDlg.pas | 8 +++++-- Src/FmDeleteCategoryDlg.dfm | 1 + Src/FmDeleteCategoryDlg.pas | 16 +++++++++++--- Src/FmDependenciesDlg.pas | 6 ++--- Src/FmDuplicateSnippetDlg.pas | 6 ++--- Src/FmFavouritesDlg.pas | 4 ++-- Src/FmFindXRefsDlg.pas | 10 +++++++-- Src/FmMain.pas | 6 ++--- Src/FmRenameCategoryDlg.dfm | 10 ++------- Src/FmRenameCategoryDlg.pas | 15 ++++++++++--- Src/FmSelectionSearchDlg.pas | 4 ++-- Src/FmSnippetsEditorDlg.pas | 8 +++---- Src/FmTestCompileDlg.dfm | 4 ++-- Src/FmTestCompileDlg.pas | 17 +++++++++++--- Src/FrCategoryDescEdit.pas | 7 +++++- Src/FrCategoryList.pas | 5 +++-- Src/FrOverview.pas | 2 +- Src/FrSelectSnippets.pas | 9 ++++++-- Src/FrSelectSnippetsBase.pas | 6 ++--- Src/FrSelectUserSnippets.pas | 9 ++++++-- Src/FrSnippetLayoutPrefs.pas | 12 ++++++++-- Src/IntfFrameMgrs.pas | 6 ++++- Src/SWAG.UImporter.pas | 8 +++---- Src/UCategoryAction.pas | 4 +++- Src/UCodeImportMgr.pas | 4 ++-- Src/UCodeShareMgr.pas | 4 ++-- Src/UCompileMgr.pas | 6 +++-- Src/UDatabaseLoader.pas | 3 ++- Src/UDetailPageHTML.pas | 4 ++-- Src/UDialogMgr.pas | 4 +++- Src/UGroups.pas | 9 ++++++-- Src/UHistory.pas | 3 ++- Src/UI.Adapters.CategoryList.pas | 3 ++- Src/UI.Adapters.SnippetKindList.pas | 4 +++- Src/UMainDisplayMgr.pas | 4 +++- Src/UOverviewTreeBuilder.pas | 5 ++++- Src/UPrintDocuments.pas | 5 ++++- Src/UPrintMgr.pas | 7 +++++- Src/UQuery.pas | 11 +++++++--- Src/URTFCategoryDoc.pas | 6 ++++- Src/USaveUnitMgr.pas | 2 +- Src/USearch.pas | 10 ++++++--- Src/USelectionIOMgr.pas | 2 +- Src/USnippetAction.pas | 4 ++-- Src/USnippetDoc.pas | 6 ++--- Src/USnippetHTML.pas | 20 +++++++++++++---- Src/USnippetPageHTML.pas | 4 +++- Src/USnippetPageStructure.pas | 7 +++++- Src/USnippetSourceGen.pas | 4 ++-- Src/USnippetValidator.pas | 6 ++--- Src/USnippetsChkListMgr.pas | 2 +- Src/USourceGen.pas | 22 ++++++++++++++----- Src/UStatusBarMgr.pas | 2 +- Src/UTestCompile.pas | 4 +++- Src/UTestCompileUI.pas | 4 +++- Src/UTestUnit.pas | 9 ++++++-- Src/UTestUnitDlgMgr.pas | 3 ++- Src/UUserDBMgr.pas | 6 ++--- Src/UView.pas | 8 +++---- Src/UXMLDocHelper.pas | 2 +- 81 files changed, 330 insertions(+), 174 deletions(-) rename Src/{DB.UCategory.pas => DB.Categories.pas} (99%) rename Src/{DB.UMain.pas => DB.Main.pas} (99%) rename Src/{DB.USnippetKind.pas => DB.SnippetKind.pas} (99%) rename Src/{DB.USnippet.pas => DB.Snippets.pas} (99%) diff --git a/Src/CodeSnip.dpr b/Src/CodeSnip.dpr index 8901477b7..5e447b7bd 100644 --- a/Src/CodeSnip.dpr +++ b/Src/CodeSnip.dpr @@ -63,11 +63,11 @@ uses Compilers.UGlobals in 'Compilers.UGlobals.pas', Compilers.URunner in 'Compilers.URunner.pas', Compilers.USearchDirs in 'Compilers.USearchDirs.pas', - DB.UCategory in 'DB.UCategory.pas', + DB.Categories in 'DB.Categories.pas', DB.IO.Manager in 'DB.IO.Manager.pas', - DB.UMain in 'DB.UMain.pas', - DB.USnippet in 'DB.USnippet.pas', - DB.USnippetKind in 'DB.USnippetKind.pas', + DB.Main in 'DB.Main.pas', + DB.Snippets in 'DB.Snippets.pas', + DB.SnippetKind in 'DB.SnippetKind.pas', DB.IO.Vault in 'DB.IO.Vault.pas', DB.IO.Vault.DCSCv2 in 'DB.IO.Vault.DCSCv2.pas', DB.IO.Vault.Null in 'DB.IO.Vault.Null.pas', diff --git a/Src/CodeSnip.dproj b/Src/CodeSnip.dproj index 6da770b68..097e03630 100644 --- a/Src/CodeSnip.dproj +++ b/Src/CodeSnip.dproj @@ -66,11 +66,11 @@ - + - - - + + + diff --git a/Src/DB.UCategory.pas b/Src/DB.Categories.pas similarity index 99% rename from Src/DB.UCategory.pas rename to Src/DB.Categories.pas index 27c5891e9..0f119d416 100644 --- a/Src/DB.UCategory.pas +++ b/Src/DB.Categories.pas @@ -10,7 +10,7 @@ } -unit DB.UCategory; +unit DB.Categories; interface @@ -20,7 +20,7 @@ interface // Delphi Generics.Collections, // Project - DB.USnippet, + DB.Snippets, DB.Vaults; diff --git a/Src/DB.IO.Categories.pas b/Src/DB.IO.Categories.pas index 8f28eb091..1de67e7fe 100644 --- a/Src/DB.IO.Categories.pas +++ b/Src/DB.IO.Categories.pas @@ -17,7 +17,7 @@ interface SysUtils, Generics.Collections, // Project - DB.UCategory, + DB.Categories, UExceptions, UTabSeparatedFileIO; diff --git a/Src/DB.IO.Common.CS4.pas b/Src/DB.IO.Common.CS4.pas index 2c028752f..84237d7d6 100644 --- a/Src/DB.IO.Common.CS4.pas +++ b/Src/DB.IO.Common.CS4.pas @@ -19,7 +19,7 @@ interface XMLIntf, // Project Compilers.UGlobals, - DB.USnippetKind, + DB.SnippetKind, UIStringList, UStructs, UXMLDocHelper, diff --git a/Src/DB.IO.ImportExport.CS4.pas b/Src/DB.IO.ImportExport.CS4.pas index 569366627..f1cf58f86 100644 --- a/Src/DB.IO.ImportExport.CS4.pas +++ b/Src/DB.IO.ImportExport.CS4.pas @@ -22,9 +22,9 @@ interface XMLIntf, Generics.Collections, // Project + DB.Categories, DB.SnippetIDs, - DB.UCategory, - DB.USnippet, + DB.Snippets, UBaseObjects, UEncodings, UIStringList, @@ -183,10 +183,10 @@ implementation XMLDom, // Project ActiveText.UMain, - DB.IO.Common.CS4, - DB.UMain, - DB.USnippetKind, + DB.Main, + DB.SnippetKind, DB.Vaults, + DB.IO.Common.CS4, UAppInfo, USnippetExtraHelper, UStructs, diff --git a/Src/DB.IO.Manager.pas b/Src/DB.IO.Manager.pas index 09f305ae5..99ef8177b 100644 --- a/Src/DB.IO.Manager.pas +++ b/Src/DB.IO.Manager.pas @@ -18,9 +18,9 @@ interface uses // Project - DB.UCategory, - DB.UMain, - DB.USnippet, + DB.Categories, + DB.Main, + DB.Snippets, DB.Vaults, UBaseObjects, UExceptions; diff --git a/Src/DB.IO.Vault.CS4.pas b/Src/DB.IO.Vault.CS4.pas index 2c71c0aa1..f6c95d947 100644 --- a/Src/DB.IO.Vault.CS4.pas +++ b/Src/DB.IO.Vault.CS4.pas @@ -20,9 +20,9 @@ interface // Delphi XMLIntf, // Project + DB.Categories, DB.MetaData, - DB.UCategory, - DB.USnippet, + DB.Snippets, DB.IO.Vault, UIStringList, UREMLDataIO, @@ -264,8 +264,8 @@ implementation XMLDom, // Project ActiveText.UMain, + DB.SnippetKind, DB.IO.Common.CS4, - DB.USnippetKind, UConsts, UExceptions, UIOUtils, diff --git a/Src/DB.IO.Vault.DCSCv2.pas b/Src/DB.IO.Vault.DCSCv2.pas index 2ea1368d3..a33e8e82f 100644 --- a/Src/DB.IO.Vault.DCSCv2.pas +++ b/Src/DB.IO.Vault.DCSCv2.pas @@ -25,9 +25,9 @@ interface IniFiles, // Project ActiveText.UMain, + DB.Categories, DB.MetaData, - DB.UCategory, - DB.USnippet, + DB.Snippets, DB.IO.Vault, UIStringList, UVersionInfo; @@ -459,7 +459,7 @@ implementation IOUtils, // Project Compilers.UGlobals, - DB.USnippetKind, + DB.SnippetKind, UComparers, UConsts, UEncodings, diff --git a/Src/DB.IO.Vault.Native.pas b/Src/DB.IO.Vault.Native.pas index fbd1263f8..8ae7714b7 100644 --- a/Src/DB.IO.Vault.Native.pas +++ b/Src/DB.IO.Vault.Native.pas @@ -20,9 +20,9 @@ interface // Project Compilers.UGlobals, DB.MetaData, - DB.UCategory, - DB.USnippet, - DB.USnippetKind, + DB.Categories, + DB.SnippetKind, + DB.Snippets, DB.IO.Vault, UIStringList, UVersionInfo, diff --git a/Src/DB.IO.Vault.Null.pas b/Src/DB.IO.Vault.Null.pas index c650f16a3..945bab3d3 100644 --- a/Src/DB.IO.Vault.Null.pas +++ b/Src/DB.IO.Vault.Null.pas @@ -18,8 +18,8 @@ interface uses // Project DB.MetaData, - DB.UCategory, - DB.USnippet, + DB.Categories, + DB.Snippets, DB.IO.Vault, UIStringList; diff --git a/Src/DB.IO.Vault.pas b/Src/DB.IO.Vault.pas index 3a445b79f..552e0c4b6 100644 --- a/Src/DB.IO.Vault.pas +++ b/Src/DB.IO.Vault.pas @@ -20,8 +20,8 @@ interface uses // Project DB.MetaData, - DB.UCategory, - DB.USnippet, + DB.Categories, + DB.Snippets, UExceptions, UIStringList; diff --git a/Src/DB.UMain.pas b/Src/DB.Main.pas similarity index 99% rename from Src/DB.UMain.pas rename to Src/DB.Main.pas index e82d268bd..6c25a360b 100644 --- a/Src/DB.UMain.pas +++ b/Src/DB.Main.pas @@ -10,7 +10,7 @@ } -unit DB.UMain; +unit DB.Main; interface @@ -23,9 +23,9 @@ interface // Project ActiveText.UMain, Compilers.UGlobals, + DB.Categories, DB.SnippetIDs, - DB.UCategory, - DB.USnippet, + DB.Snippets, DB.Vaults, UContainers, UIStringList, diff --git a/Src/DB.USnippetKind.pas b/Src/DB.SnippetKind.pas similarity index 99% rename from Src/DB.USnippetKind.pas rename to Src/DB.SnippetKind.pas index 45fbed42e..a19d4ee89 100644 --- a/Src/DB.USnippetKind.pas +++ b/Src/DB.SnippetKind.pas @@ -11,7 +11,7 @@ } -unit DB.USnippetKind; +unit DB.SnippetKind; interface diff --git a/Src/DB.USnippet.pas b/Src/DB.Snippets.pas similarity index 99% rename from Src/DB.USnippet.pas rename to Src/DB.Snippets.pas index 9b90539ce..ba999a0d6 100644 --- a/Src/DB.USnippet.pas +++ b/Src/DB.Snippets.pas @@ -10,7 +10,7 @@ } -unit DB.USnippet; +unit DB.Snippets; interface @@ -25,7 +25,7 @@ interface ActiveText.UMain, Compilers.UGlobals, DB.SnippetIDs, - DB.USnippetKind, + DB.SnippetKind, DB.Vaults, UContainers, UIStringList; diff --git a/Src/Favourites.UManager.pas b/Src/Favourites.UManager.pas index 9477928dc..e81c2a360 100644 --- a/Src/Favourites.UManager.pas +++ b/Src/Favourites.UManager.pas @@ -81,7 +81,10 @@ implementation // Delphi SysUtils, // Project - DB.UMain, DB.USnippet, Favourites.UPersist, FmFavouritesDlg; + DB.Main, + DB.Snippets, + Favourites.UPersist, + FmFavouritesDlg; { TFavouritesManager } diff --git a/Src/Favourites.UPersist.pas b/Src/Favourites.UPersist.pas index 3c58d5b09..97ca36d98 100644 --- a/Src/Favourites.UPersist.pas +++ b/Src/Favourites.UPersist.pas @@ -58,8 +58,8 @@ implementation IOUtils, Classes, /// Project + DB.Main, DB.SnippetIDs, - DB.UMain, DB.Vaults, UAppInfo, UConsts, diff --git a/Src/FmAddCategoryDlg.dfm b/Src/FmAddCategoryDlg.dfm index 110836fca..0c6f9b995 100644 --- a/Src/FmAddCategoryDlg.dfm +++ b/Src/FmAddCategoryDlg.dfm @@ -12,10 +12,6 @@ inherited AddCategoryDlg: TAddCategoryDlg Height = 240 TabOrder = 0 TabStop = True - inherited lblError: TLabel - Width = 108 - ExplicitWidth = 108 - end end end inherited btnOK: TButton diff --git a/Src/FmAddCategoryDlg.pas b/Src/FmAddCategoryDlg.pas index 27ebb3258..12a873289 100644 --- a/Src/FmAddCategoryDlg.pas +++ b/Src/FmAddCategoryDlg.pas @@ -68,7 +68,9 @@ implementation uses // Project - DB.UCategory, DB.UMain, UUniqueID; + DB.Categories, + DB.Main, + UUniqueID; {$R *.dfm} diff --git a/Src/FmCodeExportDlg.dfm b/Src/FmCodeExportDlg.dfm index 1bcdbcc40..bbdce1666 100644 --- a/Src/FmCodeExportDlg.dfm +++ b/Src/FmCodeExportDlg.dfm @@ -10,7 +10,7 @@ inherited CodeExportDlg: TCodeExportDlg object lblSnippets: TLabel Left = 0 Top = 0 - Width = 146 + Width = 151 Height = 13 Caption = 'Select &snippets to be exported:' FocusControl = frmSnippets @@ -18,7 +18,7 @@ inherited CodeExportDlg: TCodeExportDlg object lblFile: TLabel Left = 0 Top = 232 - Width = 200 + Width = 208 Height = 13 Caption = 'Save to &file: (click button to browse for file)' FocusControl = edFile diff --git a/Src/FmCodeExportDlg.pas b/Src/FmCodeExportDlg.pas index 085c561eb..a8415d786 100644 --- a/Src/FmCodeExportDlg.pas +++ b/Src/FmCodeExportDlg.pas @@ -18,10 +18,19 @@ interface uses // Delphi - Classes, StdCtrls, Controls, Forms, ExtCtrls, + Classes, + StdCtrls, + Controls, + Forms, + ExtCtrls, // Project - DB.USnippet, FmGenericOKDlg, FrCheckedTV, FrSelectUserSnippets, - FrSelectSnippets, FrSelectSnippetsBase, UBaseObjects; + DB.Snippets, + FmGenericOKDlg, + FrCheckedTV, + FrSelectUserSnippets, + FrSelectSnippets, + FrSelectSnippetsBase, + UBaseObjects; type diff --git a/Src/FmCompErrorDlg.pas b/Src/FmCompErrorDlg.pas index be6844974..dd25422bd 100644 --- a/Src/FmCompErrorDlg.pas +++ b/Src/FmCompErrorDlg.pas @@ -29,7 +29,7 @@ interface // Project Compilers.UGlobals, DB.SnippetIDs, - DB.USnippet, + DB.Snippets, FmGenericViewDlg, FrBrowserBase, FrHTMLDlg, @@ -143,7 +143,11 @@ implementation // Delphi Graphics, // Project - DB.UMain, UConsts, UExceptions, UHTMLUtils, UHTMLTemplate; + DB.Main, + UConsts, + UExceptions, + UHTMLUtils, + UHTMLTemplate; {$R *.dfm} diff --git a/Src/FmDeleteCategoryDlg.dfm b/Src/FmDeleteCategoryDlg.dfm index 67f1b748f..de0504e9c 100644 --- a/Src/FmDeleteCategoryDlg.dfm +++ b/Src/FmDeleteCategoryDlg.dfm @@ -1,5 +1,6 @@ inherited DeleteCategoryDlg: TDeleteCategoryDlg Caption = 'Delete Category' + ExplicitWidth = 320 ExplicitHeight = 375 PixelsPerInch = 96 TextHeight = 13 diff --git a/Src/FmDeleteCategoryDlg.pas b/Src/FmDeleteCategoryDlg.pas index 0f3677660..dfc6e43d2 100644 --- a/Src/FmDeleteCategoryDlg.pas +++ b/Src/FmDeleteCategoryDlg.pas @@ -17,9 +17,16 @@ interface uses // Delphi - Forms, StdCtrls, Controls, ExtCtrls, Classes, + Forms, + StdCtrls, + Controls, + ExtCtrls, + Classes, // Project - DB.UCategory, FmCategoryEditDlg, FrCategoryList, UBaseObjects; + DB.Categories, + FmCategoryEditDlg, + FrCategoryList, + UBaseObjects; type @@ -69,7 +76,10 @@ implementation uses // Project - DB.UMain, UColours, UCtrlArranger, UFontHelper; + DB.Main, + UColours, + UCtrlArranger, + UFontHelper; {$R *.dfm} diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index 00ee623cd..433095f5f 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -27,7 +27,7 @@ interface ActnList, // Project DB.SnippetIDs, - DB.USnippet, + DB.Snippets, DB.Vaults, FmGenericViewDlg, UBaseObjects, @@ -176,8 +176,8 @@ implementation SysUtils, Graphics, // Project - DB.UMain, - DB.USnippetKind, + DB.Main, + DB.SnippetKind, UBox, UColours, UCtrlArranger, diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index ed0871e35..d7e8bf6d1 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -23,7 +23,7 @@ interface ExtCtrls, Classes, // Project - DB.USnippet, + DB.Snippets, DB.Vaults, FmGenericOKDlg, UBaseObjects, @@ -90,9 +90,9 @@ implementation // Delphi Math, // Project + DB.Categories, + DB.Main, DB.SnippetIDs, - DB.UCategory, - DB.UMain, UCtrlArranger, UExceptions, UMessageBox, diff --git a/Src/FmFavouritesDlg.pas b/Src/FmFavouritesDlg.pas index 1943c2ccd..6016cf26b 100644 --- a/Src/FmFavouritesDlg.pas +++ b/Src/FmFavouritesDlg.pas @@ -279,8 +279,8 @@ implementation Windows, Graphics, // Project - DB.UMain, - DB.USnippet, + DB.Main, + DB.Snippets, DB.Vaults, UCtrlArranger, UMessageBox, diff --git a/Src/FmFindXRefsDlg.pas b/Src/FmFindXRefsDlg.pas index b9528b58c..a09373192 100644 --- a/Src/FmFindXRefsDlg.pas +++ b/Src/FmFindXRefsDlg.pas @@ -20,9 +20,15 @@ interface uses // Delphi - StdCtrls, Controls, ExtCtrls, Classes, + StdCtrls, + Controls, + ExtCtrls, + Classes, // Project - DB.USnippet, FmGenericOKDlg, UBaseObjects, USearch; + DB.Snippets, + FmGenericOKDlg, + UBaseObjects, + USearch; type diff --git a/Src/FmMain.pas b/Src/FmMain.pas index fd00d5be0..f7dc33d8b 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -585,9 +585,9 @@ implementation // Project ClassHelpers.UControls, ClassHelpers.UGraphics, - DB.UCategory, - DB.UMain, - DB.USnippet, + DB.Categories, + DB.Main, + DB.Snippets, DB.Vaults, FmSplash, FmTrappedBugReportDlg, diff --git a/Src/FmRenameCategoryDlg.dfm b/Src/FmRenameCategoryDlg.dfm index f0e9bbe65..4ba71bbd2 100644 --- a/Src/FmRenameCategoryDlg.dfm +++ b/Src/FmRenameCategoryDlg.dfm @@ -1,5 +1,7 @@ inherited RenameCategoryDlg: TRenameCategoryDlg Caption = 'Rename Category' + ExplicitWidth = 320 + ExplicitHeight = 240 PixelsPerInch = 96 TextHeight = 13 inherited pnlBody: TPanel @@ -10,10 +12,6 @@ inherited RenameCategoryDlg: TRenameCategoryDlg Height = 240 TabOrder = 0 TabStop = True - inherited lblCategories: TLabel - Width = 60 - ExplicitWidth = 60 - end end inline frmDescription: TCategoryDescEditFrame Left = 0 @@ -23,10 +21,6 @@ inherited RenameCategoryDlg: TRenameCategoryDlg TabOrder = 1 TabStop = True ExplicitTop = 120 - inherited lblError: TLabel - Width = 108 - ExplicitWidth = 108 - end end end inherited btnOK: TButton diff --git a/Src/FmRenameCategoryDlg.pas b/Src/FmRenameCategoryDlg.pas index 039d6905a..2c9ddc178 100644 --- a/Src/FmRenameCategoryDlg.pas +++ b/Src/FmRenameCategoryDlg.pas @@ -18,9 +18,16 @@ interface uses // Delphi - Forms, StdCtrls, Controls, ExtCtrls, Classes, + Forms, + StdCtrls, + Controls, + ExtCtrls, + Classes, // Project - DB.UCategory, FmCategoryEditDlg, FrCategoryList, FrCategoryDescEdit, + DB.Categories, + FmCategoryEditDlg, + FrCategoryList, + FrCategoryDescEdit, UBaseObjects; @@ -92,7 +99,9 @@ implementation // Delphi Windows {for inlining}, // Project - DB.UMain, UCtrlArranger, UStrUtils; + DB.Main, + UCtrlArranger, + UStrUtils; {$R *.dfm} diff --git a/Src/FmSelectionSearchDlg.pas b/Src/FmSelectionSearchDlg.pas index dcb246ffc..5278670c0 100644 --- a/Src/FmSelectionSearchDlg.pas +++ b/Src/FmSelectionSearchDlg.pas @@ -26,7 +26,7 @@ interface Buttons, Menus, // Project - DB.USnippet, + DB.Snippets, DB.Vaults, FmGenericOKDlg, FrCheckedTV, @@ -118,7 +118,7 @@ implementation SysUtils, Types, // Project - DB.UMain, + DB.Main, UCtrlArranger, UQuery; diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index 0657900ea..dc9c21ac3 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -33,7 +33,7 @@ interface // Project ActiveText.UMain, Compilers.UGlobals, - DB.USnippet, + DB.Snippets, DB.Vaults, FmGenericOKDlg, FrBrowserBase, @@ -297,10 +297,10 @@ implementation // Delphi Windows {for inlining}, Graphics, // Project + DB.Categories, + DB.Main, DB.SnippetIDs, - DB.UCategory, - DB.UMain, - DB.USnippetKind, + DB.SnippetKind, FmDependenciesDlg, IntfCommon, UColours, diff --git a/Src/FmTestCompileDlg.dfm b/Src/FmTestCompileDlg.dfm index f6e44ee4a..54610b754 100644 --- a/Src/FmTestCompileDlg.dfm +++ b/Src/FmTestCompileDlg.dfm @@ -10,7 +10,7 @@ inherited TestCompileDlg: TTestCompileDlg object lblSnippetName: TLabel Left = 96 Top = 8 - Width = 89 + Width = 88 Height = 13 Caption = 'lblSnippetName' Font.Charset = DEFAULT_CHARSET @@ -23,7 +23,7 @@ inherited TestCompileDlg: TTestCompileDlg object lblSnippetNameDesc: TLabel Left = 0 Top = 8 - Width = 53 + Width = 55 Height = 13 Caption = 'Results for ' end diff --git a/Src/FmTestCompileDlg.pas b/Src/FmTestCompileDlg.pas index 0cec0e356..cb66b4778 100644 --- a/Src/FmTestCompileDlg.pas +++ b/Src/FmTestCompileDlg.pas @@ -15,10 +15,21 @@ interface uses - Classes, ActnList, StdCtrls, Forms, Controls, ExtCtrls, Messages, + // Delphi + Classes, + ActnList, + StdCtrls, + Forms, + Controls, + ExtCtrls, + Messages, Generics.Collections, - - Compilers.UGlobals, DB.USnippet, FmGenericViewDlg, UBaseObjects, UCompileMgr, + // Project + Compilers.UGlobals, + DB.Snippets, + FmGenericViewDlg, + UBaseObjects, + UCompileMgr, ULEDImageList; type diff --git a/Src/FrCategoryDescEdit.pas b/Src/FrCategoryDescEdit.pas index b5dd958ea..ed292b441 100644 --- a/Src/FrCategoryDescEdit.pas +++ b/Src/FrCategoryDescEdit.pas @@ -117,7 +117,12 @@ implementation // Delphi Windows {for inlining}, // Project - DB.UCategory, DB.UMain, UColours, UCtrlArranger, UFontHelper, UStrUtils; + DB.Categories, + DB.Main, + UColours, + UCtrlArranger, + UFontHelper, + UStrUtils; {$R *.dfm} diff --git a/Src/FrCategoryList.pas b/Src/FrCategoryList.pas index c2068de05..9711362e2 100644 --- a/Src/FrCategoryList.pas +++ b/Src/FrCategoryList.pas @@ -23,7 +23,7 @@ interface StdCtrls, Classes, // Project - DB.UCategory, + DB.Categories, UI.Adapters.CategoryList; @@ -93,7 +93,8 @@ implementation // Delphi SysUtils, // Project - DB.UMain, UCtrlArranger; + DB.Main, + UCtrlArranger; {$R *.dfm} diff --git a/Src/FrOverview.pas b/Src/FrOverview.pas index 09dd79dea..8e8f8d029 100644 --- a/Src/FrOverview.pas +++ b/Src/FrOverview.pas @@ -27,7 +27,7 @@ interface ToolWin, Menus, // Project - DB.USnippet, + DB.Snippets, DB.Vaults, FrTitled, IntfFrameMgrs, diff --git a/Src/FrSelectSnippets.pas b/Src/FrSelectSnippets.pas index 6552d8ead..9bb9d3152 100644 --- a/Src/FrSelectSnippets.pas +++ b/Src/FrSelectSnippets.pas @@ -18,9 +18,14 @@ interface uses // Delphi - ImgList, Controls, Classes, ComCtrls, + ImgList, + Controls, + Classes, + ComCtrls, // Project - DB.UCategory, DB.USnippet, FrSelectSnippetsBase; + DB.Categories, + DB.Snippets, + FrSelectSnippetsBase; type diff --git a/Src/FrSelectSnippetsBase.pas b/Src/FrSelectSnippetsBase.pas index 09278872f..3410d6849 100644 --- a/Src/FrSelectSnippetsBase.pas +++ b/Src/FrSelectSnippetsBase.pas @@ -23,8 +23,8 @@ interface Classes, ComCtrls, // Project - DB.UCategory, - DB.USnippet, + DB.Categories, + DB.Snippets, DB.Vaults, FrCheckedTV, USnippetsTVDraw; @@ -133,7 +133,7 @@ implementation SysUtils, StdCtrls, // Project - DB.UMain, + DB.Main, UGroups; diff --git a/Src/FrSelectUserSnippets.pas b/Src/FrSelectUserSnippets.pas index 155d770c2..77850d845 100644 --- a/Src/FrSelectUserSnippets.pas +++ b/Src/FrSelectUserSnippets.pas @@ -18,9 +18,14 @@ interface uses // Delphi - ImgList, Controls, Classes, ComCtrls, + ImgList, + Controls, + Classes, + ComCtrls, // Project - DB.UCategory, DB.USnippet, FrSelectSnippetsBase; + DB.Categories, + DB.Snippets, + FrSelectSnippetsBase; type diff --git a/Src/FrSnippetLayoutPrefs.pas b/Src/FrSnippetLayoutPrefs.pas index a16cc1da4..7cc78daee 100644 --- a/Src/FrSnippetLayoutPrefs.pas +++ b/Src/FrSnippetLayoutPrefs.pas @@ -18,9 +18,17 @@ interface uses // Delphi - StdCtrls, ImgList, Controls, Classes, ActnList, Buttons, + StdCtrls, + ImgList, + Controls, + Classes, + ActnList, + Buttons, // Project - DB.USnippetKind, FrPrefsBase, UPreferences, USnippetPageStructure; + DB.SnippetKind, + FrPrefsBase, + UPreferences, + USnippetPageStructure; type TSnippetLayoutPrefsFrame = class(TPrefsBaseFrame) diff --git a/Src/IntfFrameMgrs.pas b/Src/IntfFrameMgrs.pas index 0f409800c..5f840085e 100644 --- a/Src/IntfFrameMgrs.pas +++ b/Src/IntfFrameMgrs.pas @@ -20,7 +20,11 @@ interface // Delphi SHDocVw, ActiveX, // Project - Browser.IntfDocHostUI, DB.USnippet, Compilers.UGlobals, UCommandBars, UView; + Browser.IntfDocHostUI, + DB.Snippets, + Compilers.UGlobals, + UCommandBars, + UView; const diff --git a/Src/SWAG.UImporter.pas b/Src/SWAG.UImporter.pas index bc8fc3f49..2722761d4 100644 --- a/Src/SWAG.UImporter.pas +++ b/Src/SWAG.UImporter.pas @@ -21,8 +21,8 @@ interface Generics.Collections, // Project ActiveText.UMain, - DB.UCategory, - DB.USnippet, + DB.Categories, + DB.Snippets, DB.Vaults, SWAG.UCommon; @@ -103,8 +103,8 @@ implementation // Delphi SysUtils, // Project - DB.UMain, - DB.USnippetKind, + DB.Main, + DB.SnippetKind, USnippetValidator; diff --git a/Src/UCategoryAction.pas b/Src/UCategoryAction.pas index 7e888c185..8b492e5a5 100644 --- a/Src/UCategoryAction.pas +++ b/Src/UCategoryAction.pas @@ -64,7 +64,9 @@ implementation uses // Project - DB.UCategory, DB.UMain, UView; + DB.Categories, + DB.Main, + UView; { TCategoryAction } diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index 5dfaf312d..99601eb41 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -157,9 +157,9 @@ implementation Classes, // Project ActiveText.UMain, + DB.Main, DB.SnippetIDs, - DB.UMain, - DB.USnippet, + DB.Snippets, IntfCommon, UIOUtils, UStrUtils; diff --git a/Src/UCodeShareMgr.pas b/Src/UCodeShareMgr.pas index 1da428608..a88b2aecb 100644 --- a/Src/UCodeShareMgr.pas +++ b/Src/UCodeShareMgr.pas @@ -18,7 +18,7 @@ interface uses // Project - DB.USnippet, + DB.Snippets, UBaseObjects, UView; @@ -59,7 +59,7 @@ implementation // Delphi SysUtils, // Project - DB.UMain, + DB.Main, DB.Vaults, FmCodeExportDlg, FmCodeImportDlg, diff --git a/Src/UCompileMgr.pas b/Src/UCompileMgr.pas index ded36eca3..d32349bf4 100644 --- a/Src/UCompileMgr.pas +++ b/Src/UCompileMgr.pas @@ -20,7 +20,9 @@ interface // Delphi Classes, Controls, // Project - Compilers.UGlobals, DB.USnippet, UView; + Compilers.UGlobals, + DB.Snippets, + UView; type @@ -138,7 +140,7 @@ implementation Compilers.UAutoDetect, Compilers.UCompilers, Compilers.USettings, - DB.UMain, + DB.Main, FmCompErrorDlg, FmCompilersDlg, FmRegisterCompilersDlg, diff --git a/Src/UDatabaseLoader.pas b/Src/UDatabaseLoader.pas index d91c11120..60cf74f72 100644 --- a/Src/UDatabaseLoader.pas +++ b/Src/UDatabaseLoader.pas @@ -57,7 +57,8 @@ implementation uses // Project - UQuery, DB.UMain; + UQuery, + DB.Main; { TDatabaseLoader } diff --git a/Src/UDetailPageHTML.pas b/Src/UDetailPageHTML.pas index 1880e09f2..4389e393b 100644 --- a/Src/UDetailPageHTML.pas +++ b/Src/UDetailPageHTML.pas @@ -68,8 +68,8 @@ implementation // Project Compilers.UGlobals, Compilers.UCompilers, - DB.UMain, - DB.USnippet, + DB.Main, + DB.Snippets, DB.Vaults, UConsts, UContainers, diff --git a/Src/UDialogMgr.pas b/Src/UDialogMgr.pas index be168c158..bbbe56204 100644 --- a/Src/UDialogMgr.pas +++ b/Src/UDialogMgr.pas @@ -19,7 +19,9 @@ interface // Delphi Classes, // Project - DB.USnippet, UCompileMgr, USearch; + DB.Snippets, + UCompileMgr, + USearch; type diff --git a/Src/UGroups.pas b/Src/UGroups.pas index 1b69a0794..f8f3262bf 100644 --- a/Src/UGroups.pas +++ b/Src/UGroups.pas @@ -19,7 +19,11 @@ interface // Delphi Generics.Collections, // Project - DB.UCategory, DB.USnippet, DB.USnippetKind, UContainers, UInitialLetter; + DB.Categories, + DB.SnippetKind, + DB.Snippets, + UContainers, + UInitialLetter; type @@ -262,7 +266,8 @@ implementation // Delphi Generics.Defaults, // Project - DB.UMain, UStrUtils; + DB.Main, + UStrUtils; { TGrouping } diff --git a/Src/UHistory.pas b/Src/UHistory.pas index 44bca7d20..3213e8038 100644 --- a/Src/UHistory.pas +++ b/Src/UHistory.pas @@ -108,7 +108,8 @@ implementation // Delphi SysUtils, // Project - DB.UMain, UExceptions; + DB.Main, + UExceptions; { THistory } diff --git a/Src/UI.Adapters.CategoryList.pas b/Src/UI.Adapters.CategoryList.pas index d1b197b86..0758d44e7 100644 --- a/Src/UI.Adapters.CategoryList.pas +++ b/Src/UI.Adapters.CategoryList.pas @@ -21,7 +21,8 @@ interface // Delphi Classes, // Project - DB.UCategory, UContainers; + DB.Categories, + UContainers; type diff --git a/Src/UI.Adapters.SnippetKindList.pas b/Src/UI.Adapters.SnippetKindList.pas index d6e4386d1..35218b669 100644 --- a/Src/UI.Adapters.SnippetKindList.pas +++ b/Src/UI.Adapters.SnippetKindList.pas @@ -21,7 +21,9 @@ interface // Delphi Classes, // Project - DB.USnippet, DB.USnippetKind, UContainers; + DB.SnippetKind, + DB.Snippets, + UContainers; type diff --git a/Src/UMainDisplayMgr.pas b/Src/UMainDisplayMgr.pas index e9c1f5459..14e52a6e7 100644 --- a/Src/UMainDisplayMgr.pas +++ b/Src/UMainDisplayMgr.pas @@ -301,7 +301,9 @@ implementation // Delphi SysUtils, // Project - DB.UMain, UPreferences, UQuery; + DB.Main, + UPreferences, + UQuery; { TMainDisplayMgr } diff --git a/Src/UOverviewTreeBuilder.pas b/Src/UOverviewTreeBuilder.pas index 87a32f23c..8526a5ada 100644 --- a/Src/UOverviewTreeBuilder.pas +++ b/Src/UOverviewTreeBuilder.pas @@ -20,7 +20,10 @@ interface // Delphu ComCtrls, // Project - DB.USnippet, UGroups, UView, UViewItemTreeNode; + DB.Snippets, + UGroups, + UView, + UViewItemTreeNode; type diff --git a/Src/UPrintDocuments.pas b/Src/UPrintDocuments.pas index b98950def..ee8b5d5dc 100644 --- a/Src/UPrintDocuments.pas +++ b/Src/UPrintDocuments.pas @@ -20,7 +20,10 @@ interface // Delphi Classes, // Project - DB.UCategory, DB.USnippet, Hiliter.UGlobals, URTFUtils; + DB.Categories, + DB.Snippets, + Hiliter.UGlobals, + URTFUtils; type diff --git a/Src/UPrintMgr.pas b/Src/UPrintMgr.pas index 4c72fc589..242e9290e 100644 --- a/Src/UPrintMgr.pas +++ b/Src/UPrintMgr.pas @@ -20,7 +20,12 @@ interface // Delphi Classes, // Project - DB.USnippet, UBaseObjects, UPrintDocuments, UPrintInfo, URTFUtils, UView; + DB.Snippets, + UBaseObjects, + UPrintDocuments, + UPrintInfo, + URTFUtils, + UView; type diff --git a/Src/UQuery.pas b/Src/UQuery.pas index a3af9870d..49fca8d51 100644 --- a/Src/UQuery.pas +++ b/Src/UQuery.pas @@ -18,7 +18,9 @@ interface uses // Project - DB.UCategory, DB.USnippet, USearch; + DB.Categories, + DB.Snippets, + USearch; type @@ -90,9 +92,12 @@ implementation uses // Delphi - SysUtils, Generics.Collections, + SysUtils, + Generics.Collections, // Project - DB.UMain, UBaseObjects, USingleton; + DB.Main, + UBaseObjects, + USingleton; type diff --git a/Src/URTFCategoryDoc.pas b/Src/URTFCategoryDoc.pas index 8040ff095..192decb40 100644 --- a/Src/URTFCategoryDoc.pas +++ b/Src/URTFCategoryDoc.pas @@ -20,7 +20,11 @@ interface // Delphi Graphics, // Project - ActiveText.URTFRenderer, DB.UCategory, DB.USnippet, UEncodings, URTFBuilder, + ActiveText.URTFRenderer, + DB.Categories, + DB.Snippets, + UEncodings, + URTFBuilder, URTFStyles; diff --git a/Src/USaveUnitMgr.pas b/Src/USaveUnitMgr.pas index 5cbc118bd..0994e0cd6 100644 --- a/Src/USaveUnitMgr.pas +++ b/Src/USaveUnitMgr.pas @@ -20,7 +20,7 @@ interface // Delphi Generics.Collections, // Project - DB.USnippet, + DB.Snippets, DB.Vaults, UIStringList, USourceFileInfo, diff --git a/Src/USearch.pas b/Src/USearch.pas index dd42b678d..c7cb20492 100644 --- a/Src/USearch.pas +++ b/Src/USearch.pas @@ -22,7 +22,7 @@ interface // Project Compilers.UGlobals, DB.SnippetIDs, - DB.USnippet, + DB.Snippets, UBaseObjects; @@ -299,9 +299,13 @@ implementation uses // Delphi - SysUtils, Character, + SysUtils, + Character, // Project - DB.UMain, IntfCommon, UConsts, UStrUtils; + DB.Main, + IntfCommon, + UConsts, + UStrUtils; type diff --git a/Src/USelectionIOMgr.pas b/Src/USelectionIOMgr.pas index f4e048aec..1a00bbd9e 100644 --- a/Src/USelectionIOMgr.pas +++ b/Src/USelectionIOMgr.pas @@ -47,7 +47,7 @@ implementation Dialogs, // Project DB.SnippetIDs, - DB.USnippet, + DB.Snippets, UConsts, UMessageBox, UOpenDialogEx, diff --git a/Src/USnippetAction.pas b/Src/USnippetAction.pas index ca26a3260..1ff6f3299 100644 --- a/Src/USnippetAction.pas +++ b/Src/USnippetAction.pas @@ -75,8 +75,8 @@ implementation uses // Project - DB.UMain, - DB.USnippet, + DB.Main, + DB.Snippets, UView; diff --git a/Src/USnippetDoc.pas b/Src/USnippetDoc.pas index 559f712dc..0add0e284 100644 --- a/Src/USnippetDoc.pas +++ b/Src/USnippetDoc.pas @@ -24,7 +24,7 @@ interface DB.Vaults, ActiveText.UMain, Compilers.UGlobals, - DB.USnippet, + DB.Snippets, UEncodings, UIStringList; @@ -124,9 +124,9 @@ implementation // Project Compilers.UCompilers, DB.DataFormats, + DB.Main, DB.MetaData, - DB.UMain, - DB.USnippetKind, + DB.SnippetKind, UStrUtils, UUrl; diff --git a/Src/USnippetHTML.pas b/Src/USnippetHTML.pas index 48c19f26d..219cfe56a 100644 --- a/Src/USnippetHTML.pas +++ b/Src/USnippetHTML.pas @@ -17,7 +17,9 @@ interface uses // Project - ActiveText.UMain, DB.UCategory, DB.USnippet; + ActiveText.UMain, + DB.Categories, + DB.Snippets; type @@ -96,9 +98,19 @@ implementation // Delphi SysUtils, // Project - ActiveText.UHTMLRenderer, DB.UMain, DB.USnippetKind, Hiliter.UAttrs, - Hiliter.UGlobals, Hiliter.UHiliters, UCompResHTML, UHTMLBuilder, - UHTMLUtils, UIStringList, UJavaScriptUtils, UResourceUtils, UStrUtils; + ActiveText.UHTMLRenderer, + DB.Main, + DB.SnippetKind, + Hiliter.UAttrs, + Hiliter.UGlobals, + Hiliter.UHiliters, + UCompResHTML, + UHTMLBuilder, + UHTMLUtils, + UIStringList, + UJavaScriptUtils, + UResourceUtils, + UStrUtils; { TSnippetHTML } diff --git a/Src/USnippetPageHTML.pas b/Src/USnippetPageHTML.pas index a4871cc06..a938fe2c1 100644 --- a/Src/USnippetPageHTML.pas +++ b/Src/USnippetPageHTML.pas @@ -19,7 +19,9 @@ interface uses // Project - DB.USnippet, USnippetHTML, USnippetPageStructure; + DB.Snippets, + USnippetHTML, + USnippetPageStructure; type diff --git a/Src/USnippetPageStructure.pas b/Src/USnippetPageStructure.pas index a30989be0..6ee8ae576 100644 --- a/Src/USnippetPageStructure.pas +++ b/Src/USnippetPageStructure.pas @@ -16,7 +16,12 @@ interface uses Generics.Collections, - DB.USnippetKind, IntfCommon, UBaseObjects, UContainers, USettings, USingleton; + DB.SnippetKind, + IntfCommon, + UBaseObjects, + UContainers, + USettings, + USingleton; type diff --git a/Src/USnippetSourceGen.pas b/Src/USnippetSourceGen.pas index 94301edfd..ef041f954 100644 --- a/Src/USnippetSourceGen.pas +++ b/Src/USnippetSourceGen.pas @@ -95,8 +95,8 @@ implementation SysUtils, // Project DB.DataFormats, - DB.USnippet, - DB.USnippetKind, + DB.SnippetKind, + DB.Snippets, UConsts, UAppInfo, UQuery, diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index 4c4af42ca..3bcb60348 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -18,8 +18,8 @@ interface uses // Project ActiveText.UMain, - DB.USnippet, - DB.USnippetKind, + DB.SnippetKind, + DB.Snippets, DB.Vaults, UBaseObjects, UStructs; @@ -133,7 +133,7 @@ implementation SysUtils, // Project ActiveText.UValidator, - DB.UMain, + DB.Main, UStrUtils; diff --git a/Src/USnippetsChkListMgr.pas b/Src/USnippetsChkListMgr.pas index 803d737f6..0c0ac195a 100644 --- a/Src/USnippetsChkListMgr.pas +++ b/Src/USnippetsChkListMgr.pas @@ -23,7 +23,7 @@ interface Windows, // Project DB.SnippetIDs, - DB.USnippet; + DB.Snippets; type diff --git a/Src/USourceGen.pas b/Src/USourceGen.pas index 3d9edf2a7..6736b46fc 100644 --- a/Src/USourceGen.pas +++ b/Src/USourceGen.pas @@ -18,9 +18,13 @@ interface uses // Delphi - Classes, Generics.Collections, + Classes, + Generics.Collections, // Project - ActiveText.UMain, DB.USnippet, UBaseObjects, UIStringList; + ActiveText.UMain, + DB.Snippets, + UBaseObjects, + UIStringList; type @@ -250,10 +254,18 @@ implementation uses // Delphi - SysUtils, Character, + SysUtils, + Character, // Project - ActiveText.UTextRenderer, DB.USnippetKind, UConsts, UExceptions, UPreferences, - USnippetValidator, UStrUtils, UWarnings, Hiliter.UPasLexer; + ActiveText.UTextRenderer, + DB.SnippetKind, + UConsts, + UExceptions, + UPreferences, + USnippetValidator, + UStrUtils, + UWarnings, + Hiliter.UPasLexer; const diff --git a/Src/UStatusBarMgr.pas b/Src/UStatusBarMgr.pas index b15c5da8c..6402d05fc 100644 --- a/Src/UStatusBarMgr.pas +++ b/Src/UStatusBarMgr.pas @@ -121,7 +121,7 @@ implementation SysUtils, Forms, // Project - DB.UMain, + DB.Main, DB.Vaults, UQuery, USearch, diff --git a/Src/UTestCompile.pas b/Src/UTestCompile.pas index 210a74b6e..516882852 100644 --- a/Src/UTestCompile.pas +++ b/Src/UTestCompile.pas @@ -20,7 +20,9 @@ interface // Delphi Classes, // Project - Compilers.UGlobals, DB.USnippet, UBaseObjects; + Compilers.UGlobals, + DB.Snippets, + UBaseObjects; type diff --git a/Src/UTestCompileUI.pas b/Src/UTestCompileUI.pas index 8df82ec99..eb8fa14f0 100644 --- a/Src/UTestCompileUI.pas +++ b/Src/UTestCompileUI.pas @@ -21,7 +21,9 @@ interface // Delphi SysUtils, Classes, // Project - Compilers.UGlobals, DB.USnippet, UBaseObjects; + Compilers.UGlobals, + DB.Snippets, + UBaseObjects; type diff --git a/Src/UTestUnit.pas b/Src/UTestUnit.pas index d0b3f7a92..4d4059e86 100644 --- a/Src/UTestUnit.pas +++ b/Src/UTestUnit.pas @@ -18,7 +18,7 @@ interface uses // Project - DB.USnippet; + DB.Snippets; type @@ -65,7 +65,12 @@ implementation // Delphi SysUtils, // Project - DB.USnippetKind, UEncodings, UIOUtils, USourceGen, USystemInfo, UUnitAnalyser, + DB.SnippetKind, + UEncodings, + UIOUtils, + USourceGen, + USystemInfo, + UUnitAnalyser, UUtils; diff --git a/Src/UTestUnitDlgMgr.pas b/Src/UTestUnitDlgMgr.pas index 05025efe5..756873fd9 100644 --- a/Src/UTestUnitDlgMgr.pas +++ b/Src/UTestUnitDlgMgr.pas @@ -20,7 +20,8 @@ interface // Delphi Classes, // Project - DB.USnippet, UBaseObjects; + DB.Snippets, + UBaseObjects; type diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index b0d0895a7..b2ae2649b 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -21,8 +21,8 @@ interface // Delphi Classes, // Project + DB.Categories, DB.SnippetIDs, - DB.UCategory, UBaseObjects, UView; @@ -96,8 +96,8 @@ implementation Windows {for inlining}, IOUtils, // Project - DB.UMain, - DB.USnippet, + DB.Main, + DB.Snippets, DB.Vaults, FmAddCategoryDlg, UI.Forms.BackupVaultDlg, diff --git a/Src/UView.pas b/Src/UView.pas index d533113ad..0002c6539 100644 --- a/Src/UView.pas +++ b/Src/UView.pas @@ -20,9 +20,9 @@ interface // Delphi Generics.Collections, // Project - DB.UCategory, - DB.USnippet, - DB.USnippetKind, + DB.Categories, + DB.SnippetKind, + DB.Snippets, UBaseObjects, UInitialLetter; @@ -198,8 +198,8 @@ implementation // Delphi SysUtils, // Project + DB.Main, DB.SnippetIDs, - DB.UMain, UExceptions, UStrUtils; diff --git a/Src/UXMLDocHelper.pas b/Src/UXMLDocHelper.pas index 9ebb91700..c2a4c7eb8 100644 --- a/Src/UXMLDocHelper.pas +++ b/Src/UXMLDocHelper.pas @@ -21,7 +21,7 @@ interface XMLIntf, // Project Compilers.UGlobals, - DB.USnippetKind, + DB.SnippetKind, UBaseObjects, UExceptions, UIStringList, From e7ecd8fd3e5bc7e041b7ad89e0e116c623385d48 Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 7 Mar 2025 09:55:05 +0000 Subject: [PATCH 221/222] Refactor out IDatabaseEdit interface Moved all methods of IDatabaseEdit into IDatabase then deleted IDatabaseEdit. Updated code in all units affected by the change. Note that TDatabase implemented both IDatabase and IDatabaseEdit. Calling code needing to use IDatabaseEdit previously had to cast the Database singleton to IDatabaseEdit to access its methods. Such casting is no longer required. --- Src/DB.IO.ImportExport.CS4.pas | 15 ++-- Src/DB.Main.pas | 159 +++++++++++++++++---------------- Src/FmAddCategoryDlg.pas | 4 +- Src/FmDeleteCategoryDlg.pas | 2 +- Src/FmDependenciesDlg.pas | 2 +- Src/FmDuplicateSnippetDlg.pas | 6 +- Src/FmMain.pas | 15 ++-- Src/FmRenameCategoryDlg.pas | 4 +- Src/FmSnippetsEditorDlg.pas | 14 ++- Src/SWAG.UImporter.pas | 6 +- Src/UCodeImportMgr.pas | 8 +- Src/UCompileMgr.pas | 4 +- Src/USearch.pas | 4 +- Src/USnippetValidator.pas | 4 +- Src/UStatusBarMgr.pas | 2 +- Src/UUserDBMgr.pas | 10 +-- 16 files changed, 122 insertions(+), 137 deletions(-) diff --git a/Src/DB.IO.ImportExport.CS4.pas b/Src/DB.IO.ImportExport.CS4.pas index f1cf58f86..6ee46376d 100644 --- a/Src/DB.IO.ImportExport.CS4.pas +++ b/Src/DB.IO.ImportExport.CS4.pas @@ -282,8 +282,7 @@ constructor TCS4SnippetExporter.InternalCreate(const SnipList: TSnippetList); // Create map of actual snippet ID to new unique key with default vault for Snippet in SnipList do fSnippetKeyMap.Add( - Snippet.ID, - (Database as IDatabaseEdit).GetUniqueSnippetKey(TVaultID.Default) + Snippet.ID, Database.GetUniqueSnippetKey(TVaultID.Default) ); end; @@ -428,7 +427,7 @@ class procedure TCS4SnippetImporter.EnsureImportCategoryExists; begin ImportCatData.Init; ImportCatData.Desc := ImportCatDesc; - (Database as IDatabaseEdit).AddCategory(ImportCatID, ImportCatData); + Database.AddCategory(ImportCatID, ImportCatData); end; end; @@ -515,8 +514,7 @@ procedure TCS4SnippetImporter.Execute(const Data: TBytes); fSnippetInfo[Idx].Key := SnippetNode.Attributes[ TCS4ImportExportDocHelper.SnippetNodeNameAttr ]; - fSnippetInfo[Idx].Data := - (Database as IDatabaseEdit).GetEditableSnippetInfo; + fSnippetInfo[Idx].Data := Database.GetEditableSnippetInfo; fSnippetInfo[Idx].Data.Props.Cat := ImportCatID; fSnippetInfo[Idx].Data.Props.Desc := GetDescription(SnippetNode); fSnippetInfo[Idx].Data.Props.DisplayName := @@ -525,9 +523,10 @@ procedure TCS4SnippetImporter.Execute(const Data: TBytes); ); if fSnippetInfo[Idx].Data.Props.DisplayName = '' then fSnippetInfo[Idx].Data.Props.DisplayName := fSnippetInfo[Idx].Key; - fSnippetInfo[Idx].Data.Props.SourceCode := TCS4ImportExportDocHelper.GetSubTagText( - fXMLDoc, SnippetNode, TCS4ImportExportDocHelper.SourceCodeTextNodeName - ); + fSnippetInfo[Idx].Data.Props.SourceCode := + TCS4ImportExportDocHelper.GetSubTagText( + fXMLDoc, SnippetNode, TCS4ImportExportDocHelper.SourceCodeTextNodeName + ); fSnippetInfo[Idx].Data.Props.HiliteSource := TCS4ImportExportDocHelper.GetHiliteSource(fXMLDoc, SnippetNode, True); // how we read extra property depends on version of file diff --git a/Src/DB.Main.pas b/Src/DB.Main.pas index 6c25a360b..c0a33064c 100644 --- a/Src/DB.Main.pas +++ b/Src/DB.Main.pas @@ -168,18 +168,6 @@ interface {Gets list of categories in the database. @return Required list. } - property Categories: TCategoryList read GetCategories; - {List of categories in the database} - property Snippets: TSnippetList read GetSnippets; - {List of snippets in the database} - end; - - { - IDatabaseEdit: - Interface to object that can be used to edit the database. - } - IDatabaseEdit = interface(IInterface) - ['{CBF6FBB0-4C18-481F-A378-84BB09E5ECF4}'] /// Creates a new snippet key that is unique within the given /// vault. @@ -188,25 +176,29 @@ interface /// string containing the key. function GetUniqueSnippetKey(const AVaultID: TVaultID): string; + /// Provides details of all a snippet's data (properties and + /// references) that may be edited. + /// TSnippet [in] Snippet for which data is + /// required. May be nil in which case a blank record is returned. + /// TSnippetEditData. Required data. function GetEditableSnippetInfo(const Snippet: TSnippet = nil): TSnippetEditData; - {Provides details of all a snippet's data (properties and references) that - may be edited. - @param Snippet [in] Snippet for which data is required. May be nil in - which case a blank record is returned. - @return Required data. - } + + /// Builds an ID list of all snippets that depend on a specified + /// snippet. + /// TSnippet [in] Snippet for which dependents + /// are required. + /// ISnippetIDList. List of IDs of dependent snippets. + /// function GetDependents(const Snippet: TSnippet): ISnippetIDList; - {Builds an ID list of all snippets that depend on a specified snippet. - @param Snippet [in] Snippet for which dependents are required. - @return List of IDs of dependent snippets. - } + + /// Builds an ID list of all snippets that cross reference a + /// specified snippet. + /// TSnippet [in] Snippet for which cross + /// referers are required. + /// ISnippetIDList. List of IDs of referring snippets. + /// function GetReferrers(const Snippet: TSnippet): ISnippetIDList; - {Builds an ID list of all snippets that cross reference a specified - snippet. - @param Snippet [in] Snippet for which cross referers are required. - @return List of IDs of referring snippets. - } /// Updates a snippet's properties and references using the /// provided data. @@ -260,51 +252,66 @@ interface function CreateTempSnippet(const AKey: string; const AVaultID: TVaultID; const AData: TSnippetEditData): TSnippet; overload; + /// Creates a new temporary copy of a snippet without adding it to + /// the Snippets object's snippets list. The new instance may not be added + /// to the Snippets object. + /// TSnippetList [in] Snippet to be copied. + /// + /// TSnippet [in] Reference to new copied snippet. + /// function CreateTempSnippet(const Snippet: TSnippet): TSnippet; overload; - {Creates a new temporary copy of a snippet without adding it to the - Snippets object's snippets list. The new instance may not be added to the - Snippets object. - @param Snippet [in] Snippet to be copied. - @return Reference to new copied snippet. - } + + /// Provides details of all a category's data that may be edited. + /// + /// TCategory [in] Category for which data is + /// required. May be nil in whih case a blank record is returned. + /// TCategoryData. Required data. + function GetEditableCategoryInfo(const Category: TCategory = nil): + TCategoryData; + + /// Adds a new category to the database. + /// string [in] ID of new category. + /// TCategoryData [in] Record storing new + /// category's properties. + /// TCategory. Reference to new category. + function AddCategory(const CatID: string; const Data: TCategoryData): + TCategory; + + /// Deletes a snippet from the database. + /// TSnippet [in] Snippet to be deleted. + /// procedure DeleteSnippet(const Snippet: TSnippet); - {Deletes a snippet from the database. - @param Snippet [in] Snippet to be deleted. - } - function GetEditableCategoryInfo( - const Category: TCategory = nil): TCategoryData; - {Provides details of all a category's data that may be edited. - @param Category [in] Category for which data is required. May be nil in - whih case a blank record is returned. - @return Required data. - } - function AddCategory(const CatID: string; - const Data: TCategoryData): TCategory; - {Adds a new category to the database. - @param CatID [in] ID of new category. - @param Data [in] Record storing new category's properties. - @return Reference to new category. - } + + /// Updates a category's properties. + /// TCategory [in] Category to be updated. + /// + /// TCategoryData [in] Record containing revised + /// data. + /// TCategory.Reference to updated category. Will have + /// changed. function UpdateCategory(const Category: TCategory; const Data: TCategoryData): TCategory; - {Updates a category's properties. - @param Category [in] Category to be updated. - @param Data [in] Record containing revised data. - @return Reference to updated category. Will have changed. - } + + /// Deletes a category and all its snippets from the database. + /// + /// TCategory [in] Category to be deleted. + /// procedure DeleteCategory(const Category: TCategory); - {Deletes a category and all its snippets from the database. - @param Category [in] Category to be deleted. - } + + /// Checks if the database has been updated since the last save. + /// + /// Boolean True if database has been updated, + /// False otherwise. function Updated: Boolean; - {Checks if the database has been updated since the last save. - @return True if database has been updated, False otherwise. - } + + /// Saves the database. procedure Save; - {Saves the database. - } - end; + property Categories: TCategoryList read GetCategories; + {List of categories in the database} + property Snippets: TSnippetList read GetSnippets; + {List of snippets in the database} + end; function Database: IDatabase; {Returns singleton instance of object that encapsulates the database. @@ -362,15 +369,11 @@ TDBDataItemFactory = class(TInterfacedObject, IDBDataItemFactory) end; - { - TDatabase: - Class that encapsulates the database. Provides access to all snippets and - all categories via the IDatabase interface. Also enables the database to be - modified via the IDatabaseEdit interface. - } + /// Class that encapsulates the database. Provides access to and + /// modify all snippets and all categories via the IDatabase interface. + /// TDatabase = class(TInterfacedObject, - IDatabase, - IDatabaseEdit + IDatabase ) strict private fUpdated: Boolean; // Flags if database has been updated @@ -485,14 +488,12 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) @param Handler [in] Handler to remove from list. } - { IDatabaseEdit methods } - /// Creates a new snippet key that is unique within the given /// vault. /// TVaultID ID of vault that the new key /// must be unique within. /// string containing the key. - /// Method of IDatabaseEdit. + /// Method of IDatabase. function GetUniqueSnippetKey(const AVaultID: TVaultID): string; function GetEditableSnippetInfo(const Snippet: TSnippet = nil): @@ -525,7 +526,7 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// /// The returned TSnippet object will be a different object /// to ASnippet. - /// Method of IDatabaseEdit. + /// Method of IDatabase. /// function UpdateSnippet(const ASnippet: TSnippet; const AData: TSnippetEditData): TSnippet; @@ -537,7 +538,7 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// TSnippetEditData [in] Record storing the new /// snippet's properties and references. /// TSnippet. Reference to the new snippet. - /// Method of IDatabaseEdit. + /// Method of IDatabase. function AddSnippet(const AKey: string; const AVaultID: TVaultID; const AData: TSnippetEditData): TSnippet; @@ -554,7 +555,7 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// duplicated snippet will belong. /// TSnippet. Reference to the duplicated snippet. /// - /// Method of IDatabaseEdit. + /// Method of IDatabase. function DuplicateSnippet(const ASnippet: TSnippet; const ANewKey: string; const ANewVaultID: TVaultID; const ANewDisplayName: string; const ACatID: string): TSnippet; @@ -569,7 +570,7 @@ TEventInfo = class(TInterfacedObject, IDatabaseChangeEventInfo) /// TSnippet Reference to new snippet. /// /// The returned snippet must not be added to the database. - /// Method of IDatabaseEdit. + /// Method of IDatabase. /// function CreateTempSnippet(const AKey: string; const AVaultID: TVaultID; const AData: TSnippetEditData): TSnippet; overload; diff --git a/Src/FmAddCategoryDlg.pas b/Src/FmAddCategoryDlg.pas index 12a873289..61dfdf96d 100644 --- a/Src/FmAddCategoryDlg.pas +++ b/Src/FmAddCategoryDlg.pas @@ -84,11 +84,11 @@ procedure TAddCategoryDlg.AddCategory(const Desc: string); var Data: TCategoryData; // category properties begin - Data := (Database as IDatabaseEdit).GetEditableCategoryInfo; + Data := Database.GetEditableCategoryInfo; Data.Desc := Desc; // add category with a unique id string as name (name must be unique and is // for internal use only) - (Database as IDatabaseEdit).AddCategory(TUniqueID.Generate, Data); + Database.AddCategory(TUniqueID.Generate, Data); end; procedure TAddCategoryDlg.ArrangeForm; diff --git a/Src/FmDeleteCategoryDlg.pas b/Src/FmDeleteCategoryDlg.pas index dfc6e43d2..6770f3814 100644 --- a/Src/FmDeleteCategoryDlg.pas +++ b/Src/FmDeleteCategoryDlg.pas @@ -125,7 +125,7 @@ procedure TDeleteCategoryDlg.ConfigForm; procedure TDeleteCategoryDlg.DeleteCategory(const Cat: TCategory); begin Assert(Cat.CanDelete, ClassName + '.DeleteCategory: Cat can''t be deleted'); - (Database as IDatabaseEdit).DeleteCategory(Cat); + Database.DeleteCategory(Cat); end; class function TDeleteCategoryDlg.Execute(AOwner: TComponent; diff --git a/Src/FmDependenciesDlg.pas b/Src/FmDependenciesDlg.pas index 433095f5f..c71d34724 100644 --- a/Src/FmDependenciesDlg.pas +++ b/Src/FmDependenciesDlg.pas @@ -460,7 +460,7 @@ procedure TDependenciesDlg.PopulateRequiredByList; // must only try to get dependents for snippet if it is in database if (tiRequiredBy in fTabs) and Assigned(ThisSnippet) then begin - Dependents := (Database as IDatabaseEdit).GetDependents(ThisSnippet); + Dependents := Database.GetDependents(ThisSnippet); for SnippetID in Dependents do begin ASnippet := Database.Snippets.Find(SnippetID); diff --git a/Src/FmDuplicateSnippetDlg.pas b/Src/FmDuplicateSnippetDlg.pas index d7e8bf6d1..d0b063dc8 100644 --- a/Src/FmDuplicateSnippetDlg.pas +++ b/Src/FmDuplicateSnippetDlg.pas @@ -144,9 +144,7 @@ procedure TDuplicateSnippetDlg.btnOKClick(Sender: TObject); begin try ValidateData; - fSnippetKey := (Database as IDatabaseEdit).GetUniqueSnippetKey( - SelectedVaultID - ); + fSnippetKey := Database.GetUniqueSnippetKey(SelectedVaultID); UpdateDatabase; except on E: Exception do @@ -231,7 +229,7 @@ function TDuplicateSnippetDlg.SelectedVaultID: TVaultID; procedure TDuplicateSnippetDlg.UpdateDatabase; begin - (Database as IDatabaseEdit).DuplicateSnippet( + Database.DuplicateSnippet( fSnippet, fSnippetKey, SelectedVaultID, diff --git a/Src/FmMain.pas b/Src/FmMain.pas index f7dc33d8b..ad12eb712 100644 --- a/Src/FmMain.pas +++ b/Src/FmMain.pas @@ -657,7 +657,7 @@ procedure TMainForm.actAddSnippetExecute(Sender: TObject); procedure TMainForm.actBackupVaultExecute(Sender: TObject); begin - if (Database as IDatabaseEdit).Updated then + if Database.Updated then TUserDBMgr.Save(Self); TUserDBMgr.BackupDatabase(Self); fStatusBarMgr.Update; @@ -760,7 +760,7 @@ procedure TMainForm.actDeleteSnippetExecute(Sender: TObject); procedure TMainForm.actDeleteVaultExecute(Sender: TObject); begin - if (Database as IDatabaseEdit).Updated then + if Database.Updated then TUserDBMgr.Save(Self); if TUserDBMgr.DeleteDatabase then begin @@ -947,7 +947,7 @@ procedure TMainForm.actLoadSelectionExecute(Sender: TObject); procedure TMainForm.actMoveVaultExecute(Sender: TObject); begin - if (Database as IDatabaseEdit).Updated then + if Database.Updated then TUserDBMgr.Save(Self); TUserDBMgr.MoveDatabase; end; @@ -1158,7 +1158,7 @@ procedure TMainForm.actUpdateDbaseExecute(Sender: TObject); if fDialogMgr.ExecDBUpdateDlg then begin // Database was updated: check if user database needs saving - if (Database as IDatabaseEdit).Updated + if Database.Updated and TMessageBox.Confirm(Self, sConfirmSave) then TUserDBMgr.Save(Self); // Reload the databases @@ -1325,14 +1325,11 @@ procedure TMainForm.FormCreate(Sender: TObject); end; procedure TMainForm.FormDestroy(Sender: TObject); -var - EditableDB: IDatabaseEdit; begin inherited; // Save any changes to user database - EditableDB := Database as IDatabaseEdit; - if EditableDB.Updated then - EditableDB.Save; + if Database.Updated then + Database.Save; // Unhook snippets event handler Database.RemoveChangeEventHandler(DBChangeHandler); diff --git a/Src/FmRenameCategoryDlg.pas b/Src/FmRenameCategoryDlg.pas index 2c9ddc178..6dac08204 100644 --- a/Src/FmRenameCategoryDlg.pas +++ b/Src/FmRenameCategoryDlg.pas @@ -212,9 +212,9 @@ procedure TRenameCategoryDlg.RenameCategory(const Category: TCategory; var EditData: TCategoryData; // category properties begin - EditData := (Database as IDatabaseEdit).GetEditableCategoryInfo(Category); + EditData := Database.GetEditableCategoryInfo(Category); EditData.Desc := NewDesc; - (Database as IDatabaseEdit).UpdateCategory(Category, EditData); + Database.UpdateCategory(Category, EditData); end; procedure TRenameCategoryDlg.UpdateOKBtn; diff --git a/Src/FmSnippetsEditorDlg.pas b/Src/FmSnippetsEditorDlg.pas index dc9c21ac3..c02a384ef 100644 --- a/Src/FmSnippetsEditorDlg.pas +++ b/Src/FmSnippetsEditorDlg.pas @@ -710,13 +710,9 @@ procedure TSnippetsEditorDlg.btnOKClick(Sender: TObject); fEditData.Assign(UpdateData); // Add or update snippet if Assigned(fSnippet) then - (Database as IDatabaseEdit).UpdateSnippet(fSnippet, fEditData) + Database.UpdateSnippet(fSnippet, fEditData) else - begin - (Database as IDatabaseEdit).AddSnippet( - UniqueSnippetKey, SelectedVaultID, fEditData - ) - end; + Database.AddSnippet(UniqueSnippetKey, SelectedVaultID, fEditData); except on E: Exception do HandleException(E); @@ -759,7 +755,7 @@ function TSnippetsEditorDlg.CreateTempSnippet: TSnippet; ValidateData; // Create snippet object from entered data EditData.Assign(UpdateData); - Result := (Database as IDatabaseEdit).CreateTempSnippet( + Result := Database.CreateTempSnippet( UniqueSnippetKey, SelectedVaultID, EditData ); end; @@ -955,7 +951,7 @@ procedure TSnippetsEditorDlg.InitForm; inherited; // Get data associated with snippet, or blank / default data if adding a new // snippet - fEditData := (Database as IDatabaseEdit).GetEditableSnippetInfo(fSnippet); + fEditData := Database.GetEditableSnippetInfo(fSnippet); // Populate controls with dynamic data PopulateControls; // Initialise controls to default values @@ -1038,7 +1034,7 @@ function TSnippetsEditorDlg.UniqueSnippetKey: string; if Assigned(fSnippet) then Result := fSnippet.Key else - Result := (Database as IDatabaseEdit).GetUniqueSnippetKey(SelectedVaultID); + Result := Database.GetUniqueSnippetKey(SelectedVaultID); end; function TSnippetsEditorDlg.UpdateData: TSnippetEditData; diff --git a/Src/SWAG.UImporter.pas b/Src/SWAG.UImporter.pas index 2722761d4..ae5cdafab 100644 --- a/Src/SWAG.UImporter.pas +++ b/Src/SWAG.UImporter.pas @@ -177,7 +177,7 @@ class procedure TSWAGImporter.EnsureSWAGCategoryExists; begin SWAGCatData.Init; SWAGCatData.Desc := SWAGCatDesc; - (Database as IDatabaseEdit).AddCategory(SWAGCatID, SWAGCatData); + Database.AddCategory(SWAGCatID, SWAGCatData); end; end; @@ -277,9 +277,9 @@ procedure TSWAGImporter.ImportPacketAsSnippet( SnippetKey: string; // unique ID of new snippet SnippetDetails: TSnippetEditData; // data describing new snippet begin - SnippetKey := (Database as IDatabaseEdit).GetUniqueSnippetKey(AVaultID); + SnippetKey := Database.GetUniqueSnippetKey(AVaultID); SnippetDetails := BuildSnippetInfo(SWAGPacket); - (Database as IDatabaseEdit).AddSnippet(SnippetKey, AVaultID, SnippetDetails); + Database.AddSnippet(SnippetKey, AVaultID, SnippetDetails); end; procedure TSWAGImporter.IncludePacket(const SWAGPacket: TSWAGPacket); diff --git a/Src/UCodeImportMgr.pas b/Src/UCodeImportMgr.pas index 99601eb41..4d7bc6e2d 100644 --- a/Src/UCodeImportMgr.pas +++ b/Src/UCodeImportMgr.pas @@ -214,7 +214,7 @@ procedure TCodeImportMgr.InitImportInfoList; fImportInfoList.Add( TImportInfo.Create( SnippetInfo.Key, - (Database as IDatabaseEdit).GetUniqueSnippetKey(RequestVaultCallback), + Database.GetUniqueSnippetKey(RequestVaultCallback), StrIf( SnippetInfo.Data.Props.DisplayName = '', SnippetInfo.Key, @@ -251,7 +251,6 @@ TSavedReferences = record end; var - Editor: IDatabaseEdit; // object used to update user database SnippetInfo: TSnippetInfo; // info about each snippet from import file ImportInfo: TImportInfo; // info about how / whether to import a snippet VaultID: TVaultID; // vault into which we're importing @@ -266,7 +265,6 @@ TSavedReferences = record fImportInfoList: include all required info in fImportInfoList? } - Editor := Database as IDatabaseEdit; VaultID := RequestVaultCallback(); SavedRefs := TList.Create( @@ -303,7 +301,7 @@ TSavedReferences = record SnippetDataNoRefs.Refs.Depends.Clear; // add snippet without any dependency - SavedRef.Snippet := Editor.AddSnippet( + SavedRef.Snippet := Database.AddSnippet( ImportInfo.NewKey, VaultID, SnippetDataNoRefs ); @@ -314,7 +312,7 @@ TSavedReferences = record // Add back the saved snippet references for SavedRef in SavedRefs do if SavedRef.Data.Refs.Depends.Count > 0 then - Editor.UpdateSnippet(SavedRef.Snippet, SavedRef.Data); + Database.UpdateSnippet(SavedRef.Snippet, SavedRef.Data); finally SavedRefs.Free; diff --git a/Src/UCompileMgr.pas b/Src/UCompileMgr.pas index d32349bf4..839585eb7 100644 --- a/Src/UCompileMgr.pas +++ b/Src/UCompileMgr.pas @@ -171,9 +171,7 @@ procedure TCompileMgr.Compile(const UIParent: TWinControl; DisplayProc(fCompilers); // Copy snippet to LastCompiledSnippet property fLastCompiledSnippet.Free; - fLastCompiledSnippet := (Database as IDatabaseEdit).CreateTempSnippet( - Snippet - ); + fLastCompiledSnippet := Database.CreateTempSnippet(Snippet); end; constructor TCompileMgr.Create(AOwner: TComponent); diff --git a/Src/USearch.pas b/Src/USearch.pas index c7cb20492..f2ead4dd7 100644 --- a/Src/USearch.pas +++ b/Src/USearch.pas @@ -1084,14 +1084,14 @@ procedure TXRefSearchFilter.ReferenceReverseRequired(const Snippet: TSnippet); begin if not (soRequiredReverse in fOptions) then Exit; - AddToXRefs((Database as IDatabaseEdit).GetDependents(Snippet)); + AddToXRefs(Database.GetDependents(Snippet)); end; procedure TXRefSearchFilter.ReferenceReverseSeeAlso(const Snippet: TSnippet); begin if not (soSeeAlsoReverse in fOptions) then Exit; - AddToXRefs((Database as IDatabaseEdit).GetReferrers(Snippet)); + AddToXRefs(Database.GetReferrers(Snippet)); end; procedure TXRefSearchFilter.ReferenceSeeAlso(const Snippet: TSnippet); diff --git a/Src/USnippetValidator.pas b/Src/USnippetValidator.pas index 3bcb60348..0ead99a70 100644 --- a/Src/USnippetValidator.pas +++ b/Src/USnippetValidator.pas @@ -273,9 +273,7 @@ class function TSnippetValidator.ValidateDependsList(const AKey: string; var TempSnippet: TSnippet; // temporary snippet that is checked for dependencies begin - TempSnippet := (Database as IDatabaseEdit).CreateTempSnippet( - AKey, AVaultID, AData - ); + TempSnippet := Database.CreateTempSnippet(AKey, AVaultID, AData); try Result := ValidateDependsList(TempSnippet, AErrorMsg); finally diff --git a/Src/UStatusBarMgr.pas b/Src/UStatusBarMgr.pas index 6402d05fc..239645380 100644 --- a/Src/UStatusBarMgr.pas +++ b/Src/UStatusBarMgr.pas @@ -386,7 +386,7 @@ procedure TStatusBarMgr.ShowUserDBInfo; // status bar to draw the panel. // We hide message if database not updated - fUserDBInfoVisible := (Database as IDatabaseEdit).Updated; + fUserDBInfoVisible := Database.Updated; fStatusBar.Repaint; end; diff --git a/Src/UUserDBMgr.pas b/Src/UUserDBMgr.pas index b2ae2649b..4df7cd68a 100644 --- a/Src/UUserDBMgr.pas +++ b/Src/UUserDBMgr.pas @@ -299,7 +299,7 @@ class function TUserDBMgr.CanRenameACategory: Boolean; class function TUserDBMgr.CanSave: Boolean; begin // We can save database if it's been changed - Result := (Database as IDatabaseEdit).Updated; + Result := Database.Updated; end; class procedure TUserDBMgr.DeleteACategory; @@ -367,7 +367,7 @@ class procedure TUserDBMgr.DeleteSnippet(ViewItem: IView); ClassName + '.Delete: Current view is not a snippet'); Snippet := (ViewItem as ISnippetView).Snippet; // Check if snippet has dependents: don't allow deletion if so - Dependents := (Database as IDatabaseEdit).GetDependents(Snippet); + Dependents := Database.GetDependents(Snippet); if Dependents.Count > 0 then begin TMessageBox.Error( @@ -380,7 +380,7 @@ class procedure TUserDBMgr.DeleteSnippet(ViewItem: IView); Exit; end; // Get permission to delete. If snippet has dependents list them in prompt - Referrers := (Database as IDatabaseEdit).GetReferrers(Snippet); + Referrers := Database.GetReferrers(Snippet); if Referrers.Count = 0 then ConfirmMsg := Format(sConfirmDelete, [Snippet.DisplayName]) else @@ -392,7 +392,7 @@ class procedure TUserDBMgr.DeleteSnippet(ViewItem: IView); ] ); if TMessageBox.Confirm(nil, ConfirmMsg) then - (Database as IDatabaseEdit).DeleteSnippet(Snippet); + Database.DeleteSnippet(Snippet); end; class procedure TUserDBMgr.DuplicateSnippet(ViewItem: IView); @@ -506,7 +506,7 @@ constructor TUserDBSaveUI.TSaveThread.Create; procedure TUserDBSaveUI.TSaveThread.Execute; begin - (Database as IDatabaseEdit).Save; + Database.Save; end; { TUserDBRestoreUI } From 8258738d40bb2d311bfddfe17c5af6463ef68d6f Mon Sep 17 00:00:00 2001 From: delphidabbler <5164283+delphidabbler@users.noreply.github.com> Date: Fri, 7 Mar 2025 10:26:13 +0000 Subject: [PATCH 222/222] Remove rejected TODO --- Src/DB.Categories.pas | 3 --- 1 file changed, 3 deletions(-) diff --git a/Src/DB.Categories.pas b/Src/DB.Categories.pas index 0f119d416..8c3882709 100644 --- a/Src/DB.Categories.pas +++ b/Src/DB.Categories.pas @@ -226,9 +226,6 @@ function TCategory.CompareIDTo(const Cat: TCategory): Integer; constructor TCategory.Create(const CatID: string; const Data: TCategoryData); begin - {TODO -cVault: Add a simpler contructor that takes only the category ID and - description and creates does all the convoluted TCategoryData setting! - } inherited Create; fID := CatID; fDescription := Data.Desc;