Skip to content

Commit f88a9fb

Browse files
circular17circular17
authored
Merge pull request #599 from bgrabitmap/master
sync branch
2 parents ec3ea84 + 87aa62a commit f88a9fb

18 files changed

Lines changed: 805 additions & 19 deletions

‎.github/dependabot.yml‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
---
2+
version: 2
3+
updates:
4+
- package-ecosystem: "github-actions"
5+
directory: "/"
6+
schedule:
7+
interval: "monthly"

‎.github/workflows/make.pas‎

Lines changed: 237 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,237 @@
1+
program Make;
2+
{$mode objfpc}{$H+}
3+
4+
uses
5+
Classes,
6+
SysUtils,
7+
StrUtils,
8+
FileUtil,
9+
Zipper,
10+
fphttpclient,
11+
RegExpr,
12+
openssl,
13+
opensslsockets,
14+
Process;
15+
16+
const
17+
Target: string = 'lazpaint';
18+
Dependencies: array of string = ();
19+
20+
type
21+
TLog = (audit, info, error);
22+
Output = record
23+
Success: boolean;
24+
Output: string;
25+
end;
26+
27+
procedure OutLog(Knd: TLog; Msg: string);
28+
begin
29+
case Knd of
30+
error: Writeln(stderr, #27'[31m', Msg, #27'[0m');
31+
info: Writeln(stderr, #27'[32m', Msg, #27'[0m');
32+
audit: Writeln(stderr, #27'[33m', Msg, #27'[0m');
33+
end;
34+
end;
35+
36+
function CheckModules: Output;
37+
begin
38+
if FileExists('.gitmodules') then
39+
if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
40+
'--force', '--remote'], Result.Output) then
41+
OutLog(info, Result.Output);
42+
end;
43+
44+
function AddPackage(Path: string): Output;
45+
begin
46+
with TRegExpr.Create do
47+
begin
48+
Expression :=
49+
{$IFDEF MSWINDOWS}
50+
'(cocoa|x11|_template)'
51+
{$ELSE}
52+
'(cocoa|gdi|_template)'
53+
{$ENDIF}
54+
;
55+
if not Exec(Path) and RunCommand('lazbuild', ['--add-package-link', Path],
56+
Result.Output) then
57+
OutLog(audit, 'added ' + Path);
58+
Free;
59+
end;
60+
end;
61+
62+
function BuildProject(Path: string): Output;
63+
var
64+
Line: string;
65+
begin
66+
OutLog(audit, 'build from ' + Path);
67+
try
68+
Result.Success := RunCommand('lazbuild', ['--build-all', '--recursive',
69+
'--no-write-project', Path], Result.Output);
70+
if Result.Success then
71+
for Line in SplitString(Result.Output, LineEnding) do
72+
begin
73+
if ContainsStr(Line, 'Linking') then
74+
begin
75+
Result.Output := SplitString(Line, ' ')[2];
76+
OutLog(info, ' to ' + Result.Output);
77+
break;
78+
end;
79+
end
80+
else
81+
begin
82+
ExitCode += 1;
83+
for Line in SplitString(Result.Output, LineEnding) do
84+
with TRegExpr.Create do
85+
begin
86+
Expression := '(Fatal|Error):';
87+
if Exec(Line) then
88+
OutLog(error, #10 + Line);
89+
Free;
90+
end;
91+
end;
92+
except
93+
on E: Exception do
94+
OutLog(error, E.ClassName + #13#10 + E.Message);
95+
end;
96+
end;
97+
98+
function RunTest(Path: string): Output;
99+
var
100+
Temp: string;
101+
begin
102+
Result := BuildProject(Path);
103+
Temp:= Result.Output;
104+
if Result.Success then
105+
try
106+
if not RunCommand(Temp, ['--all', '--format=plain', '--progress'], Result.Output) then
107+
begin
108+
ExitCode += 1;
109+
OutLog(error, Result.Output);
110+
end;
111+
except
112+
on E: Exception do
113+
OutLog(error, E.ClassName + #13#10 + E.Message);
114+
end;
115+
end;
116+
117+
function InstallOPM(Each: string): string;
118+
var
119+
OutFile, Uri: string;
120+
Zip: TStream;
121+
begin
122+
Result :=
123+
{$IFDEF MSWINDOWS}
124+
GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
125+
{$ELSE}
126+
GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
127+
{$ENDIF}
128+
+ Each;
129+
OutFile := GetTempFileName;
130+
Uri := 'https://packages.lazarus-ide.org/' + Each + '.zip';
131+
if not DirectoryExists(Result) then
132+
begin
133+
Zip := TFileStream.Create(OutFile, fmCreate or fmOpenWrite);
134+
with TFPHttpClient.Create(nil) do
135+
begin
136+
try
137+
AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
138+
AllowRedirect := True;
139+
Get(Uri, Zip);
140+
OutLog(audit, 'Download from ' + Uri + ' to ' + OutFile);
141+
finally
142+
Free;
143+
end;
144+
end;
145+
Zip.Free;
146+
CreateDir(Result);
147+
with TUnZipper.Create do
148+
begin
149+
try
150+
FileName := OutFile;
151+
OutputPath := Result;
152+
Examine;
153+
UnZipAllFiles;
154+
OutLog(audit, 'Unzip from ' + OutFile + ' to ' + Result);
155+
finally
156+
Free;
157+
end;
158+
end;
159+
DeleteFile(OutFile);
160+
end;
161+
end;
162+
163+
function LintPython(Path: string): Output;
164+
begin
165+
OutLog(audit, 'Linting Python file: ' + Path);
166+
if not RunCommand('python3', ['-m', 'pylint', Path], Result.Output) then
167+
begin
168+
OutLog(error, Result.Output);
169+
//ExitCode += 1;
170+
end
171+
end;
172+
173+
function LintC(Path: string): Output;
174+
begin
175+
OutLog(audit, 'Linting C file: ' + Path);
176+
if not RunCommand('cppcheck', ['--language=c', '--enable=warning,style', '--template=gcc', Path], Result.Output) then
177+
begin
178+
OutLog(error, Result.Output);
179+
//ExitCode += 1;
180+
end
181+
end;
182+
183+
function LintShell(Path: string): Output;
184+
begin
185+
OutLog(audit, 'Linting Shell file: ' + Path);
186+
if not RunCommand('shellcheck', ['--external-sources', Path], Result.Output) then
187+
begin
188+
OutLog(error, Result.Output);
189+
//ExitCode += 1;
190+
end
191+
end;
192+
193+
procedure BuildAll;
194+
var
195+
Each, Item: string;
196+
List: TStringList;
197+
begin
198+
CheckModules;
199+
InitSSLInterface;
200+
for Item in Dependencies do
201+
begin
202+
List := FindAllFiles(InstallOPM(Item), '*.lpk', True);
203+
try
204+
for Each in List do
205+
AddPackage(Each);
206+
finally
207+
List.Free;
208+
end;
209+
end;
210+
List := FindAllFiles(GetCurrentDir, '*.lpk', True);
211+
try
212+
for Each in List do
213+
AddPackage(Each);
214+
finally
215+
List.Free;
216+
end;
217+
List := FindAllFiles(Target, '*.lpi', True);
218+
try
219+
for Each in List do
220+
if not ContainsStr(Each, 'zengl') then
221+
if ContainsStr(ReadFileToString(ReplaceStr(Each, '.lpi', '.lpr')),
222+
'consoletestrunner') then
223+
RunTest(Each)
224+
else
225+
BuildProject(Each);
226+
finally
227+
List.Free;
228+
end;
229+
if ExitCode <> 0 then
230+
OutLog(error, #10 + 'Errors: ' + IntToStr(ExitCode))
231+
else
232+
OutLog(info, #10 + 'Errors: ' + IntToStr(ExitCode));
233+
end;
234+
235+
begin
236+
BuildAll;
237+
end.

‎.github/workflows/make.yml‎

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
---
2+
name: Make
3+
4+
on:
5+
schedule:
6+
- cron: '0 0 1 * *'
7+
push:
8+
branches:
9+
- "**"
10+
pull_request:
11+
branches:
12+
- master
13+
- main
14+
15+
concurrency:
16+
group: ${{ github.workflow }}-${{ github.ref }}
17+
cancel-in-progress: true
18+
19+
jobs:
20+
build:
21+
runs-on: ${{ matrix.os }}
22+
timeout-minutes: 120
23+
strategy:
24+
matrix:
25+
os:
26+
- ubuntu-latest
27+
- windows-latest
28+
steps:
29+
- name: Checkout
30+
uses: actions/checkout@v4
31+
with:
32+
submodules: true
33+
34+
- name: Build on Linux
35+
if: runner.os == 'Linux'
36+
shell: bash
37+
run: |
38+
set -xeuo pipefail
39+
sudo bash -c 'apt-get update; apt-get install -y lazarus cppcheck pylint shellcheck' >/dev/null
40+
instantfpc -Fu/usr/lib/lazarus/*/components/lazutils .github/workflows/make.pas
41+
42+
- name: Build on Windows
43+
if: runner.os == 'Windows'
44+
shell: powershell
45+
run: |
46+
New-Variable -Option Constant -Name VAR -Value @{
47+
Uri = 'https://fossies.org/windows/misc/lazarus-3.8-fpc-3.2.2-win64.exe'
48+
OutFile = (New-TemporaryFile).FullName + '.exe'
49+
}
50+
Invoke-WebRequest @VAR
51+
& $VAR.OutFile.Replace('Temp', 'Temp\.') /SP- /VERYSILENT /SUPPRESSMSGBOXES /NORESTART | Out-Null
52+
$Env:PATH+=';C:\Lazarus'
53+
$Env:PATH+=';C:\Lazarus\fpc\3.2.2\bin\x86_64-win64'
54+
(Get-Command 'lazbuild').Source | Out-Host
55+
(Get-Command 'instantfpc').Source | Out-Host
56+
instantfpc '-FuC:\Lazarus\components\lazutils' .github/workflows/make.pas

‎.gitmodules‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
[submodule "use/bgrabitmap"]
2+
path = use/bgrabitmap
3+
url = git@github.com:bgrabitmap/bgrabitmap.git
4+
[submodule "use/bgracontrols"]
5+
path = use/bgracontrols
6+
url = git@github.com:bgrabitmap/bgracontrols.git

‎Install/flatpak/0001-515-runtime-fix-for-Qt.patch‎

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
From 11b9c647dd96edaf4a3240a3683493fb37a0e0e0 Mon Sep 17 00:00:00 2001
2+
From: Johann ELSASS <circular@operamail.com>
3+
Date: Thu, 28 Dec 2023 16:40:48 +0100
4+
Subject: [PATCH] #515 runtime fix for Qt
5+
6+
---
7+
lazpaint/lazpaintmainform.lfm | 1 +
8+
lazpaint/lazpaintmainform.pas | 2 ++
9+
2 files changed, 3 insertions(+)
10+
11+
diff --git a/lazpaint/lazpaintmainform.lfm b/lazpaint/lazpaintmainform.lfm
12+
index a2dffa1..2765760 100644
13+
--- a/lazpaint/lazpaintmainform.lfm
14+
+++ b/lazpaint/lazpaintmainform.lfm
15+
@@ -5769,6 +5769,7 @@ object FMain: TFMain
16+
Top = 514
17+
end
18+
object TimerUpdate: TTimer
19+
+ Enabled = False
20+
Interval = 50
21+
OnTimer = TimerUpdateTimer
22+
Left = 653
23+
diff --git a/lazpaint/lazpaintmainform.pas b/lazpaint/lazpaintmainform.pas
24+
index 708cb24..551c7d0 100644
25+
--- a/lazpaint/lazpaintmainform.pas
26+
+++ b/lazpaint/lazpaintmainform.pas
27+
@@ -1251,6 +1251,7 @@ begin
28+
UpdateToolBar;
29+
FShouldArrange := true;
30+
QueryArrange;
31+
+ TimerUpdate.Enabled := true;
32+
end;
33+
34+
procedure TFMain.OnLatestVersionUpdate(ANewVersion: string);
35+
@@ -2593,6 +2594,7 @@ end;
36+
37+
procedure TFMain.FormHide(Sender: TObject);
38+
begin
39+
+ TimerUpdate.Enabled := false;
40+
FShouldArrange := false;
41+
FTopMostInfo := LazPaintInstance.HideTopmost;
42+
LazPaintInstance.SaveMainWindowPosition;
43+
--
44+
2.43.0
45+

‎Install/flatpak/0001-avoid-crash-on-Qt5.patch‎

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
From d73455025d71226472e7eb880da36f6fb85c5df0 Mon Sep 17 00:00:00 2001
2+
From: Johann ELSASS <circular@fastmail.com>
3+
Date: Thu, 6 Oct 2022 21:44:47 +0200
4+
Subject: [PATCH] avoid crash on Qt5
5+
6+
---
7+
lazpaint/lazpaintinstance.pas | 1 +
8+
lazpaint/lazpaintmainform.pas | 1 +
9+
2 files changed, 2 insertions(+)
10+
11+
diff --git a/lazpaint/lazpaintinstance.pas b/lazpaint/lazpaintinstance.pas
12+
index 5da9ac6..b5f624b 100644
13+
--- a/lazpaint/lazpaintinstance.pas
14+
+++ b/lazpaint/lazpaintinstance.pas
15+
@@ -374,6 +374,7 @@ procedure TLazPaintInstance.ReportActionProgress(AProgressPercent: integer);
16+
var
17+
delay: Integer;
18+
begin
19+
+ {$IFDEF LCLqt5}exit;{$ENDIF}
20+
if AProgressPercent < 100 then delay := 10000 else delay := 1000;
21+
if Assigned(FMain) then FMain.UpdatingPopup:= true;
22+
try
23+
diff --git a/lazpaint/lazpaintmainform.pas b/lazpaint/lazpaintmainform.pas
24+
index 0fe875c..708cb24 100644
25+
--- a/lazpaint/lazpaintmainform.pas
26+
+++ b/lazpaint/lazpaintmainform.pas
27+
@@ -2695,6 +2695,7 @@ end;
28+
29+
procedure TFMain.TimerUpdateTimer(Sender: TObject);
30+
begin
31+
+ if FLazPaintInstance = nil then exit;
32+
TimerUpdate.Enabled := false;
33+
if ToolManager.ToolSleeping and not spacePressed and
34+
([ssLeft,ssRight,ssMiddle] * FLayout.MouseButtonState = []) then
35+
--
36+
2.43.0
37+

0 commit comments

Comments
 (0)