1 // SPDX-License-Identifier: GPL-3.0-only
2 unit UPython;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 Classes, SysUtils, UProcessAuto;
10
11 const
12 DefaultPythonBin = {$IFDEF WINDOWS}'pyw'{$ELSE}'python3'{$ENDIF};
13
14 type
15 TReceiveLineEvent = procedure(ASender: TObject; ALine: UTF8String) of object;
16 TCommandEvent = procedure(ASender: TObject; ACommand, AParam: UTF8String; out AResult: UTF8String) of object;
17
18 { TPythonScript }
19
20 TPythonScript = class
21 private
22 FOnBusy: TNotifyEvent;
23 FPythonBin: string;
24 FPythonVersion: string;
25 FLinePrefix: RawByteString;
26 FOnCommand: TCommandEvent;
27 FOnError: TReceiveLineEvent;
28 FOnOutputLine: TReceiveLineEvent;
29 FPythonSend: TSendLineMethod;
30 FErrorText: UTF8String;
31 FFirstOutput: boolean;
GetPythonVersionMajornull32 function GetPythonVersionMajor: integer;
33 procedure PythonError(ALine: RawByteString);
34 procedure PythonOutput(ALine: RawByteString);
35 procedure PythonBusy(var {%H-}ASleep: boolean);
36 public
37 constructor Create(APythonBin: string = DefaultPythonBin);
38 procedure Run(AScriptFilename: UTF8String; APythonVersion: integer = 3);
DefaultScriptDirectorynull39 class function DefaultScriptDirectory: string;
40 property OnOutputLine: TReceiveLineEvent read FOnOutputLine write FOnOutputLine;
41 property OnError: TReceiveLineEvent read FOnError write FOnError;
42 property OnCommand: TCommandEvent read FOnCommand write FOnCommand;
43 property OnBusy: TNotifyEvent read FOnBusy write FOnBusy;
44 property PythonVersion: string read FPythonVersion;
45 property PythonVersionMajor: integer read GetPythonVersionMajor;
46 property ErrorText: UTF8String read FErrorText;
47 end;
48
GetPythonVersionnull49 function GetPythonVersion(APythonBin: string = DefaultPythonBin): string;
GetScriptTitlenull50 function GetScriptTitle(AFilename: string): string;
51
52 var
53 CustomScriptDirectory: string;
54
55 implementation
56
57 uses process, UResourceStrings, Forms, UTranslation;
58
59 var
60 PythonVersionCache: record
61 Bin: string;
62 Version: string;
63 end;
64
GetPythonVersionnull65 function GetPythonVersion(APythonBin: string = DefaultPythonBin): string;
66 const PythonVersionPrefix = 'Python ';
67 var versionStr: string;
68 begin
69 if (PythonVersionCache.Bin <> APythonBin) or (PythonVersionCache.Version = '?') then
70 begin
71 RunCommand(APythonBin, ['-V'], versionStr, [poStderrToOutPut]);
72 PythonVersionCache.Bin := APythonBin;
73 if versionStr.StartsWith(PythonVersionPrefix) then
74 PythonVersionCache.Version := trim(copy(versionStr,length(PythonVersionPrefix)+1,
75 length(versionStr)-length(PythonVersionPrefix)))
76 else
77 PythonVersionCache.Version := '?';
78 end;
79 result := PythonVersionCache.Version;
80 end;
81
GetScriptTitlenull82 function GetScriptTitle(AFilename: string): string;
83 var t: textfile;
84 header: string;
85 matchLang: boolean;
86
87 procedure RetrieveTitle(AText: string; ADefault: boolean; var title: string; out ALangMatch: boolean);
88 var
89 posCloseBracket: SizeInt;
90 lang: String;
91 begin
92 If AText.StartsWith('#') then
93 Delete(AText, 1,1);
94 AText := AText.Trim;
95 ALangMatch := false;
96 if AText.StartsWith('(') then
97 begin
98 posCloseBracket := pos(')', AText);
99 if posCloseBracket > 0 then
100 begin
101 lang := copy(AText, 2, posCloseBracket-2);
102 delete(AText, 1, posCloseBracket);
103 AText := AText.Trim;
104 if lang = ActiveLanguage then
105 ALangMatch:= true;
106 end;
107 end else
108 begin
109 if not ADefault then exit;
110 if ActiveLanguage = DesignLanguage then ALangMatch:= true;
111 end;
112 if ALangMatch or ADefault then
113 begin
114 title := AText;
115 title := StringReplace(title, ' >', '>', [rfReplaceAll]);
116 title := StringReplace(title, '> ', '>', [rfReplaceAll]);
117 end;
118 end;
119
120 begin
121 result := '';
122 assignFile(t, AFilename);
123 reset(t);
124 try
125 readln(t, header);
126 if header.StartsWith('#') then
127 begin
128 RetrieveTitle(header, true, result, matchLang);
129 while not matchLang do
130 begin
131 readln(t, header);
132 if header.StartsWith('#') then
133 begin
134 RetrieveTitle(header, false, result, matchLang);
135 end else break;
136 end;
137 end;
138 finally
139 closefile(t);
140 end;
141 end;
142
143 { TPythonScript }
144
145 procedure TPythonScript.PythonOutput(ALine: RawByteString);
146 var
147 idxParam, cmdPos: SizeInt;
148 command, param, finalLine: RawByteString;
149 commandRes: UTF8String;
150 i, curDisplayPos, maxDisplayLen: Integer;
151 displayedLine: RawByteString;
152 begin
153 if FFirstOutput then
154 begin
155 if ALine <> 'LazPaint script'#9 then
156 raise exception.Create('This is not a LazPaint script')
157 else
158 begin
159 FFirstOutput:= false;
160 if Assigned(FPythonSend) then
161 FPythonSend(chr(27)+'LazPaint')
162 else
163 raise exception.Create('Send callback not defined');
164 end;
165 end;
166
167 cmdPos := pos(#27, ALine);
168 if (cmdPos > 0) then
169 begin
170 FLinePrefix += copy(ALine, 1, cmdPos-1);
171 delete(ALine, 1, cmdPos-1);
172
173 idxParam := Pos(#29, ALine);
174 param := '';
175 if idxParam = 0 then
176 command := copy(ALine,2,length(ALine)-1)
177 else
178 begin
179 command := copy(ALine,2,idxParam-2);
180 param := copy(ALine,idxParam+1,length(ALine)-(idxParam+1)+1);
181 end;
182 if command<>'' then
183 begin
184 if command[length(command)] = '?' then
185 begin
186 delete(command, length(command), 1);
187 if Assigned(FOnCommand) then
188 FOnCommand(self, command, param, commandRes)
189 else
190 commandRes := '';
191 if Assigned(FPythonSend) then
192 FPythonSend(commandRes);
193 end else
194 begin
195 if Assigned(FOnCommand) then
196 FOnCommand(self, command, param, commandRes);
197 end;
198 end;
199
200 end else
201 begin
202 if Assigned(FOnOutputLine) then
203 begin
204 finalLine := FLinePrefix+ALine;
205 setlength(displayedLine, 80);
206 curDisplayPos := 1;
207 maxDisplayLen := 0;
208 for i := 1 to length(finalLine) do
209 begin
210 if finalLine[i] = #13 then curDisplayPos := 1 else
211 if finalLine[i] = #8 then
212 begin
213 if curDisplayPos > 1 then dec(curDisplayPos);
214 end else
215 begin
216 if curDisplayPos > length(displayedLine) then
217 setlength(displayedLine, length(displayedLine)*2);
218 displayedLine[curDisplayPos] := finalLine[i];
219 if curDisplayPos > maxDisplayLen then
220 maxDisplayLen := curDisplayPos;
221 inc(curDisplayPos);
222 end;
223 end;
224 setlength(displayedLine, maxDisplayLen);
225 FOnOutputLine(self, displayedLine);
226 end;
227 FLinePrefix := '';
228 end;
229 end;
230
231 procedure TPythonScript.PythonBusy(var ASleep: boolean);
232 begin
233 if Assigned(FOnBusy) then FOnBusy(self);
234 end;
235
236 constructor TPythonScript.Create(APythonBin: string);
237 begin
238 FPythonBin := APythonBin;
239 FPythonVersion:= GetPythonVersion(FPythonBin);
240 end;
241
242 procedure TPythonScript.PythonError(ALine: RawByteString);
243 begin
244 if Assigned(FOnError) then
245 FOnError(self, ALine)
246 else
247 FErrorText += ALine+LineEnding;
248 end;
249
TPythonScript.GetPythonVersionMajornull250 function TPythonScript.GetPythonVersionMajor: integer;
251 var
252 posDot: SizeInt;
253 {%H-}errPos: integer;
254 begin
255 posDot := pos('.',PythonVersion);
256 if posDot = 0 then
257 result := 0
258 else
259 val(copy(PythonVersion,1,posDot-1), result, errPos);
260 end;
261
262 procedure TPythonScript.Run(AScriptFilename: UTF8String;
263 APythonVersion: integer);
264 begin
265 FLinePrefix := '';
266 if PythonVersionMajor <> APythonVersion then
267 raise exception.Create(
268 StringReplace( StringReplace(rsPythonUnexpectedVersion,
269 '%1',inttostr(APythonVersion),[]),
270 '%2',inttostr(PythonVersionMajor),[]) + #9 + rsDownload + #9 + 'https://www.python.org');
271 FFirstOutput:= true;
272 AutomationEnvironment.Values['PYTHONPATH'] := DefaultScriptDirectory;
273 try
274 RunProcessAutomation(FPythonBin, ['-u', AScriptFilename], FPythonSend, @PythonOutput, @PythonError, @PythonBusy);
275 finally
276 AutomationEnvironment.Clear;
277 end;
278 FPythonSend := nil;
279 end;
280
TPythonScript.DefaultScriptDirectorynull281 class function TPythonScript.DefaultScriptDirectory: string;
282 begin
283 if CustomScriptDirectory<>'' then
284 result := CustomScriptDirectory
285 else
286 result := GetResourcePath('scripts');
287 end;
288
289 end.
290
291