paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 05:38:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* AI assistant functonality for Lazarus

Browse Source
This commit is contained in:
Michaël Van Canneyt 2025-01-04 15:37:32 +01:00
parent 58ce582298
commit 16b3f5455a
29 changed files with 4087 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
components/aissist/Readme.md Normal file
View File

@ -0,0 +1,34 @@
# Lazarus AI assistant - AIssist
This directory contains an implementation of a Lazarus AI assistent.
There are several directories and packages.
To install, install the following packages in the correct order:
- In the components/chatcontrol directory, install the lazchatctrl package.
This package contains the lazarus chat controls, needed in some of the
forms and demos.
- Install the aissist package in the api dir.
This package contains an abstract 'AI assistant' client. It relies on API
providers to implement actual APIs
- Install the janai package in the api/janai dir
This package contains a Jan AI API. It is compatible to the ChatGPT API,
and should be usable for communicating with ChatGPT. (but you need a
license key)
- Install the laz_aissist package.
This package contains the actual integration of the AI client in the Lazarus IDE.
It registers the following things:
- a menu entry in the 'View' menu called 'AIssist chat'.
- A settings page in the tools - options menu: the 'AI Assistant options' page.
Here you must set :
- The protocol to use (currently only the JanAI/ChatGPT API is supported)
- The URL where the AI requests must be sent
- The model you wish to use.
- The maximum lengt of the AI replies
The Demos directory contains a console and GUI demo of the AIClient class.
They serve to demonstrate the API and can be used separately from the IDE.

617
components/aissist/api/aiclient.pas Normal file
View File

@ -0,0 +1,617 @@
{
This file is part of the Free Component Library (FCL)
Copyright (c) 2024 by Michael Van Canneyt
AI server communication implementation
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit AIClient;
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
interface
uses
Classes, SysUtils, fpjson, fpwebclient, fpasyncwebclient;
Type
EAIServer = Class(Exception);
{ TAIServerSettings }
TAIServerSettings = class(TPersistent)
private
FBaseURL: String;
FDefaultMaxLength: Integer;
FDefaultModel: String;
FOnProtocolChange: TNotifyEvent;
FProtocol: String;
procedure SetBaseURL(AValue: String);
procedure SetProtocol(AValue: String);
protected
Property OnProtocolChange : TNotifyEvent Read FOnProtocolChange Write FOnProtocolChange;
public
procedure Assign(Source: TPersistent); override;
Published
Property BaseURL : String Read FBaseURL Write SetBaseURL;
Property DefaultModel : String Read FDefaultModel Write FDefaultModel;
Property DefaultMaxLength : Integer Read FDefaultMaxLength Write FDefaultMaxLength;
Property Protocol : String Read FProtocol Write SetProtocol;
end;
TModelData = Record
// Just ID and Human-readable name for the time being
ID : String; // To be used as model identifier in prompts.
Name : string;
end;
TModelDataArray = Array of TModelData;
TPromptResponse = record
// For now only response text ?
Response : string;
end;
TPromptResponseArray = Array of TPromptResponse;
TAIRequestErrorData = record
Error : String;
ErrorClass : String;
Method : String;
URL : String;
RequestBody : String;
end;
TModelsResponseCallBack = Procedure (Sender : TObject; aModels : TModelDataArray) of object;
TPromptResponseCallBack = Procedure (Sender : TObject; aResponses : TPromptResponseArray) of object;
TAIRequestErrorHandler = procedure (Sender : TObject; aErrorData : TAIRequestErrorData) of object;
TCustomAIClient = Class;
TAIProtocol = Class;
TAiUrl = (auListModels,auPrompt);
TAiUrls = Set of TAiUrl;
{ TAIProtocol }
TAIProtocol = Class(TObject)
private
FClient: TCustomAIClient;
public
constructor Create(aClient : TCustomAIClient); virtual;
// Convert responses to user data
Function ResponseToModels(aResponse : TJSONData; out Models: TModelDataArray) : boolean; virtual; abstract;
Function ResponseToPromptResponses(aResponse : TJSONData; out Responses: TPromptResponseArray) : boolean; virtual; abstract;
function CreatePromptRequest(const aModel,aPrompt : string; aMaxResponseLength : Cardinal) : TJSONData; virtual; abstract;
// All URLS are relative to the base URL, they MUST NOT start with /
function GetAIURL(aURL : TAiUrl) : String; virtual; abstract;
class function protocolname : string; virtual;
class function DefaultURL : String; virtual;
property Client : TCustomAIClient Read FClient;
end;
TAIProtocolClass = Class of TAIProtocol;
{ TCustomAIClient }
TCustomAIClient = class(TComponent)
Private type
THTTPRequestResponse = Record
Response : TWebClientResponse;
UserCallbackMethod : TMethod;
end;
THTTPResultHandler = procedure (const aResponse : THTTPRequestResponse) of object;
class var
_protocols : Array of TAIProtocolClass;
_protocolcount : integer;
class function IndexOfProtocol(const aName: string): Integer;
private
FOnError: TAIRequestErrorHandler;
FProtocol: TAIProtocol;
FSettings: TAIServerSettings;
FSynchronizeCallBacks: Boolean;
FWebClient : TAbstractWebClient;
procedure ProtocolChange(Sender: TObject);
procedure SetSettings(AValue: TAIServerSettings);
Protected
procedure CheckProtocol;
procedure CheckServerURL;
function CreateSettings : TAIServerSettings; virtual;
// Async response handling
procedure HandleModelsResponse(const aResponse: THTTPRequestResponse);
procedure HandlePromptResponse(const aResponse: THTTPRequestResponse);
Property Protocol : TAIProtocol Read FProtocol;
// HTTP Request handling
procedure ErrorHandler(aException: Exception; aContext : TAsyncRequestContext);
procedure ServerRequest(const aMethod, aURL: String; aResultHandler: THTTPResultHandler; aUserCallback: TMethod);
procedure ServerDataRequest(const aMethod, aURL: String; aJSON: TJSONData; aResultHandler: THTTPResultHandler; aUserCallback: TMethod);
// Protocol management
Public
class Procedure RegisterAIProtocol(aClass : TAIProtocolClass);
class Procedure UnRegisterAIProtocol(const aProtocol : String);
class function GetProtocolClass(const aName : string) : TAIProtocolClass;
class function FindProtocolClass(const aName: string): TAIProtocolClass;
class function GetProtocolList(aList : TStrings) : Integer;
public
constructor Create(aOwner : TComponent); override;
destructor Destroy; override;
// Get a list of available model descriptions
procedure GetModels(aCallBack : TModelsResponseCallBack);
// Send a prompt to the AI.
procedure SendPrompt(aCallBack: TPromptResponseCallBack; const aPrompt: string; aModel : String = ''; aMaxLength: Cardinal = 0);
// AI server settings
property Settings : TAIServerSettings Read FSettings Write SetSettings;
// Should callbacks be executed in the main thread ?
property SynchronizeCallBacks : Boolean Read FSynchronizeCallBacks Write FSynchronizeCallBacks;
// Error handler
property OnError : TAIRequestErrorHandler Read FOnError Write FOnError;
end;
TAIClient = Class(TCustomAIClient)
property Settings;
property OnError;
end;
Procedure RegisterAIProtocol(aClass : TAIProtocolClass);
implementation
uses httpprotocol, fphttpwebclient;
Type
{ TAIRequestData }
TAIRequestData = Class(TAsyncRequestData)
UserCallbackMethod : TMethod;
ResultHandler : TCustomAIClient.THTTPResultHandler;
procedure HandleWebResponse(aResponse: TWebClientResponse; aUserData: TObject);
end;
procedure RegisterAIProtocol(aClass: TAIProtocolClass);
begin
TCustomAIClient.RegisterAIProtocol(aClass);
end;
{ TAIServerSettings }
procedure TAIServerSettings.SetBaseURL(AValue: String);
begin
if FBaseURL=AValue then Exit;
FBaseURL:=AValue;
if FBaseURL<>'' then
FBaseURL:=IncludeHTTPPathDelimiter(FBaseURL);
end;
procedure TAIServerSettings.SetProtocol(AValue: String);
begin
if FProtocol=AValue then Exit;
FProtocol:=AValue;
If Assigned(FOnProtocolChange) then
FOnProtocolChange(Self);
end;
procedure TAIServerSettings.Assign(Source: TPersistent);
var
aSource: TAIServerSettings absolute Source;
begin
if Source is TAIServerSettings then
begin
FDefaultModel:=aSource.FDefaultModel;
FDefaultMaxLength:=aSource.FDefaultMaxLength;
FBaseURL:=aSource.BaseURL;
Protocol:=aSource.FProtocol; // trigger onchange
end else
inherited Assign(Source);
end;
{ TAIProtocol }
constructor TAIProtocol.Create(aClient: TCustomAIClient);
begin
FClient:=aClient;
end;
class function TAIProtocol.protocolname: string;
begin
Result:=ClassName;
end;
class function TAIProtocol.DefaultURL: String;
begin
Result:='';
end;
{ TCustomAIClient }
procedure TCustomAIClient.SetSettings(AValue: TAIServerSettings);
begin
if FSettings=AValue then Exit;
FSettings.Assign(AValue);
end;
function TCustomAIClient.CreateSettings: TAIServerSettings;
begin
Result:=TAIServerSettings.Create;
end;
constructor TCustomAIClient.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
FSettings:=CreateSettings;
FSettings.OnProtocolChange:=@ProtocolChange;
FWebClient:=DefaultWebClientClass.Create(Self);
end;
destructor TCustomAIClient.Destroy;
begin
FreeAndNil(FWebClient);
FreeAndNil(FSettings);
inherited Destroy;
end;
Type
{ TModelsResponseCallbackHandler }
TModelsResponseCallbackHandler = Class(TObject)
Private
FCallBack : TModelsResponseCallBack;
FList : TModelDataArray;
FSender : TObject;
Public
constructor Create(aSender : TObject; aCallBack : TModelsResponseCallback; aList :TModelDataArray);
procedure Execute;
end;
{ TModelsResponseCallbackHandler }
constructor TModelsResponseCallbackHandler.Create(aSender : TObject; aCallBack: TModelsResponseCallback; aList: TModelDataArray);
begin
FCallBack:=aCallBack;
FList:=aList;
FSender:=aSender;
end;
procedure TModelsResponseCallbackHandler.Execute;
begin
try
FCallBack(Fsender,FList);
finally
Free;
end;
end;
procedure TCustomAIClient.HandleModelsResponse(const aResponse: THTTPRequestResponse);
var
CallBack : TModelsResponseCallback;
handler : TModelsResponseCallbackHandler;
aList : TModelDataArray;
JSON : TJSONData;
begin
CheckProtocol;
json:=Nil;
try
JSON:=GetJSON(aResponse.Response.GetContentAsString);
if Protocol.ResponseToModels(JSON,aList) then
begin
Callback:=TModelsResponseCallback(aResponse.UserCallbackMethod);
handler:=TModelsResponseCallbackHandler.Create(Self,CallBack,aList);
if SynchronizeCallBacks then
TThread.Synchronize(TThread.CurrentThread,@Handler.Execute)
else
Handler.Execute;
end;
finally
JSON.Free;
end;
end;
procedure TAIRequestData.HandleWebResponse(aResponse : TWebClientResponse; aUserData : TObject);
var
Res : TCustomAIClient.THTTPRequestResponse;
begin
Res.Response:=aResponse;
Res.UserCallbackMethod:=Self.UserCallbackMethod;
if Assigned(Self.ResultHandler) then
ResultHandler(Res);
end;
procedure TCustomAIClient.ServerRequest(const aMethod,aURL : String; aResultHandler : THTTPResultHandler; aUserCallback : TMethod);
var
Context : TAsyncRequestContext;
Data : TAIRequestData;
begin
Context.Client:=FWebClient;
Context.Request:=FWebClient.CreateRequest;
Context.Method:=aMethod;
Context.URL:=aURL;
Data:=TAIRequestData.Create(Context);
// AI specific
Data.UserCallbackMethod:=aUserCallBack;
Data.OnResponse:=@Data.HandleWebResponse;
Data.ResultHandler:=aResultHandler;
THTTPRequestThread.create(Data);
end;
Type
{ TErrorCallBackHandler }
TErrorCallBackHandler = class(TObject)
FServer : TCustomAIClient;
FData : TAIRequestErrorData;
constructor create(aServer : TCustomAIClient; aData :TAIRequestErrorData);
procedure Execute;
end;
{ TErrorCallBackHandler }
constructor TErrorCallBackHandler.create(aServer: TCustomAIClient; aData: TAIRequestErrorData);
begin
FServer:=aServer;
FData:=aData;
end;
procedure TErrorCallBackHandler.Execute;
begin
try
if Assigned(FServer.FOnError) then
FServer.FOnError(FServer,FData);
finally
Free;
end;
end;
procedure TCustomAIClient.ErrorHandler(aException: Exception; aContext : TAsyncRequestContext);
var
AIContext: TAIRequestErrorData;
Handler : TErrorCallBackHandler;
begin
if Assigned(FOnError) then
begin
AIContext.Error:=aException.Message;
AIContext.ErrorClass:=aException.ClassName;
AIContext.URL:=aContext.URL;
AIContext.Method:=aContext.Method;
AIContext.RequestBody:=aContext.Request.GetContentAsString;
Handler:=TErrorCallBackHandler.Create(Self,AICOntext);
if SynchronizeCallBacks then
TThread.Synchronize(TThread.CurrentThread,@Handler.Execute)
else
Handler.Execute;
end;
end;
procedure TCustomAIClient.ProtocolChange(Sender: TObject);
var
aClass : TAIProtocolClass;
begin
aClass:=GetProtocolClass(FSettings.Protocol);
FreeAndNil(FProtocol);
FProtocol:=aClass.Create(Self);
end;
procedure TCustomAIClient.ServerDataRequest(const aMethod,aURL : String; aJSON : TJSONData; aResultHandler : THTTPResultHandler; aUserCallback : TMethod);
var
Data : TAIRequestData;
Context : TAsyncRequestContext;
begin
Context.Client:=FWebClient;
Context.Request:=FWebClient.CreateRequest;
Context.Request.SetContentFromString(aJSON.AsJSON);
// Writeln('Request: ',Context.Request.GetContentAsString);
Context.Request.Headers.Values['Content-Type']:='application/json';
Context.Method:=aMethod;
Context.URL:=aURL;
Data:=TAIRequestData.Create(Context);
// AI specific
Data.UserCallbackMethod:=aUserCallBack;
Data.OnResponse:=@Data.HandleWebResponse;
Data.ResultHandler:=aResultHandler;
Data.OnError:=@ErrorHandler;
THTTPRequestThread.create(Data);
end;
procedure TCustomAIClient.GetModels(aCallBack: TModelsResponseCallBack);
var
RequestURL : String;
begin
CheckProtocol;
CheckServerURL;
RequestURL:=Settings.BaseURL+Protocol.GetAIURL(auListModels);
ServerRequest('GET',RequestURL,@HandleModelsResponse,TMethod(aCallBack));
end;
Type
{ TPromptResponseHandler }
TPromptResponseHandler = class(TObject)
Private
FSender : TObject;
FCallBack :TPromptResponseCallback;
FResponses : TPromptResponseArray;
Public
Constructor Create(aSender : TObject; aCallBack :TPromptResponseCallback; aResponses : TPromptResponseArray);
procedure Execute;
end;
{ TPromptResponseHandler }
constructor TPromptResponseHandler.Create(aSender: TObject; aCallBack: TPromptResponseCallback; aResponses: TPromptResponseArray);
begin
FSender:=aSender;
FCallBack:=aCallBack;
FResponses:=aResponses;
end;
procedure TPromptResponseHandler.Execute;
begin
try
FCallBack(FSender,FResponses);
finally
Free;
end;
end;
procedure TCustomAIClient.HandlePromptResponse(const aResponse: THTTPRequestResponse);
var
CallBack : TPromptResponseCallback;
lResponses : TPromptResponseArray;
Handler : TPromptResponseHandler;
JSON : TJSONData;
begin
CheckProtocol;
CheckServerURL;
json:=Nil;
try
// Writeln('Response: ',aResponse.Response.GetContentAsString);
JSON:=GetJSON(aResponse.Response.GetContentAsString);
if Protocol.ResponseToPromptResponses(JSON,lResponses) then
begin
Callback:=TPromptResponseCallback(aResponse.UserCallbackMethod);
Handler:=TPromptResponseHandler.Create(Self,CallBack,lResponses);
if SynchronizeCallBacks then
TThread.Synchronize(TThread.CurrentThread,@Handler.Execute)
else
Handler.Execute;
end;
finally
JSON.Free;
end;
end;
class procedure TCustomAIClient.RegisterAIProtocol(aClass: TAIProtocolClass);
var
Len : Integer;
begin
Len:=Length(_protocols);
If _protocolcount=len then
SetLength(_protocols,len+10);
_protocols[_protocolcount]:=aClass;
inc(_protocolcount);
end;
class procedure TCustomAIClient.UnRegisterAIProtocol(const aProtocol: String);
var
Idx : Integer;
begin
Idx:=IndexOfProtocol(aProtocol);
if Idx=_protocolcount-1 then
_protocols[idx]:=nil
else
begin
_Protocols[Idx]:=_Protocols[_protocolCount-1];
_Protocols[_protocolCount]:=nil;
end;
Dec(_protocolcount);
end;
class function TCustomAIClient.IndexOfProtocol(const aName: string): Integer;
begin
Result:=_protocolcount-1;
While (Result>=0) and Not SameText(_protocols[Result].protocolname,aName) do
Dec(Result);
end;
procedure TCustomAIClient.CheckProtocol;
begin
If FProtocol=Nil then
Raise EAIServer.Create('No protocol assigned');
end;
procedure TCustomAIClient.CheckServerURL;
begin
if Settings.BaseURL='' then
Raise EAIServer.Create('Server URL is not set');
end;
class function TCustomAIClient.FindProtocolClass(const aName: string): TAIProtocolClass;
var
Idx : integer;
begin
Idx:=IndexOfProtocol(aName);
if Idx=-1 then
Result:=Nil
else
Result:=_protocols[Idx]
end;
class function TCustomAIClient.GetProtocolList(aList: TStrings): Integer;
var
i : Integer;
begin
For I:=0 to _protocolcount-1 do
aList.Add(_protocols[i].protocolname);
Result:=_protocolcount
end;
class function TCustomAIClient.GetProtocolClass(const aName: string): TAIProtocolClass;
var
Idx : integer;
begin
Result:=FindProtocolClass(aName);
if (Result=Nil) then
Raise EAIServer.CreateFmt('Unknown AI protocol: "%s"',[aName]);
end;
procedure TCustomAIClient.SendPrompt(aCallBack: TPromptResponseCallBack; const aPrompt: string; aModel: String; aMaxLength: Cardinal
);
var
JSON : TJSONData;
lModel,RequestURL : String;
lMaxLen : Cardinal;
begin
CheckProtocol;
RequestURL:=Settings.BaseURL+Protocol.GetAIURL(auPrompt);
lMaxLen:=aMaxLength;
if lMaxLen=0 then
lMaxLen:=Settings.DefaultMaxLength;
lModel:=aModel;
if lModel='' then
lModel:=Settings.DefaultModel;
JSON:=Protocol.CreatePromptRequest(lModel,aPrompt,lMaxLen);
try
ServerDataRequest('POST',RequestURL,JSON,@HandlePromptResponse,TMethod(aCallBack));
finally
JSON.Free;
end;
end;
initialization
if DefaultWebClientClass=Nil then
DefaultWebClientClass:=TFPHTTPWebClient;
end.

40
components/aissist/api/aissist.lpk Normal file
View File

@ -0,0 +1,40 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="5">
<Name Value="aissist"/>
<Type Value="RunAndDesignTime"/>
<Author Value="Michael Van Canneyt"/>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Description Value="General-purpose AI Client class, does not provide a concrete AI API.
Install e.g. the JanAI package in order to install an actual AP protocol."/>
<License Value="Modified LGPL"/>
<Version Minor="9" Release="1"/>
<Files>
<Item>
<Filename Value="aiclient.pas"/>
<UnitName Value="AIClient"/>
</Item>
<Item>
<Filename Value="fpasyncwebclient.pas"/>
<UnitName Value="fpasyncwebclient"/>
</Item>
</Files>
<RequiredPkgs>
<Item>
<PackageName Value="FCL"/>
</Item>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
</Package>
</CONFIG>

21
components/aissist/api/aissist.pas Normal file
View File

@ -0,0 +1,21 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit aissist;
{$warn 5023 off : no warning about unused units}
interface
uses
aiclient, fpasyncwebclient, LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('aissist', @Register);
end.

117
components/aissist/api/fpasyncwebclient.pas Normal file
View File

@ -0,0 +1,117 @@
{
This file is part of the Free Component Library (FCL)
Copyright (c) 2024 by Michael Van Canneyt
ASync HTTP request execution
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit fpasyncwebclient;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpwebclient;
type
TAsyncRequestContext = record
Method,URL : String;
Request : TWebClientRequest;
Client : TAbstractWebClient;
UserData : TObject;
end;
TWebResponseEvent = procedure (aResponse : TWebClientResponse; aUserData : TObject) of object;
TWebRequestErrorEvent = procedure (aException : Exception; aContext : TAsyncRequestContext) of object;
{ TAsyncRequestData }
TAsyncRequestData = class
FContext : TAsyncRequestContext;
OnResponse : TWebResponseEvent;
OnError : TWebRequestErrorEvent;
constructor create(const aContext : TAsyncRequestContext);
destructor destroy; override;
procedure ExecuteRequest;
end;
{ THTTPRequestThread }
THTTPRequestThread = class(TThread)
Private
FData : TAsyncRequestData;
protected
Procedure Execute; override;
public
// Thread will destroy aData and itself.
constructor create(aData : TAsyncRequestData); reintroduce;
end;
implementation
{ THTTPRequestThread }
constructor THTTPRequestThread.Create(aData : TAsyncRequestData);
begin
FData:=AData;
FreeOnTerminate:=True;
Inherited Create(False);
end;
procedure THTTPRequestThread.Execute;
begin
try
FData.ExecuteRequest;
finally
FData.Free;
end;
end;
{ TAsyncRequestData }
constructor TAsyncRequestData.create(const aContext: TAsyncRequestContext);
begin
FContext:=aContext;
end;
destructor TAsyncRequestData.destroy;
begin
FContext.Request.Free;
end;
procedure TAsyncRequestData.ExecuteRequest;
var
Res : TWebClientResponse;
begin
With FContext do
try
begin
Res:=Client.ExecuteRequest(Method,Url,Request);
if Assigned(OnResponse) then
OnResponse(Res,UserData);
end;
except
On E : Exception do
If Assigned(OnError) then
OnError(E,FContext);
end;
end;
end.

42
components/aissist/api/janai/janai.lpk Normal file
View File

@ -0,0 +1,42 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="5">
<Name Value="janai"/>
<Type Value="RunAndDesignTime"/>
<Author Value="Michael Van Canneyt"/>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Description Value="Provide an Jan AI REST AI protocol to the abstract AIssist client."/>
<License Value="Modified LGPL"/>
<Version Minor="9" Release="1"/>
<Files>
<Item>
<Filename Value="janai_v1.pas"/>
<UnitName Value="janai_v1"/>
</Item>
<Item>
<Filename Value="janaiprotocol.pas"/>
<UnitName Value="janaiprotocol"/>
</Item>
</Files>
<RequiredPkgs>
<Item>
<PackageName Value="aissist"/>
</Item>
<Item>
<PackageName Value="FCL"/>
</Item>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
</Package>
</CONFIG>

21
components/aissist/api/janai/janai.pas Normal file
View File

@ -0,0 +1,21 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit janai;
{$warn 5023 off : no warning about unused units}
interface
uses
janai_v1, janaiprotocol, LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('janai', @Register);
end.

1008
components/aissist/api/janai/janai_v1.pas Normal file
View File

File diff suppressed because it is too large Load Diff

137
components/aissist/api/janai/janaiprotocol.pas Normal file
View File

@ -0,0 +1,137 @@
{
This file is part of the Free Component Library (FCL)
Copyright (c) 2024 by Michael Van Canneyt
AI Server - JAN AI server protocol implementation
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit JanAIProtocol;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, aiclient, fpjson;
type
{ TJanAIServer }
{ TJanAIServerProtocol }
TJanAIServerProtocol = Class(TAIProtocol)
public
function CreatePromptRequest(const aModel, aPrompt: string; aMaxResponseLength: Cardinal): TJSONData; override;
function ResponseToPromptResponses(aResponse: TJSONData; out Responses: TPromptResponseArray): boolean; override;
function ResponseToModels(aResponse: TJSONData; out Models: TModelDataArray): boolean; override;
function GetAIURL(aURL: TAIURL): String; override;
class function protocolname : string; override;
class function DefaultURL : String; override;
end;
implementation
uses janai_v1;
{ TJanAIServerProtocol }
class function TJanAIServerProtocol.protocolname: string;
begin
Result:='JanAI';
end;
class function TJanAIServerProtocol.DefaultURL: String;
begin
Result:='http://localhost:1337/v1/';
end;
function TJanAIServerProtocol.ResponseToModels(aResponse: TJSONData; out Models: TModelDataArray): boolean;
var
Response : TModelsListResponse;
Item : TDataItem;
Idx : Integer;
begin
Models:=[];
Response:=TModelsListResponse.CreateFromJSON(aResponse);
try
SetLength(Models,Length(Response.data));
Idx:=0;
For Item in Response.data do
begin
Models[Idx].Name:=Item.Name;
Models[Idx].ID:=Item.id;
Inc(Idx);
end;
Result:=True;
finally
Response.Free;
end;
end;
function TJanAIServerProtocol.GetAIURL(aURL: TAIURL): String;
begin
case aURL of
auListModels : Result:='models';
auPrompt : Result:='chat/completions';
end;
end;
function TJanAIServerProtocol.CreatePromptRequest(const aModel, aPrompt: string; aMaxResponseLength: Cardinal): TJSONData;
var
Prompt : TCompletionRequest;
Msgs : TMessages;
Item : TMessageItem;
begin
Prompt:=TCompletionRequest.CreateFromJSON(Nil);
try
Msgs:=[];
SetLength(Msgs,1);
Item:=TMessageItem.Create;
Item.content:=aPrompt;
Item.Role:='user';
Msgs[0]:=Item;
Prompt.messages:=Msgs;
Prompt.max_tokens:=aMaxResponseLength;
Prompt.model:=aModel;
Result:=Prompt.SaveToJSON;
finally
Prompt.Free;
end;
end;
function TJanAIServerProtocol.ResponseToPromptResponses(aResponse: TJSONData; out Responses: TPromptResponseArray): boolean;
var
Resp : TCompletionsResponse;
Item : TchoicesItem;
Idx : Integer;
begin
Responses:=[];
Resp:=TCompletionsResponse.CreateFromJSON(aResponse);
SetLength(Responses,Length(Resp.choices));
Idx:=0;
For Item in Resp.Choices do
Responses[Idx].Response:=Item.message.content;
Result:=True;
end;
initialization
RegisterAIProtocol(TJANAIServerProtocol);
end.

61
components/aissist/demos/console/testaissist.lpi Normal file
View File

@ -0,0 +1,61 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="testaissist"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="janai"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="testaissist.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="testaissist"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

94
components/aissist/demos/console/testaissist.lpr Normal file
View File

@ -0,0 +1,94 @@
program testaissist;
uses cthreads, sysutils, classes, custapp, aiclient, fpwebclient, jsonparser, janaiprotocol;
Type
{ TApp }
{ TMyApp }
TMyApp = Class(TCustomApplication)
FClient : TAIClient;
constructor create(aOwner : TComponent); override;
Procedure Run;
private
procedure DoError(Sender: TObject; aErrorData : TAIRequestErrorData);
procedure HandleModels(Sender: TObject; aModels: TModelDataArray);
procedure HandlePrompt(Sender: TObject; aResponses: TPromptResponseArray);
end;
{ TMyApp }
constructor TMyApp.create(aOwner: TComponent);
begin
inherited create(aOwner);
FClient:=TAIClient.Create(Self);
FClient.Settings.BaseURL:='http://localhost:1337/v1';
FClient.Settings.DefaultModel:='mistral-ins-7b-q4';
FClient.Settings.DefaultMaxLength:=2048;
FClient.Settings.Protocol:=TJANAIServerProtocol.protocolname;
FClient.OnError:=@DoError;
end;
procedure TMyApp.Run;
begin
FClient.GetModels(@HandleModels);
While not Terminated do
begin
CheckSynchronize;
Sleep(100);
end;
end;
procedure TMyApp.DoError(Sender: TObject; aErrorData : TAIRequestErrorData);
begin
With aErrorData do
begin
Writeln('Got error ',ErrorClass,' during AI request : ',Error);
Writeln('Request details: ',METHOD,' ',URL);
if RequestBody<>'' then
begin
Writeln('Request body:');
Writeln(RequestBody);
end;
end;
Terminate;
end;
procedure TMyApp.HandleModels(Sender: TObject; aModels: TModelDataArray);
var
Model : TModelData;
begin
Writeln('Received model list (',Length(aModels),' entries) : ');
For Model in aModels do
Writeln(Model.id,' : ',Model.Name);
Writeln('Asking for hello world program...');
FClient.SendPrompt(@HandlePrompt,'Please create a "hello, world!" program in pascal');
Writeln('The AI is thinking. Waiting for reply...');
end;
procedure TMyApp.HandlePrompt(Sender: TObject; aResponses: TPromptResponseArray);
var
Resp : TPromptResponse;
begin
Writeln('Got ',Length(aResponses),' replies: ');
For Resp in aResponses do
Writeln(Resp.Response);
Terminate;
end;
begin
With TMyApp.Create(nil) do
try
Run;
finally
Free;
end;
end.

162
components/aissist/demos/gui/frmmain.lfm Normal file
View File

@ -0,0 +1,162 @@
object MainChatForm: TMainChatForm
Left = 425
Height = 623
Top = 278
Width = 1073
Caption = 'AI Chat demo'
ClientHeight = 623
ClientWidth = 1073
SessionProperties = 'Left;Top;Width;Height;pnlPrompt.Height'
LCLVersion = '3.99.0.0'
OnCreate = FormCreate
object Button1: TButton
Left = 16
Height = 25
Top = 552
Width = 75
Caption = 'Button1'
TabOrder = 0
OnClick = handleConnect
end
object GBChat: TGroupBox
Left = 0
Height = 433
Top = 42
Width = 1073
Align = alClient
Caption = 'AI Chat'
Constraints.MinWidth = 200
TabOrder = 1
end
object Panel1: TPanel
Left = 0
Height = 42
Top = 0
Width = 1073
Align = alTop
BevelOuter = bvNone
ClientHeight = 42
ClientWidth = 1073
TabOrder = 2
object edtURL: TEdit
Left = 144
Height = 28
Top = 8
Width = 376
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
TextHint = 'Enter base URL for AI server API'
OnChange = edtURLChange
end
object lblURL: TLabel
AnchorSideTop.Control = edtURL
AnchorSideRight.Control = edtURL
AnchorSideBottom.Control = edtURL
AnchorSideBottom.Side = asrBottom
Left = 34
Height = 28
Top = 8
Width = 110
Anchors = [akTop, akLeft, akBottom]
AutoSize = False
BorderSpacing.Right = 8
Caption = 'Server API URL'
Layout = tlCenter
end
object cbModels: TComboBox
AnchorSideTop.Control = edtURL
AnchorSideBottom.Control = edtURL
AnchorSideBottom.Side = asrBottom
Left = 684
Height = 28
Top = 8
Width = 324
Anchors = [akTop, akRight, akBottom]
ItemHeight = 0
TabOrder = 1
OnChange = cbModelsChange
end
object lblModel: TLabel
AnchorSideTop.Control = edtURL
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = edtURL
AnchorSideBottom.Side = asrBottom
Left = 632
Height = 28
Top = 8
Width = 39
Anchors = [akTop, akRight, akBottom]
Caption = 'Model'
Layout = tlCenter
end
object btnConnect: TButton
AnchorSideLeft.Control = edtURL
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = edtURL
AnchorSideBottom.Control = edtURL
AnchorSideBottom.Side = asrBottom
Left = 528
Height = 28
Top = 8
Width = 75
Anchors = [akTop, akLeft, akBottom]
BorderSpacing.Left = 8
Caption = '&Connect'
TabOrder = 2
OnClick = handleConnect
end
end
object pnlPrompt: TPanel
Left = 0
Height = 143
Top = 480
Width = 1073
Align = alBottom
ClientHeight = 143
ClientWidth = 1073
TabOrder = 3
object Label1: TLabel
Left = 30
Height = 16
Top = 17
Width = 79
Caption = 'Your prompt:'
end
object mPrompt: TMemo
Left = 128
Height = 112
Top = 16
Width = 832
Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0
end
object btnPrompt: TButton
Left = 976
Height = 25
Top = 17
Width = 88
Anchors = [akTop, akRight]
Caption = 'Prompt AI'
TabOrder = 1
OnClick = handlePrompt
end
end
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 475
Width = 1073
Align = alBottom
ResizeAnchor = akBottom
ResizeStyle = rsPattern
end
object psAI: TIniPropStorage
StoredValues = <>
Active = False
OnSaveProperties = psAISaveProperties
OnRestoreProperties = psAIRestoreProperties
Left = 421
Top = 110
end
end

225
components/aissist/demos/gui/frmmain.pas Normal file
View File

@ -0,0 +1,225 @@
unit frmmain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, IniPropStorage, chatcontrol, aiclient,
janaiprotocol;
type
TChatState = (csDisconnected,csConnected,csWaiting,csAIThinking);
{ TMainChatForm }
TMainChatForm = class(TForm)
Button1: TButton;
btnConnect: TButton;
btnPrompt: TButton;
cbModels: TComboBox;
edtURL: TEdit;
GBChat: TGroupBox;
psAI: TIniPropStorage;
Label1: TLabel;
lblURL: TLabel;
lblModel: TLabel;
mPrompt: TMemo;
Panel1: TPanel;
pnlPrompt: TPanel;
Splitter1: TSplitter;
procedure cbModelsChange(Sender: TObject);
procedure edtURLChange(Sender: TObject);
procedure handleConnect(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure handlePrompt(Sender: TObject);
procedure psAIRestoreProperties(Sender: TObject);
procedure psAISaveProperties(Sender: TObject);
private
FChat : TChatControl;
FAIClient : TAIClient;
FChatState : TChatState;
procedure HandleAIAnswer(Sender: TObject; aResponses: TPromptResponseArray);
procedure HandleRequestError(Sender: TObject; aErrorData: TAIRequestErrorData);
procedure SetState(aState : TChatState);
Procedure CheckState;
function ExtractModelID(S: String): string;
procedure HandleGetModels(Sender: TObject; aModels: TModelDataArray);
property State : TChatState Read FChatState Write SetState;
public
end;
var
MainChatForm: TMainChatForm;
implementation
{$R *.lfm}
{ TMainChatForm }
procedure TMainChatForm.FormCreate(Sender: TObject);
begin
FChat:=TChatControl.Create(Self);
FChat.Parent:=GBChat;
FChat.Align:=alClient;
FChat.Width:=ClientWidth div 2;
FAIClient:=TAIClient.Create(Self);
FAIClient.Settings.Protocol:=TJanAIServerProtocol.protocolname;
FAIClient.OnError:=@HandleRequestError;
FAIClient.SynchronizeCallBacks:=True;
FAIClient.Settings.DefaultMaxLength:=2048;
psAI.IniFileName:=GetAppConfigFile(False);
psAI.Active:=True;
mPrompt.Text:=FAIClient.Settings.DefaultModel;
SetState(csDisconnected);
end;
procedure TMainChatForm.handlePrompt(Sender: TObject);
var
S : String;
begin
if State<>csWaiting then exit;
S:=mPrompt.Text;
FChat.AddText(S,tsRight);
FChat.LeftTyping:=True;
FAIClient.SendPrompt(@HandleAIAnswer,mPrompt.Text);
State:=csAIThinking;
end;
procedure TMainChatForm.psAIRestoreProperties(Sender: TObject);
begin
FAIClient.Settings.BaseURL:=psAI.ReadString('URL','');
FAIClient.Settings.DefaultModel:=psAI.ReadString('model','');
edtURL.Text:=FAIClient.Settings.BaseURL;
end;
procedure TMainChatForm.psAISaveProperties(Sender: TObject);
begin
psAI.WriteString('URL',FAIClient.Settings.BaseURL);
psAI.WriteString('model',FAIClient.Settings.DefaultModel);
end;
procedure TMainChatForm.SetState(aState: TChatState);
begin
if aState=FChatState then exit;
FChatState:=aState;
CheckState;
end;
procedure TMainChatForm.HandleRequestError(Sender: TObject; aErrorData: TAIRequestErrorData);
var
Msg : TStrings;
begin
Msg:=TStringList.Create;
try
Msg.Add('Drat!');
Msg.Add('An error occurred while talking to the AI!');
Msg.Add('Here is the error we got: '+aErrorData.Error);
Msg.Add('This is what we were trying to do: '+aErrorData.Method+' '+aErrorData.URL);
if aErrorData.RequestBody<>'' then
begin
Msg.Add('And this is what we were saying:');
Msg.Add(aErrorData.RequestBody);
end;
FChat.AddText(Msg.Text,tsLeft);
FChat.LeftTyping:=False;
if State=csAIThinking then
State:=csWaiting
else
State:=csDisconnected;
finally
Msg.Free;
end;
end;
procedure TMainChatForm.HandleAIAnswer(Sender: TObject; aResponses: TPromptResponseArray);
begin
FChat.LeftTyping:=False;
State:=csWaiting;
if Length(aResponses)=0 then
FChat.AddText('No answer from AI, try refining your prompt',tsLeft)
else
FChat.AddText(aResponses[0].Response,tsLeft);
end;
procedure TMainChatForm.CheckState;
begin
pnlPrompt.Enabled:=(State=csWaiting);
if State<csConnected then
begin
cbModels.Clear;
cbModels.Items.Clear;
end;
end;
procedure TMainChatForm.HandleGetModels(Sender: TObject; aModels: TModelDataArray);
var
aModel : TModelData;
Idx,I : Integer;
begin
Idx:=-1;
With cbModels.Items do
begin
BeginUpdate;
For aModel in aModels do
begin
I:=Add('['+aModel.ID+'] '+aModel.Name);
if aModel.ID=FAIClient.Settings.DefaultModel then
Idx:=I;
end;
EndUpdate;
end;
cbModels.ItemIndex:=Idx;
FChat.LeftTyping:=False;
if Idx>=0 then
State:=csWaiting
else
State:=csConnected;
end;
procedure TMainChatForm.handleConnect(Sender: TObject);
begin
FAIClient.Settings.BaseURL:=edtURL.Text;
FAIClient.GetModels(@HandleGetModels);
FChat.LeftTyping:=True;
end;
procedure TMainChatForm.edtURLChange(Sender: TObject);
begin
State:=csDisconnected;
end;
function TMainChatForm.ExtractModelID(S : String) : string;
var
P1,P2 : Integer;
begin
P1:=Pos('[',S);
P2:=Pos(']',S);
if (P1>0) and (P2>P1) then
Result:=Copy(S,P1+1,P2-P1-1)
else
Result:=S;
end;
procedure TMainChatForm.cbModelsChange(Sender: TObject);
var
mID : String;
begin
mID:=ExtractModelID(cbModels.Text);
FAIClient.Settings.DefaultModel:=mID;
if mID<>'' then
State:=csWaiting;
end;
end.

BIN
components/aissist/demos/gui/uiassist.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 130 KiB

84
components/aissist/demos/gui/uiassist.lpi Normal file
View File

@ -0,0 +1,84 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="uiassist"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="chatctrls"/>
</Item>
<Item>
<PackageName Value="janai"/>
</Item>
<Item>
<PackageName Value="aissist"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="uiassist.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="frmmain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainChatForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="uiassist"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

26
components/aissist/demos/gui/uiassist.lpr Normal file
View File

@ -0,0 +1,26 @@
program uiassist;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, frmmain, chatcontrol, typingindicator
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.{%H-}MainFormOnTaskbar:=True;
Application.Initialize;
Application.CreateForm(TMainChatForm, MainChatForm);
Application.Run;
end.

BIN
components/aissist/demos/gui/uiassist.res Normal file
View File

Binary file not shown.

168
components/aissist/ide/aissistcontroller.pas Normal file
View File

@ -0,0 +1,168 @@
{ Copyright (C) 2024
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Michael Van Canneyt
Abstract: AI Assistant controller
}
unit AIssistController;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, AIClient, JanAIProtocol, SrcEditorIntf, IDEOptionsIntf, IDEOptEditorIntf, BaseIDEIntf;
Type
TAIState = (csDisconnected,csConnected,csWaiting,csAIThinking);
{ TAIssistController }
TAIssistController = Class(TComponent)
private
FConfigFrame: TAbstractIDEOptionsEditorClass;
FSettings: TAIServerSettings;
class var _Instance: TAIssistController;
Public
class constructor Init;
class destructor done;
Class property Instance : TAIssistController Read _Instance;
Public
constructor create(aOwner : TComponent); override;
Destructor destroy; override;
procedure HandleShowConfig(Sender : TObject);
function ShowConfig: Boolean;
Procedure LoadConfig;
Procedure SaveConfig;
Function CreateAIClient : TAIClient;
Function ExplainCurrentSelection (aEdit : TSourceEditorInterface): Boolean;
Function Configured : Boolean;
Property Settings : TAIServerSettings Read FSettings;
Property ConfigFrame : TAbstractIDEOptionsEditorClass Read FConfigFrame Write FConfigFrame;
end;
Function AIController : TAIssistController;
implementation
uses LazIDEintf, StrAIssist, LazConfigStorage, forms, frmaixplain;
const
DefaultMaxLength = 2048;
function AIController: TAIssistController;
begin
Result:=TAIssistController.Instance;
end;
{ TAIssistController }
class constructor TAIssistController.Init;
begin
_Instance:=TAIssistController.Create(nil);
end;
class destructor TAIssistController.done;
begin
FreeAndNil(_Instance);
end;
constructor TAIssistController.create(aOwner: TComponent);
begin
inherited create(aOwner);
FSettings:=TAIServerSettings.Create;
FSettings.Protocol:=TJanAIServerProtocol.protocolname;
end;
destructor TAIssistController.destroy;
begin
FreeAndNil(FSettings);
inherited destroy;
end;
procedure TAIssistController.HandleShowConfig(Sender: TObject);
begin
ShowConfig;
end;
function TAIssistController.ShowConfig : Boolean;
begin
Result:=LazarusIDE.DoOpenIDEOptions(ConfigFrame);
end;
procedure TAIssistController.LoadConfig;
var
Storage : TConfigStorage;
begin
Storage:=GetIDEConfigStorage(SConfigFile, True);
with Storage do
try
Settings.Protocol := GetValue(KeyProtocol,Settings.Protocol);
Settings.BaseURL := GetValue(KeyServerURL,'');
Settings.DefaultModel:= GetValue(KeyDefaultModel,'');
Settings.DefaultMaxLength:= GetValue(KeyDefaultMaxLength,DefaultMaxLength);
finally
Free;
end;
end;
procedure TAIssistController.SaveConfig;
var
Storage : TConfigStorage;
begin
Storage:=GetIDEConfigStorage(SConfigFile, True);
with Storage do
try
SetDeleteValue(KeyServerURL,Settings.BaseURL,'');
SetDeleteValue(KeyProtocol,Settings.Protocol,TJanAIServerProtocol.protocolname);
SetDeleteValue(KeyDefaultModel,Settings.DefaultModel,'');
SetDeleteValue(KeyDefaultMaxLength,Settings.DefaultMaxLength, DefaultMaxLength);
finally
Free;
end;
end;
function TAIssistController.CreateAIClient: TAIClient;
begin
Result:=Nil;
If Not Configured then exit;
Result:=TAIClient.Create(Self);
Result.Settings:=Self.Settings;
end;
function TAIssistController.ExplainCurrentSelection(aEdit : TSourceEditorInterface): Boolean;
var
frm : TAIxplainForm;
Clnt : TAIClient;
lPos,Caret : TPoint;
begin
// todo: show messages
if Not Assigned(aEdit) then exit(False);
if not Configured then exit(False);
frm:=TAIxplainForm.Create(Application);
Caret:=aEdit.CursorScreenXY;
lPos:=aEdit.EditorControl.ClientToScreen(aEdit.ScreenToPixelPosition(Caret));
Frm.Top:=lPos.Y;
Frm.Left:=lPos.X;
Clnt:=CreateAIClient;
Frm.Explain(aEdit,Clnt);
frm.Show;
end;
function TAIssistController.Configured: Boolean;
begin
Result:=(Settings.BaseURL<>'');
Result:=Result and ((Settings.Protocol<>'') and (TAIClient.FindProtocolClass(Settings.Protocol)<>Nil));
Result:=Result and (Settings.DefaultModel<>'');
Result:=Result and (Settings.DefaultMaxLength>500);
end;
end.

146
components/aissist/ide/fraaissistconfig.lfm Normal file
View File

@ -0,0 +1,146 @@
object AIAssistentConfigFrame: TAIAssistentConfigFrame
Left = 0
Height = 239
Top = 0
Width = 445
ClientHeight = 239
ClientWidth = 445
TabOrder = 0
DesignLeft = 530
DesignTop = 419
object CBProtocol: TComboBox
AnchorSideTop.Control = Owner
Left = 120
Height = 28
Top = 8
Width = 227
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
ItemHeight = 0
TabOrder = 0
Text = 'CBProtocol'
OnChange = CBProtocolChange
end
object lblProtocol: TLabel
AnchorSideTop.Control = CBProtocol
AnchorSideRight.Control = CBProtocol
AnchorSideBottom.Control = CBProtocol
AnchorSideBottom.Side = asrBottom
Left = 56
Height = 28
Top = 8
Width = 56
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight, akBottom]
AutoSize = False
BorderSpacing.Right = 8
Caption = 'Protocol'
Layout = tlCenter
end
object edtURL: TEdit
AnchorSideTop.Control = CBProtocol
AnchorSideTop.Side = asrBottom
Left = 120
Height = 28
Top = 44
Width = 307
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
TabOrder = 1
TextHint = 'Enter AI API Server URL'
end
object lblURL: TLabel
AnchorSideTop.Control = edtURL
AnchorSideRight.Control = edtURL
AnchorSideBottom.Control = edtURL
AnchorSideBottom.Side = asrBottom
Left = 43
Height = 28
Top = 44
Width = 69
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight, akBottom]
AutoSize = False
BorderSpacing.Right = 8
Caption = 'Server URL'
Layout = tlCenter
end
object cbModel: TComboBox
AnchorSideTop.Control = edtURL
AnchorSideTop.Side = asrBottom
Left = 120
Height = 28
Top = 80
Width = 227
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
ItemHeight = 0
TabOrder = 2
end
object lblModel: TLabel
AnchorSideTop.Control = cbModel
AnchorSideRight.Control = cbModel
AnchorSideBottom.Control = cbModel
AnchorSideBottom.Side = asrBottom
Left = 16
Height = 28
Top = 80
Width = 96
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight, akBottom]
AutoSize = False
BorderSpacing.Right = 8
Caption = 'Default model'
Layout = tlCenter
end
object edtMaxResponseLength: TLazIntegerEdit
AnchorSideTop.Control = cbModel
AnchorSideTop.Side = asrBottom
Left = 120
Height = 28
Top = 116
Width = 80
Value = 0
MinValue = -9223372036854775808
MaxValue = 9223372036854775807
SetDecimalKeys = '#'
HexIndicator = '$'
ToggleHexKeys = '$x'
OctIndicator = '&'
ToggleOctKeys = '&'
BinIndicator = '%'
ToggleBinKeys = '%'
BorderSpacing.Top = 8
TabOrder = 3
Text = '0'
end
object lblMaxLength: TLabel
AnchorSideTop.Control = edtMaxResponseLength
AnchorSideRight.Control = edtMaxResponseLength
AnchorSideBottom.Control = edtMaxResponseLength
AnchorSideBottom.Side = asrBottom
Left = 34
Height = 28
Top = 116
Width = 78
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight, akBottom]
AutoSize = False
BorderSpacing.Right = 8
Caption = 'Max. Length'
Layout = tlCenter
end
object btnRefresh: TButton
AnchorSideTop.Control = cbModel
AnchorSideBottom.Control = cbModel
AnchorSideBottom.Side = asrBottom
Left = 352
Height = 28
Top = 80
Width = 75
Anchors = [akTop, akRight, akBottom]
Caption = 'Refresh'
TabOrder = 4
OnClick = HandleRefreshClick
end
end

173
components/aissist/ide/fraaissistconfig.pas Normal file
View File

@ -0,0 +1,173 @@
{ Copyright (C) 2024
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Michael Van Canneyt
Abstract: AI Assistant configuration frame
}
unit fraAIssistConfig;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, AIClient,
IDEOptionsIntf, IDEOptEditorIntf, IDEUtils, IDEDialogs, LazNumEdit;
type
{ TAIAssistentConfigFrame }
TAIAssistentConfigFrame = class(TAbstractIDEOptionsEditor)
btnRefresh: TButton;
CBProtocol: TComboBox;
cbModel: TComboBox;
edtURL: TEdit;
lblProtocol: TLabel;
lblModel: TLabel;
edtMaxResponseLength: TLazIntegerEdit;
lblMaxLength: TLabel;
lblURL: TLabel;
procedure CBProtocolChange(Sender: TObject);
procedure HandleRefreshClick(Sender: TObject);
private
FBusy : Boolean;
FClient : TAIClient;
procedure CheckURL;
function ExtractModelID(const S: String): string;
procedure GetModelNames;
procedure HandleModels(Sender: TObject; aModels: TModelDataArray);
public
function GetTitle: String; override;
procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
procedure ReadSettings({%H-}AOptions: TAbstractIDEOptions); override;
procedure WriteSettings({%H-}AOptions: TAbstractIDEOptions); override;
class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
end;
implementation
uses StrAIssist, AIssistController;
{$R *.lfm}
{ TAIAssistentConfigFrame }
procedure TAIAssistentConfigFrame.HandleModels(Sender: TObject; aModels: TModelDataArray);
var
aModel : TModelData;
Idx,I : Integer;
begin
FBusy:=False;
Idx:=-1;
With cbModel.Items do
begin
BeginUpdate;
Clear;
For aModel in aModels do
begin
I:=Add('['+aModel.ID+'] '+aModel.Name);
if SameText(aModel.ID,AIController.Settings.DefaultModel) then
Idx:=I;
end;
EndUpdate;
end;
if CBModel.Text='' then
cbModel.ItemIndex:=Idx;
end;
function TAIAssistentConfigFrame.GetTitle: String;
begin
Result:=SConfigTitle;
end;
procedure TAIAssistentConfigFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
begin
if ADialog<>Nil then ; // Silence compiler warning
TAIClient.GetProtocolList(CBProtocol.Items);
end;
procedure TAIAssistentConfigFrame.ReadSettings(AOptions: TAbstractIDEOptions);
begin
CBProtocol.ItemIndex:=CBProtocol.Items.IndexOf(AIController.Settings.Protocol);
EdtURL.Text:=AIController.Settings.BaseURL;
CheckURL;
cbModel.Text:=AIController.Settings.DefaultModel;
edtMaxResponseLength.Value:=AIController.Settings.DefaultMaxLength;
if AIController.Configured then
GetModelNames;
end;
procedure TAIAssistentConfigFrame.HandleRefreshClick(Sender: TObject);
begin
GetModelNames;
end;
procedure TAIAssistentConfigFrame.CBProtocolChange(Sender: TObject);
begin
CheckURL;
end;
procedure TAIAssistentConfigFrame.CheckURL;
var
lClass : TAIProtocolClass;
begin
if edtURL.Text<>'' then
exit;
lClass:=TAIClient.FindProtocolClass(CBProtocol.Text);
if lClass<>Nil then
edtURL.Text:=lClass.DefaultURL;
end;
procedure TAIAssistentConfigFrame.GetModelNames;
begin
if FBusy then exit;
if not Assigned(FClient) then
FClient:=TAIClient.Create(Self);
FClient.Settings.Protocol:=cbProtocol.Text;
FClient.Settings.BaseURL:=edtURL.Text;
FClient.SynchronizeCallBacks:=True;
FBusy:=True;
FClient.GetModels(@HandleModels);
end;
function TAIAssistentConfigFrame.ExtractModelID(const S : String) : string;
var
P1,P2 : Integer;
begin
P1:=Pos('[',S);
P2:=Pos(']',S);
if (P1>0) and (P2>P1) then
Result:=Copy(S,P1+1,P2-P1-1)
else
Result:=S;
end;
procedure TAIAssistentConfigFrame.WriteSettings(AOptions: TAbstractIDEOptions);
begin
AIController.Settings.Protocol:=cbProtocol.Text;
AIController.Settings.BaseURL := EdtURL.Text;
AIController.Settings.DefaultModel := ExtractModelID(cbModel.Text);
AIController.Settings.DefaultMaxLength := edtMaxResponseLength.Value;
AIController.SaveConfig;
end;
class function TAIAssistentConfigFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
begin
Result:=IDEEditorGroups.GetByIndex(GroupEnvironment)^.GroupClass;
end;
end.

85
components/aissist/ide/frmaissistchat.lfm Normal file
View File

@ -0,0 +1,85 @@
object AIssistChatForm: TAIssistChatForm
Left = 544
Height = 477
Top = 278
Width = 786
Caption = 'AI Assistent conversation form'
ClientHeight = 477
ClientWidth = 786
LCLVersion = '4.99.0.0'
OnCreate = FormCreate
object pnlPrompt: TPanel
Left = 0
Height = 143
Top = 334
Width = 786
Align = alBottom
ClientHeight = 143
ClientWidth = 786
TabOrder = 0
object lblPrompt: TLabel
Left = 30
Height = 16
Top = 17
Width = 79
Caption = 'Your prompt:'
end
object mPrompt: TMemo
Left = 128
Height = 112
Top = 16
Width = 545
Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0
end
object btnPrompt: TButton
Left = 689
Height = 25
Top = 17
Width = 88
Anchors = [akTop, akRight]
Caption = 'Prompt AI'
TabOrder = 1
OnClick = HandlePrompt
end
object btnConfigure: TButton
Left = 689
Height = 25
Top = 103
Width = 88
Anchors = [akRight, akBottom]
Caption = 'Configure...'
TabOrder = 2
OnClick = HandleConfigureClick
end
end
object GBChat: TGroupBox
Left = 0
Height = 329
Top = 0
Width = 786
Align = alClient
Caption = 'AI Conversation'
Constraints.MinWidth = 200
TabOrder = 1
end
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 329
Width = 786
Align = alBottom
ResizeAnchor = akBottom
ResizeStyle = rsPattern
end
object pmChat: TPopupMenu
OnPopup = pmChatPopup
Left = 107
Top = 82
object MICopy: TMenuItem
Caption = '&Copy'
OnClick = MICopyClick
end
end
end

209
components/aissist/ide/frmaissistchat.pas Normal file
View File

@ -0,0 +1,209 @@
{ Copyright (C) 2024
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Michael Van Canneyt
Abstract: AI Assistant conversation window
}
unit frmaissistchat;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ChatControl, TypingIndicator,
LCLType, StdCtrls, ExtCtrls, Menus, AIClient;
type
{ TAIssistChatForm }
TChatState = (csUnconfigured,csWaiting,csAIThinking);
TAIssistChatForm = class(TForm)
btnPrompt: TButton;
btnConfigure: TButton;
GBChat: TGroupBox;
lblPrompt: TLabel;
MICopy: TMenuItem;
mPrompt: TMemo;
pnlPrompt: TPanel;
pmChat: TPopupMenu;
Splitter1: TSplitter;
procedure FormCreate(Sender: TObject);
procedure HandleConfigureClick(Sender: TObject);
procedure HandlePrompt(Sender: TObject);
procedure MICopyClick(Sender: TObject);
procedure pmChatPopup(Sender: TObject);
private
FChat : TChatControl;
FAIClient : TAIClient;
FChatState : TChatState;
FOnConfigure: TNotifyEvent;
procedure CheckState;
procedure ConfigureServer;
procedure CreateServer;
procedure HandleAIAnswer(Sender: TObject; aResponses: TPromptResponseArray);
procedure HandleRequestError(Sender: TObject; aErrorData: TAIRequestErrorData);
procedure SetState(AValue: TChatState);
public
{ public declarations }
property State : TChatState Read FChatState Write SetState;
property OnConfigure : TNotifyEvent Read FOnConfigure Write FOnConfigure;
end;
implementation
uses ClipBrd,StrAIssist, AIssistController;
{$R *.lfm}
{ TAIssistChatForm }
procedure TAIssistChatForm.HandleAIAnswer(Sender: TObject; aResponses: TPromptResponseArray);
begin
FChat.LeftTyping:=False;
State:=csWaiting;
if Length(aResponses)=0 then
FChat.AddText(SErrNoAnswer,tsLeft)
else
FChat.AddText(aResponses[0].Response,tsLeft);
end;
procedure TAIssistChatForm.HandleRequestError(Sender: TObject; aErrorData: TAIRequestErrorData);
var
Msg : TStrings;
begin
Msg:=TStringList.Create;
try
Msg.Add(SErrorTitle);
Msg.Add(SErrorIntro);
Msg.Add(SErrorInfo,[aErrorData.Error]);
Msg.Add(SErrorContext,[aErrorData.Method,aErrorData.URL]);
if aErrorData.RequestBody<>'' then
begin
Msg.Add(SErrorBody);
Msg.Add(aErrorData.RequestBody);
end;
FChat.AddText(Msg.Text,tsLeft);
FChat.LeftTyping:=False;
if State=csAIThinking then
State:=csWaiting
else
State:=csUnconfigured;
finally
Msg.Free;
end;
end;
procedure TAIssistChatForm.SetState(AValue: TChatState);
begin
if FChatState=AValue then Exit;
FChatState:=AValue;
CheckState;
end;
procedure TAIssistChatForm.FormCreate(Sender: TObject);
begin
FChat:=TChatControl.Create(Self);
FChat.Parent:=GBChat;
FChat.Align:=alClient;
FChat.Width:=ClientWidth div 2;
FChat.PopupMenu:=pmChat;
CreateServer;
end;
procedure TAIssistChatForm.CreateServer;
begin
FAIClient:=AIController.CreateAIClient;
if Assigned(FAIClient) then
ConfigureServer
else
FChat.AddText(SErrPleaseConfigure,tsLeft);
end;
procedure TAIssistChatForm.HandleConfigureClick(Sender: TObject);
begin
if Assigned(FOnConfigure) then
FOnConfigure(Self);
FreeAndNil(FAIClient);
State:=csUnconfigured;
CreateServer;
end;
procedure TAIssistChatForm.CheckState;
begin
pnlPrompt.Enabled:=(State=csWaiting);
end;
procedure TAIssistChatForm.ConfigureServer;
begin
FAIClient.OnError:=@HandleRequestError;
FAIClient.SynchronizeCallBacks:=True;
State:=csWaiting;
end;
procedure TAIssistChatForm.HandlePrompt(Sender: TObject);
var
S : String;
begin
Case State of
csUnconfigured : FChat.AddText(SErrPleaseConfigure,tsLeft);
csAIThinking : FChat.AddText(SErrAIWaiting,tsLeft);
end;
if State<>csWaiting then
exit;
S:=mPrompt.Text;
if S='' then
begin
FChat.AddText(SErrPleaseEnterPrompt,tsLeft);
exit;
end;
FChat.AddText(S,tsRight);
FChat.LeftTyping:=True;
FAIClient.SendPrompt(@HandleAIAnswer,S);
State:=csAIThinking;
end;
procedure TAIssistChatForm.MICopyClick(Sender: TObject);
var
lPt : TPoint;
Item : TChatItem;
begin
lPt:=pmChat.PopupPoint;
lpt:=FChat.ScreenToClient(lpt);
Item:=FChat.GetItemAt(lPt.X,lPt.Y);
if Item<>Nil then
Clipboard.AsText:=Item.Text;
end;
procedure TAIssistChatForm.pmChatPopup(Sender: TObject);
var
lPt : TPoint;
Item : TChatItem;
HaveItem : Boolean;
begin
lPt:=pmChat.PopupPoint;
lpt:=FChat.ScreenToClient(lpt);
Item:=FChat.GetItemAt(lPt.X,lPt.Y);
HaveItem:=Item<>Nil;
MICopy.Enabled:=HaveItem;
end;
end.

121
components/aissist/ide/frmaixplain.lfm Normal file
View File

@ -0,0 +1,121 @@
object AIxplainForm: TAIxplainForm
Left = 681
Height = 481
Top = 256
Width = 643
BorderStyle = bsSizeToolWin
Caption = 'AI Code explainer'
ClientHeight = 481
ClientWidth = 643
FormStyle = fsStayOnTop
ShowInTaskBar = stNever
LCLVersion = '3.99.0.0'
OnClose = FormClose
OnCreate = FormCreate
object pnlThinking: TPanel
Left = 0
Height = 26
Top = 0
Width = 643
Align = alTop
BevelOuter = bvNone
Caption = 'AI is thinking about it... '
TabOrder = 0
OnClick = pnlThinkingClick
end
object nbExplain: TNotebook
Left = 0
Height = 405
Top = 26
Width = 643
PageIndex = 0
Align = alClient
TabOrder = 2
object PPrompt: TPage
object mPrompt: TMemo
Left = 0
Height = 405
Top = 0
Width = 643
Align = alClient
ScrollBars = ssAutoBoth
TabOrder = 0
WordWrap = False
end
end
object PReply: TPage
object mExplain: TMemo
Left = 0
Height = 405
Top = 0
Width = 643
Align = alClient
ReadOnly = True
ScrollBars = ssAutoBoth
TabOrder = 0
end
end
end
object bpExplain: TButtonPanel
Left = 6
Height = 38
Top = 437
Width = 631
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton'
HelpButton.DefaultCaption = True
CloseButton.Name = 'CloseButton'
CloseButton.DefaultCaption = True
CancelButton.Name = 'CancelButton'
CancelButton.DefaultCaption = True
TabOrder = 1
ShowButtons = [pbClose]
object SBRefresh: TSpeedButton
Left = 4
Height = 28
Top = 6
Width = 140
Align = alLeft
BorderSpacing.Around = 4
Caption = 'Edit prompt'
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF80293EFF7F2AB1FF7F2ADFFF80
2AF4FF7F2AC9FF802B66FF550003FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF7F
2AABFF802C46FFFFFF00FF802008FF802BA2FF7F2AFFFF7F2AE5FF7F2A9DFF7F
2A8DFF802ACAFF7F2AFFFF802BC0FF792813FFFFFF00FFFFFF00FFFFFF00FF7F
2AFFFF802A80FF6D2407FF802AC2FF7F2AFDFF7E2B7DFF6D2407FFFFFF00FFFF
FF00FFFFFF00FF802A5CFF802BF6FF7F2AC9FF80330AFFFFFF00FFFFFF00FF7F
2AFFFF802A80FF8029A0FF7F2AFDFF7E2957FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FF7E2B4DFF7F2AFDFF7F2A97FFFFFF00FFFFFF00FF7F
2AFFFF7F29A7FF7F2AFFFF7E2B7DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FF7F2B83FF7F2AE3FFFFFF00FFFFFF00FF7F
2AFFFF7F29F7FF802BEAFF802B8AFF802988FF802C46FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF802B06FFFFFF00FFFFFF00FF7F
2AFFFF7F2AFFFF7F2AFFFF7F2AFFFF7F2AFFFF7F2AABFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
FFAB0000FFFF0000FFFF0000FFFF0000FFFF0000FFFFFFFFFF00FFFFFF000000
FF06FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
FF450000FF770000FF790000FFE70000FFF60000FFFFFFFFFF00FFFFFF000000
FFE30000FF82FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF000000FF7D0000FFFF0000FFA70000FFFFFFFFFF00FFFFFF000000
FF990000FFFC0000FF49FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF000000FF570000FFFD0000FFA00000FF800000FFFFFFFFFF00FFFFFF000000
FF0B0000FFCC0000FFF50000FF56FFFFFF00FFFFFF00FFFFFF000000FF070000
FF7C0000FFFD0000FFC20000FF070000FF800000FFFFFFFFFF00FFFFFF00FFFF
FF000000FF150000FFC50000FFFF0000FFC60000FF8A0000FF9B0000FFE40000
FFFF0000FFA30000FF08FFFFFF000000FF460000FFABFFFFFF00FFFFFF00FFFF
FF00FFFFFF000000FF040000FF6A0000FFCD0000FFF70000FFE00000FFB10000
FF3FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
OnClick = SBRefreshClick
end
end
end

198
components/aissist/ide/frmaixplain.pas Normal file
View File

@ -0,0 +1,198 @@
unit frmaixplain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ButtonPanel, ComCtrls, Buttons,
typingindicator, SrcEditorIntf, AIClient;
type
{ TAIxplainForm }
TAIxplainForm = class(TForm)
bpExplain: TButtonPanel;
mExplain: TMemo;
mPrompt: TMemo;
nbExplain: TNotebook;
PPrompt: TPage;
PReply: TPage;
pnlThinking: TPanel;
SBRefresh: TSpeedButton;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure pnlThinkingClick(Sender: TObject);
procedure SBRefreshClick(Sender: TObject);
private
FTyping : TTypingIndicator;
FEditor: TSourceEditorInterface;
FAIClient: TAIClient;
FBusy : Boolean;
procedure ActivateResponse;
procedure CreatePrompt;
function GetPrompt: string;
procedure HandleAIError(Sender: TObject; aErrorData: TAIRequestErrorData);
procedure HandleAIResponse(Sender: TObject; aResponses: TPromptResponseArray);
procedure SendPrompt;
public
procedure Explain(aEditor: TSourceEditorInterface; aAIClient: TAIClient);
end;
var
AIxplainForm: TAIxplainForm;
implementation
uses StrAIssist;
{$R *.lfm}
const
piPrompt = 0;
piReply = 1;
{ TAIxplainForm }
procedure TAIxplainForm.FormCreate(Sender: TObject);
begin
FTyping:=TTypingIndicator.Create(Self);
FTyping.Parent:=PReply;
FTyping.Visible:=False;
FTyping.Width:=80;
FTyping.Height:=40;
FTyping.Top:=mExplain.Top+24;
FTyping.Left:=mExplain.left+24;
pnlThinking.Visible:=False;
nbExplain.PageIndex:=piReply;
sbRefresh.Caption:=EditPromptCaption;
end;
procedure TAIxplainForm.pnlThinkingClick(Sender: TObject);
begin
end;
procedure TAIxplainForm.SBRefreshClick(Sender: TObject);
begin
if nbExplain.PageIndex=piReply then
begin
nbExplain.PageIndex:=piPrompt;
sbRefresh.Caption:=SendPromptCaption;
end
else if nbExplain.PageIndex=piPrompt then
begin
nbExplain.PageIndex:=piReply;
SendPrompt;
sbRefresh.Caption:=EditPromptCaption;
end;
end;
procedure TAIxplainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction:=caFree;
end;
procedure TAIxplainForm.ActivateResponse;
begin
FTyping.Visible:=False;
nbExplain.PageIndex:=piReply;
mExplain.Clear;
mExplain.Visible:=True;
SBRefresh.Visible:=True;
pnlThinking.Visible:=False;
sbRefresh.Caption:=EditPromptCaption;
end;
procedure TAIxplainForm.HandleAIResponse(Sender: TObject; aResponses: TPromptResponseArray);
var
S : TStrings;
begin
FBusy:=False;
ActivateResponse;
if (Length(AResponses)=0) then
begin
mExplain.Lines.Add(SNoExplanation);
end
else
begin
mExplain.Lines.Add(SAIExplanation);
S:=TStringList.Create;
try
S.Text:=aResponses[0].Response;
mExplain.Lines.AddStrings(S);
finally
S.Free;
end;
end;
end;
procedure TAIxplainForm.HandleAIError(Sender: TObject; aErrorData: TAIRequestErrorData);
begin
ActivateResponse;
FBusy:=False;
mExplain.Lines.Add(SErrorTitle);
mExplain.Lines.Add(SErrorIntro);
mExplain.Lines.Add(SErrorInfo,[aErrorData.Error]);
mExplain.Lines.Add(SErrorContext,[aErrorData.Method,aErrorData.URL]);
// Body ?
end;
procedure TAIxplainForm.Explain(aEditor: TSourceEditorInterface; aAIClient: TAIClient);
begin
FEditor:=aEditor;
FAIClient:=aAIClient;
FAIClient.OnError:=@HandleAIError;
FAIClient.SynchronizeCallBacks:=True;
CreatePrompt;
SendPrompt;
end;
function TAIxplainForm.GetPrompt : string;
begin
Result:=mPrompt.Text;
end;
procedure TAIxplainForm.SendPrompt;
begin
if FBusy then
exit;
FBusy:=True;
FAIClient.SendPrompt(@HandleAIResponse,GetPrompt);
mExplain.Clear;
mExplain.Visible:=False;
SBRefresh.Visible:=False;
nbExplain.PageIndex:=piReply;
pnlThinking.Visible:=True;
FTyping.Visible:=True;
end;
procedure TAIxplainForm.CreatePrompt;
var
S : String;
Src : TStrings;
begin
Src:=TStringList.Create;
try
S:=Feditor.GetText(True);
if S='' then
S:=Feditor.GetText(False);
Src.Text:=S;
MPrompt.Lines.Add(SExplainPrompt);
MPrompt.Lines.Add('');
MPrompt.Lines.AddStrings(Src);
finally
Src.Free;
end;
end;
end.

71
components/aissist/ide/laz_aissist.lpk Normal file
View File

@ -0,0 +1,71 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="5">
<Name Value="laz_aissist"/>
<Type Value="DesignTime"/>
<Author Value="Michael Van Canneyt"/>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Description Value="A simple interface to a local/remote AI model, using a REST API"/>
<License Value="Modified LGPL"/>
<Version Minor="9" Release="1"/>
<Files>
<Item>
<Filename Value="frmaissistchat.pas"/>
<UnitName Value="frmaissistchat"/>
</Item>
<Item>
<Filename Value="reglazaissist.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="RegLazAIssist"/>
</Item>
<Item>
<Filename Value="aissistcontroller.pas"/>
<UnitName Value="AIssistController"/>
</Item>
<Item>
<Filename Value="straissist.pas"/>
<UnitName Value="StrAIssist"/>
</Item>
<Item>
<Filename Value="fraaissistconfig.pas"/>
<UnitName Value="fraAIssistConfig"/>
</Item>
<Item>
<Filename Value="frmaixplain.pas"/>
<UnitName Value="frmaixplain"/>
</Item>
</Files>
<RequiredPkgs>
<Item>
<PackageName Value="lazchatctrl"/>
</Item>
<Item>
<PackageName Value="LazControlDsgn"/>
</Item>
<Item>
<PackageName Value="janai"/>
</Item>
<Item>
<PackageName Value="aissist"/>
</Item>
<Item>
<PackageName Value="IDEIntf"/>
</Item>
<Item>
<PackageName Value="FCL"/>
</Item>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
</Package>
</CONFIG>

22
components/aissist/ide/laz_aissist.pas Normal file
View File

@ -0,0 +1,22 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit laz_aissist;
{$warn 5023 off : no warning about unused units}
interface
uses
frmaissistchat, RegLazAIssist, AIssistController, StrAIssist, fraAIssistConfig, frmaixplain, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('RegLazAIssist', @RegLazAIssist.Register);
end;
initialization
RegisterPackage('laz_aissist', @Register);
end.

122
components/aissist/ide/reglazaissist.pas Normal file
View File

@ -0,0 +1,122 @@
{ Copyright (C) 2024
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Michael Van Canneyt
Abstract: AI Assistant registration
}
unit RegLazAIssist;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LazLoggerBase, FileUtil, IDECommands, IDEWindowIntf, LazIDEIntf, MenuIntf, frmaissistchat;
var
AIssistChatForm: TAIssistChatForm;
AIssistChatFormCreator: TIDEWindowCreator; // set by Register procedure
AIssistOptionsFrameID: integer = 3000;
procedure ShowAIssistChatForm(Sender: TObject);
procedure Register; // Check the "Register Unit" of this unit in the package editor.implementation
implementation
uses
IDEOptionsIntf, IDEOptEditorIntf, AIssistController,SrcEditorIntf,
fraAIssistConfig, Forms, StrAIssist;
procedure ShowAIssistChatForm(Sender: TObject);
begin
IDEWindowCreators.ShowForm(AIssistChatFormCreator.FormName, true);
end;
procedure CreateAIssistChatForm(Sender: TObject; aFormName: string;
var AForm: TCustomForm; DoDisableAutoSizing: boolean);
begin
// sanity check to avoid clashing with another package that has registered a window with the same name
if CompareText(aFormName, SAISSistChatForm)<>0 then begin
DebugLn(['ERROR: CreateAIssistChatForm: there is already a form with this name']);
exit;
end;
IDEWindowCreators.CreateForm(AForm, TAIssistChatForm, DoDisableAutoSizing,
LazarusIDE.OwningComponent);
AForm.Name:=aFormName;
AIssistChatForm:=AForm as TAIssistChatForm;
AIssistChatForm.OnConfigure:=@AIController.HandleShowConfig;
end;
procedure ShowAIxplainForm(Sender : TObject);
begin
AIController.ExplainCurrentSelection(SourceEditorManagerIntf.ActiveEditor);
end;
procedure RegisterAIChatWindow;
var
CmdCatViewMenu: TIDECommandCategory;
ViewAIssistChatFormCommand: TIDECommand;
begin
// search shortcut category
CmdCatViewMenu:=IDECommandList.FindCategoryByName(CommandCategoryViewName);
// register shortcut
ViewAIssistChatFormCommand:=RegisterIDECommand(CmdCatViewMenu,
SCMDViewAIssistChatForm,
SAIssistChatMenuCaption,
IDEShortCut(Ord('I'), [ssctrl,ssAlt],Ord('C'), [ssctrl,ssAlt]), // <- set here your default shortcut
CleanIDEShortCut, nil, @ShowAIssistChatForm);
// register menu item in View menu
RegisterIDEMenuCommand(itmViewMainWindows,
SCMDViewAIssistChatForm,
SAIssistChatMenuCaption, nil, nil, ViewAIssistChatFormCommand);
// register dockable Window
AIssistChatFormCreator:=IDEWindowCreators.Add(
'AIssistChatForm',
@CreateAIssistChatForm, nil,
'100', '100', '900', '700' // default place at left=100, top=100, right=300, bottom=300
// you can also define percentage values of screen or relative positions, see wiki
);
// add IDE options frame
AIssistOptionsFrameID:=RegisterIDEOptionsEditor(GroupEnvironment,TAIAssistentConfigFrame,
AIssistOptionsFrameID)^.Index;
end;
procedure RegisterExplainCommand;
var
CatTextEditing: TIDECommandCategory;
AIExplainSelectionCommand: TIDECommand;
begin
CatTextEditing:=IDECommandList.FindCategoryByName(CommandCategoryTextEditingName);
// register shortcut
AIExplainSelectionCommand:=RegisterIDECommand(CatTextEditing,
SCMDExplainSelectedCode,
SAIExplainSelectedCodeCaption,
IDEShortCut(Ord('I'), [ssctrl,ssAlt],Ord('E'), [ssctrl,ssAlt]), // <- set here your default shortcut
CleanIDEShortCut, nil, @ShowAIxplainForm);
// register menu item in View menu
RegisterIDEMenuCommand(itmSourceCodeToolChecks,
SCMDExplainSelectedCode,
SAIExplainSelectedCodeCaption, nil, nil, AIExplainSelectionCommand);
end;
procedure Register;
begin
AIController.LoadConfig;
AIController.ConfigFrame:=TAIAssistentConfigFrame;
RegisterAIChatWindow;
RegisterExplainCommand;
end;
end.

57
components/aissist/ide/straissist.pas Normal file
View File

@ -0,0 +1,57 @@
{ Copyright (C) 2024
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Michael Van Canneyt
Abstract: Strings for AI Assistant
}
unit StrAIssist;
{$mode objfpc}{$H+}
interface
const
SAISSistChatForm = 'AIssistChatForm';
SCMDViewAIssistChatForm = 'ViewAIssistChatForm';
SCMDExplainSelectedCode = 'AIExplainSelectedCode';
SConfigFile = 'aissist.xml';
KeyServerURL = 'ServerURL';
KeyProtocol = 'Protocol';
KeyDefaultModel = 'DefaultModel';
KeyDefaultMaxLength = 'DefaultMaxLength';
Resourcestring
SAIssistChatMenuCaption = 'AIssist chat';
SAIExplainSelectedCodeCaption = 'AI Explain Selected Code';
SConfigTitle = 'AI Assistant options';
SErrorTitle = 'Drat!';
SErrorIntro = 'An error occurred while talking to the AI!';
SErrorInfo = 'Here is the error we got: %s';
SErrorContext = 'This is what we were trying to do: %s %s';
SErrorBody = 'And this is what we were saying:';
SErrPleaseConfigure = 'No AI server has been configured.'+sLineBreak+
'Use the "Configure" button to enter IDE options and configure an AI server';
SErrPleaseEnterPrompt = 'Please enter an AI prompt such as:'+sLineBreak+
'"generate a ''Hello,World!'' program in Pascal".';
SErrAIWaiting = 'The AI engine is still answering your previous prompt.'+
'Please wait for it to finish.';
SErrNoAnswer = 'No answer from AI, try refining your prompt';
SExplainPrompt = 'Explain the following Object Pascal code:';
SNoExplanation = 'The AI could not explain. Maybe ask a different question?';
SAIExplanation = 'This is what the AI thinks of the selected code:';
SendPromptCaption = 'Send AI prompt';
EditPromptCaption = 'Edit AI prompt';
implementation
end.

26
components/aissist/lazaissist.lpg Normal file
View File

@ -0,0 +1,26 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectGroup FileVersion="2">
<Targets>
<Target FileName="api/aissist.lpk"/>
<Target FileName="api/janai/janai.lpk"/>
<Target FileName="ctrls/chatctrls.lpk"/>
<Target FileName="ide/laz_aissist.lpk"/>
<Target FileName="gui/uiassist.lpi">
<BuildModes>
<Mode Name="Default"/>
</BuildModes>
</Target>
<Target FileName="testaissist.lpi">
<BuildModes>
<Mode Name="Default"/>
</BuildModes>
</Target>
<Target FileName="ctrls/demo/chatdemo.lpi">
<BuildModes>
<Mode Name="Default"/>
</BuildModes>
</Target>
</Targets>
</ProjectGroup>
</CONFIG>