IStringList...

[cdbc]

Hi
Good nice to hear 
Roland are you by any chance testing with the 'stripcomments example?!?
If so, I've found a bug that eats Guids 
Have got the fix too, I'll attach 'comment_states.pas' in the other thread...
Regards Benny

[Roland57]

Yes, I got the new file. Test successful. 

[cdbc]

Hi
There's a new version 5.07.06.2024 out now.
Thanks to @ASerge for pointing it out: There's a /missing/ overridden method in TStringList, namely 'function IndexOf(aStr: string; aStart: integer);', which is present in TStrings, but alas ...not overridden.
It is now present in IStringList, so you don't have to e.g.: "idx:= TStrings(SomeStrList).IndexOf('test',idx+1);"
Regards Benny

[ASerge]

By the way, Benny, is such a class needed only to avoid using try finally?

[cdbc]

Hi ASerge
Well, I certainly use it a lot. I like that it's safe to e.g.: return a stringlist from a function. Me personally, I use it and other interfaces to an from plugin-libraries etc.
It wasn't primarily to avoid 'try-finally-end', but ofc. it saves three lines and some remembrance on my part(which isn't getting any better) 
Regards Benny

[ASerge]

It may be easier to give access to the entire type at once. Here is a list of what you don't public in your class, but what TStringList has:

Code: Pascal  [Select][+][-]

1. function Equals(Obj: TObject): Boolean; virtual; overload;
2. function Equals(TheStrings: TStrings): Boolean; overload;
3. Function Filter(aFilter: TStringsFilterMethod) : TStrings;
4. function LastIndexOf(const S: string): Integer;
5. function LastIndexOf(const S: string; aStart : Integer): Integer; virtual;
6. Function Map(aMap: TStringsMapMethod) : TStrings;
7. function Reduce(aReduceMethod: TStringsReduceMethod; const startingValue: string): string;
8. Function Reverse : TStrings;
9. function Shift : String;
10. Function Slice(fromIndex: integer) : TStrings;
11. Procedure Fill(const aValue : String; aStart,aEnd : Integer);
12. Procedure Filter(aFilter: TStringsFilterMethod; aList : TStrings);
13. procedure ForEach(aCallback: TStringsForeachMethod);
14. procedure ForEach(aCallback: TStringsForeachMethodEx);
15. procedure ForEach(aCallback: TStringsForeachMethodExObj);
16. Procedure Map(aMap: TStringsMapMethod; aList : TStrings);
17. Procedure Reverse(aList : TStrings);
18. procedure SetStrings(TheStrings: array of string); overload; virtual;
19. Procedure Slice(fromIndex: integer; aList : TStrings);
20. property AlwaysQuote: Boolean read FAlwaysQuote write FAlwaysQuote;
21. property Capacity: Integer read GetCapacity write SetCapacity;
22. property CommaText: string read GetCommaText write SetCommaText;
23. property DefaultEncoding: TEncoding read FDefaultEncoding write SetDefaultEncoding;
24. property DelimitedText: string read GetDelimitedText write SetDelimitedText;
25. property Delimiter: Char read GetDelimiter write SetDelimiter;
26. property Encoding: TEncoding read FEncoding;
27. property LineBreak : string Read GetLineBreak write SetLineBreak;
28. Property MissingNameValueSeparatorAction : TMissingNameValueSeparatorAction Read GetMissingNameValueSeparatorAction Write SetMissingNameValueSeparatorAction;
29. property Names[Index: Integer]: string read GetName;
30. Property NameValueSeparator : Char Read GetNameValueSeparator Write SetNameValueSeparator;
31. property Objects[Index: Integer]: TObject read GetObject write PutObject;
32. property Options: TStringsOptions read FOptions write FOptions;
33. property QuoteChar: Char read GetQuoteChar write SetQuoteChar;
34. Property SkipLastLineBreak : Boolean Read GetSkipLastLineBreak Write SetSkipLastLineBreak;
35. Property StrictDelimiter : Boolean Read GetStrictDelimiter Write SetStrictDelimiter;
36. property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter;
37. Property TextLineBreakStyle : TTextLineBreakStyle Read GetLBS Write SetLBS;
38. Property TrailingLineBreak : Boolean Read GetTrailingLineBreak Write SetTrailingLineBreak;
39. Property UseLocale : Boolean Read GetUseLocale Write SetUseLocale;
40. property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex;
41.  

I can suggest a simple way to make an interface out of a class.

Code: Pascal  [Select][+][-]

1. unit uMakeAutoFree;
2.  
3. {$mode ObjFPC}
4.  
5. interface
6.  
7. function MakeAutoFree(AObj: TObject): IInterface; overload;
8. function MakeAutoFree(ACls: TClass): IInterface; overload;
9.  
10. implementation
11.  
12. type
13.   TAutoFreeHolder = class(TInterfacedObject, IInterface)
14.   strict private
15.     FObj: TObject;
16.   protected
17.     function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
18.   public
19.     constructor Create(AObj: TObject);
20.     destructor Destroy; override;
21.   end;
22.  
23. function MakeAutoFree(AObj: TObject): IInterface;
24. begin
25.   Result := TAutoFreeHolder.Create(AObj);
26. end;
27.  
28. function MakeAutoFree(ACls: TClass): IInterface;
29. begin
30.   Result := MakeAutoFree(ACls.Create);
31. end;
32.  
33. //
34.  
35. constructor TAutoFreeHolder.Create(AObj: TObject);
36. begin
37.   inherited Create;
38.   FObj := AObj;
39. end;
40.  
41. destructor TAutoFreeHolder.Destroy;
42. begin
43.   FObj.Free;
44.   inherited;
45. end;
46.  
47. function TAutoFreeHolder.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
48. begin
49.   if Assigned(FObj) and FObj.GetInterface(iid, obj) then
50.     Result := S_OK
51.   else
52.     Result := inherited;
53. end;
54.  
55. end.

And example of use:

Code: Pascal  [Select][+][-]

1. {$MODE OBJFPC}
2. {$APPTYPE CONSOLE}
3.  
4. uses SysUtils, Classes, uMakeAutoFree;
5.  
6. type
7.   TTestList = class(TStringList)
8.   public
9.     destructor Destroy; override;
10.   end;
11.  
12. destructor TTestList.Destroy;
13. begin
14.   Writeln('TTestList.Destroy');
15.   inherited;
16. end;
17.  
18. procedure Test;
19. var
20.   L: TTestList;
21.   LHolder: IInterface;
22. begin
23.   LHolder := MakeAutoFree(TTestList);
24.   L := LHolder as TTestList;
25.   L.CommaText := '1,2,3,4,5';
26.   L.CaseSensitive := True;
27. end;
28.  
29. begin
30.   Test;
31.   Readln;
32. end.

[Thaddy]

Neat!
Btw, small remark: if you declare as winapi, the ifdefs for stdcall and cdecl are not necessary, winapi handles this automatically and is cross platform as well, not tied to windows. (and stdcall is win32 only, ignored for other platforms)

Code: Pascal  [Select][+][-]

1. //{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
2. winapi

[edit] suggestion removed: the interface reference IS needed.
I took the liberty of aliasing MakeAutoFree to just auto for even less typing 

[cdbc]

Hi
First off, I made what I needed.

Works great, btw, pity is that it does not work as IStrings (wish)

Thanks 
Believe you me Thaddy, this has been an after-thougt...
I'll put in the {$interfaces com} and surface more methods and properties, probably when I need them, for now: If in dire straits, use the "List" function/property, it's a TStringList.
Regarding 'winapi': I looked at what works in the RTL and implemented things like that. Afterall COM is growing old and there migth still be an odd win32 out there...
Oh ...and Yeah that's a neat trick ASerge.
Regards Benny

[Thaddy]

[edit] I editted the code this sunday, instead of a new post.

OK, my idea with ASerge's code, now the single assignment works:

Code: Pascal  [Select][+][-]

1. unit autofree;
2. {$if fpc_fullversion < 30301}
3. {$error this code need FPC version 3.3.1 or higher}
4. {$ifend}
5. {$mode delphi}{$interfaces com}
6. {  This code is inspired by the code from ASerge on the Freepascal forum.
7.    I added a interface storage, which makes it possible to drop is and as}
8.  
9. interface
10.  
11. type
12.   { Our own interface type }
13.   IAutoFree = interface(IUnknown)
14.   ['{89D8F215-61FF-4EBF-8C9E-9C027619DC0E}']
15.   end;
16.  
17. { create an instance from a class reference }
18. function Auto(ACls: TClass ): IAutoFree;overload;
19. { create an instance of a class }
20. function Auto(AObj: TObject): IAutoFree;overload;
21. { Currently the compiler chokes on this:
22. function Auto<T:class, constructor>:T;overload;
23. procedure Auto<T:class>(out value:T);overload;}
24. implementation
25.  
26. uses
27.   classes;
28.    
29. type  
30.   TAutoFreeHolder = class(TInterfacedObject,IAutoFree)
31.   strict private
32.     FObj: TObject;
33.   protected
34.     function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;winapi;
35.   public
36.     class var Store:IInterfaceList;
37.     class constructor Create;
38.     constructor Create(AObj: TObject);
39.     destructor Destroy; override;
40.   end;
41.  
42. { for some reason my current trunk version does not let me
43.   add these two generics to the autofree unit
44. function Auto<T:class, constructor>:T;overload;
45. begin
46.   Result := Auto(T.Create) as T;
47. end;
48.  
49. procedure Auto<T:class>(out value:T);overload;
50. begin
51.   Value := Auto(T.Create) as T;
52. end;
53. }
54. function Auto(AObj: TObject): IAutoFree;overload;
55. begin
56.   Result := TAutoFreeHolder.Create(AObj);
57.   TAutoFreeHolder.Store.Add(Result);
58. end;
59.  
60. function Auto(ACls: TClass): IAutofree;overload;
61. begin
62.   Result := Auto(ACls.Create);
63. end;
64.  
65. class constructor TAutoFreeHolder.Create;
66. begin
67.   Store :=TInterfaceList.Create;
68. end;
69.  
70. constructor TAutoFreeHolder.Create(AObj: TObject);
71. begin
72.   inherited Create;
73.   FObj := AObj;
74. end;
75.  
76. destructor TAutoFreeHolder.Destroy;
77. begin
78.   FObj.Free;
79.   inherited;
80. end;
81.  
82. function TAutoFreeHolder.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;winapi;
83. begin
84.   if Assigned(FObj) and FObj.GetInterface(iid, obj) then
85.     Result := S_OK
86.   else
87.     Result := inherited;
88. end;
89.  
90. end.

In this case the interfaces are stored in an internal store, so we can get rid of the dual declarations.
The demo would then look like this:

Code: Pascal  [Select][+][-]

1. {$if fpc_fullversion < 30301}
2. {$error this unit needs 3.3.1 or higher}
3. {$ifend}
4. {$mode delphi}{$H+}
5. {$modeswitch implicitfunctionspecialization}
6. { for some reason my current trunk version does not let me
7.   add these two generics to the autofree unit}
8. function Auto<T:class, constructor>:T;overload;
9. begin
10.   Result :=Auto(T.Create) as T;
11. end;
12.  
13. procedure Auto<T:class>(out value:T);overload;
14. begin
15.   Value := Auto(T.Create) as T;
16. end;
17.  
18. var
19.   List:TStringList;
20.   Strm:TStringStream;
21. begin
22.   Auto(List);  //implicit
23.   Auto(Strm);
24.   List.Add('Test');
25.   List.SaveToStream(Strm);
26.   writeln(Strm.DataString);
27. end.
28. end.

[cdbc]

Hi Thaddy
Phew, That looks quite 'Nifty' and also advanced, using /a couple/ of new compiler-features 
Good on you mate, you also made it easy to use 

Code: Pascal  [Select][+][-]

1. var
2.   L: TTestList;
3. begin
4.   L := Auto<TTestList>;

This certainly works for me...
Regards Benny

[cdbc]

Hi
Pheeeewww, That was an undertaking... 
...But there's a new version out, 'istrlist.pas' has reached version 6.09.06.2024
edit: Added the /forgotten/ observer-stuff from TPersistent... same version, please re-pull.
@Thaddy & @ASerge: Could you please take a 'gander' on this one? Let me know what you think.
To anyone who might be interested, you can get it from here: https://gitlab.com/cdbc-public/ibcstringlist
Regards Benny

[Thaddy]

Benny,

I editted my post from yesterday, because otherwise it becomes so cluttered.
I also removed some of my posts that have become irrelevant.
The code now works reliably with everything you throw at it, and, i mean, how cool is this:

Code: Pascal  [Select][+][-]

1. var
2.   List:TStringList;
3. begin
4.   Auto(List); { implicit creation of an auto free'd stringlist! }
5. .....

The code is now very close to what I eventually wanted to achieve with my smartpointer code. Actually, it is better!
Thanks to ASerge for the idea. I just added a store and generics.
(The store is necessary to get rid of as)

[cdbc]

Hi Thaddy
IT'S COOL 
Hats off to you my friend, you did it \o/\o/\o/
This new syntaks of yours... Me Likey  ...you had me worried for while, with too much to remember, in order for one to use it, but now it's just "Get up and get coding" so to speak 
I took your wish and went with it, plus a few more details, to be discovered 
Have a 'LookSee' for yourself...
Regards Benny

[Thaddy]

your code is also cool. i see many applications for it.

[cdbc]

Hi
Right, so I needed a couple of new factories (constructors) in 'istrlist.pas'...
They're called:

Code: Pascal  [Select][+][-]

1. { it is the user's responsibility, to ensure that the 'a(B)inary(l)arge(o)bjectof(b)yte'
2.   constitutes a body of text, i.e.: strings. this factory performs NO checks!!! }
3. function CreStrListFromBytes(const aBlob: array of byte): IStringList;
4. { it is the user's responsibility, to ensure that the 'aTextfileName' exists and
5.   constitutes a body of text, i.e.: strings. this factory performs NO checks!!! }
6. function CreStrListFromFile(const aTextfileName: string): IStringList;

Aptly named after what they do:
1) Takes an open array of bytes as param, I needed it when working with the
    results of @KodeZwerg's 'BinToInc' utility, *not* TBytes, there's a stream
    for that... 
2) Takes a textfile-name as param, I mean, why write 2 lines of code to
    create a stringlist from a textfile, when you can write 1 

Then the 'ForEach' iterators bothered me, they've got no way to send an arbitrary 'UserData' along into the callbacks, I'm used to doing that with library-callbacks, so I implemented that in 'IStrings':

Code: Pascal  [Select][+][-]

1.   { Callback that lets the user send arbitrary 'aData' along in the 'ForEach' call,
2.     which gets passed untouched through, to be at the user's disposal in callback.
3.     sig: procedure(const aValue: string; const anIdx: ptrint; anObj: TObject; aData: pointer) of object; }
4.   TStringsForEachMethodExObjData = procedure(const aValue: string; const anIdx: ptrint; anObj: TObject; aData: pointer) of object;
5. ...
6.   IStrings = ...
7.   ...
8.     procedure ForEach(aCallback: TStringsForEachMethodExObjData;UserData: pointer); overload; ///bc 200824
9.     procedure ForEachReverse(aCallback: TStringsForEachMethodExObjData;UserData: pointer); ///bc 200824
10.   ...
11.   end;

Plus a reversed iterator, could come in handy someday... 
The new version is: 7.20.08.2024 and it's available in my  Gitlab
Get it while it's hot... 
Regards Benny