[Pas2js] Pas2JS: compiler extension to validate XML/XSLT files

[Ondrej Pokorny]

On 30.12.2022 19:13, Ondrej Pokorny via Pas2js wrote:
> I will definitely write back about my success.

I got it working for project&package files: https://postimg.cc/fJQR1S4R

You find the package source code below for reference (maybe it is not 
100% complete, but you should get the idea). Now, if somebody asks you 
to handle HTML/XML/CSS files you can refer them here ;)

Of course it would be possible to read all pascal files and extract the 
{$R} directives from the files, but I am happy with this simple solution.

Ondrej

unit CheckXMLPkg;

{$mode objfpc}{$H+}

interface

uses
   Classes, SysUtils, LazIDEIntf, SrcEditorIntf, ProjectIntf, CodeTree, 
OXmlPDOM, OTextReadWrite;

type
   TEventContainer = class
   private
     function CheckXMLFile(const aFileName: string): Boolean;
     function CheckProjectXMLFiles(Sender: TObject): TModalResult;
     function CheckPackageXMLFiles(APackage: TIDEPackage): TModalResult;
   end;

procedure Register;

implementation

function TEventContainer.CheckPackageXMLFiles(APackage: TIDEPackage): 
TModalResult;
var
   I: Integer;
begin
   Result := mrOK;
   for I := 0 to APackage.FileCount-1 do
     if not CheckXMLFile(APackage.Files[I].Filename) then
       Result := mrCancel;
   if Result=mrCancel then
   begin
     if IDEMessagesWindow.SelectFirstUrgentMessage(mluError, True) then
       IDEMessagesWindow.OpenSelection;
   end;
end;

function TEventContainer.CheckProjectXMLFiles(Sender: TObject): 
TModalResult;
var
   I: Integer;
   xFile: TLazProjectFile;
begin
   Result := mrOK;
   for I := 0 to LazProject1.FileCount-1 do
   begin
     xFile := LazProject1.Files[I];
     if xFile.IsPartOfProject and not CheckXMLFile(xFile.Filename) then
       Result := mrCancel;
   end;
   if Result=mrCancel then
   begin
     if IDEMessagesWindow.SelectFirstUrgentMessage(mluError, True) then
       IDEMessagesWindow.OpenSelection;
   end;
end;

function TEventContainer.CheckXMLFile(const aFileName: string): Boolean;
var
   xXML: TXMLDocument;
   xExt: string;
begin
   xExt := ExtractFileExt(aFileName);
   if not(SameText(xExt, '.xslt') or SameText(xExt, '.xml')) then
     Exit(True);

   // OXml used here, you can use your favorite XML parser
   xXML := TXMLDocument.Create;
   try
     xXML.ReaderSettings.ErrorHandling := ehSilent;
     try
       Result := xXML.LoadFromFile(aFileName) and not 
Assigned(xXML.ParseError);
     except
       on E: EFCreateError do
       begin
         // ignore - file doesn't exist
         Exit(True);
       end;
     end;
     if Assigned(xXML.ParseError) then
     begin
       IDEMessagesWindow.AddCustomMessage(mluError, 
xXML.ParseError.Reason, aFileName, xXML.ParseError.Line, 
xXML.ParseError.LinePos, '');
       Beep;
     end;
   finally
     xXML.Free;
   end;
end;

procedure Register;
var
   EventContainer: TEventContainer = nil;
begin
LazarusIDE.AddHandlerOnProjectBuilding(@EventContainer.CheckProjectXMLFiles);
LazarusIDE.AddHandlerOnPackageBuilding(@EventContainer.CheckPackageXMLFiles);
end;

end.