1 unit LHelpControl;
2
3 {
4 Starts, stops and controls external help viewer via IPC.
5 This is used to display context-sensitive help in Lazarus, and could be used in applications to do the same.
6
7 Also contains definitions used by both Lazarus IDE and help viewers.
8 Currently, the only help viewer that supports this protocol is the lhelp CHM help viewer.
9 }
10
11 {$mode objfpc}{$H+}
12
13 interface
14
15 uses
16 Classes, SysUtils, SimpleIPC, process,
17 // LazUtils
18 LazFileUtils, LazLoggerBase, UTF8Process;
19
20 const
21 PROTOCOL_VERSION='2'; //IDE<>LHelp communication protocol version. Please update when breaking compatibility
22 // Version 1: original version
23 // Version 2:
24 // - support for Proposed extensions in bug 24743:
25 // - openurl: if applicable return error instead of unknown
26 // - openurl: if applicable return invalid url instead of invalid file for openurl
27 // Version 2.1: ipcname string constant part may only contain A..Z, a..z, _
28 type
29 TRequestType = (rtFile, rtUrl, rtContext, rtMisc {window handling etc});
30 TMiscRequests = (mrShow, mrVersion, mrClose, mrBeginUpdate, mrEndUpdate);
31
32 TLHelpResponse = (srError, srNoAnswer, srUnknown, srSuccess, srInvalidFile, srInvalidURL, srInvalidContext);
33
34 TFileRequest = record
35 // Opening files
36 RequestType: TRequestType;
37 FileName: array[0..512] of char;
38 end;
39 TUrlRequest = record
40 FileRequest: TFileRequest;
41 Url: array[0..512] of char;
42 end;
43 TContextRequest = record
44 FileRequest: TFileRequest;
45 HelpContext: THelpContext;
46 end;
47 TMiscRequest = record
48 // In this record, the FileName array may have a meaning specific to the request ID.
49 FileRequest: TFileRequest;
50 RequestID: TMiscRequests;
51 end;
52
53 TProcedureOfObject = procedure of object;
54
55 { TLHelpConnection }
56
57 TLHelpConnection = class(TObject)
58 private
59 FProcessWhileWaiting: TProcedureOfObject;
60 fServerOut: TSimpleIPCClient; // sends messages to lhelp
61 fServerIn: TSimpleIPCServer; // recieves messages from lhelp
62 // Wait for help viewer to respond in a reasonable timeframe and return the response
WaitForMsgResponsenull63 function WaitForMsgResponse: TLHelpResponse;
64 // Send a message to the help viewer
SendMessagenull65 function SendMessage(Stream: TStream): TLHelpResponse;
66 public
67 constructor Create;
68 destructor Destroy; override;
69 // Checks whether the server is running using SimpleIPC
ServerRunningnull70 function ServerRunning: Boolean;
71 // Starts remote server (help viewer); if Hide specified, asks the help server to hide itself/run minimized while starting
72 // Server must support a switch --ipcname that accepts the NameForServer argument to identify it for SimpleIPC
StartHelpServernull73 function StartHelpServer(NameForServer: String;
74 ServerEXE: String = ''; Hide: boolean=false): Boolean;
75 // Shows URL in the HelpFileName file by sending a TUrlRequest
OpenURLnull76 function OpenURL(HelpFileName: String; Url: String): TLHelpResponse;
77 // Shows help for Context in the HelpFileName file by sending a TContextRequest request
OpenContextnull78 function OpenContext(HelpFileName: String; Context: THelpContext): TLHelpResponse;
79 // Opens HelpFileName by sending a TContextRequest
OpenFilenull80 function OpenFile(HelpFileName: String): TLHelpResponse;
81 // Send BeginUpdate through miscCommand
BeginUpdatenull82 function BeginUpdate: TLHelpResponse;
83 // Send EndUpdate through miscCommand
EndUpdatenull84 function EndUpdate: TLHelpResponse;
85 // Requests to run command on viewer by sending a TMiscrequest
RunMiscCommandnull86 function RunMiscCommand(CommandID: TMiscRequests): TLHelpResponse;
87 // Calling code can set this to process e.g. GUI handling while waiting for help to show
88 property ProcessWhileWaiting: TProcedureOfObject read FProcessWhileWaiting write FProcessWhileWaiting;
89 end;
90
91 implementation
92
93 { TLHelpConnection }
94
TLHelpConnection.WaitForMsgResponsenull95 function TLHelpConnection.WaitForMsgResponse: TLHelpResponse;
96 const
97 // This value should be big enough to give any reasonable help system time to
98 // respond.
99 // If it does respond but takes longer, the delay should be irritating for the
100 // typical user so it then isn't fit for purpose.
101 TimeoutSecs=10;
102 var
103 Stream: TStream;
104 StartTime: TDateTime;
105 TimeOut: TDateTime;
106 begin
107 Result := srNoAnswer;
108 TimeOut := EncodeTime(0,0,TimeOutSecs,0);
109 StartTime := Now;
110 while (Now-StartTime)<TimeOut do
111 begin
112 if fServerIn.PeekMessage(50, True) then
113 begin
114 Stream := fServerIn.MsgData;
115 Stream.Position := 0;
116 Result := TLHelpResponse(Stream.ReadDWord);
117 Exit;
118 end;
119 if Assigned(FProcessWhileWaiting) then FProcessWhileWaiting();
120 end;
121 debugln('LHelpControl: WaitForMsgResponse: hit timeout ('+inttostr(TimeoutSecs)+' seconds)');
122 end;
123
SendMessagenull124 function TLHelpConnection.SendMessage(Stream: TStream): TLHelpResponse;
125 begin
126 Result := srNoAnswer;
127 if fServerOut.Active then
128 begin
129 fServerOut.SendMessage(mtUnknown, Stream);
130 Result := WaitForMsgResponse;
131 end;
132 end;
133
134 constructor TLHelpConnection.Create;
135 begin
136 fServerOut := TSimpleIPCClient.Create(nil);
137 fServerIn := TSimpleIPCServer.Create(nil);
138 end;
139
140 destructor TLHelpConnection.Destroy;
141 begin
142 if fServerOut.Active then
143 fServerOut.Active:=False;
144 if fServerIn.Active then
145 fServerIn.Active:=False;
146 fServerOut.Free;
147 fServerIn.Free;
148 inherited Destroy;
149 end;
150
ServerRunningnull151 function TLHelpConnection.ServerRunning: Boolean;
152 begin
153 Result := (fServerOut<>nil) and (fServerOut.ServerID <> '') and (fServerOut.ServerRunning);
154 end;
155
StartHelpServernull156 function TLHelpConnection.StartHelpServer(NameForServer: String;
157 ServerEXE: String; Hide: boolean=false): Boolean;
158 var
159 X: Integer;
160 Cmd: String;
161 begin
162 Result := False;
163
164 fServerIn.Active := False;
165 fServerIn.ServerID := NameForServer+'client';
166 fServerIn.Global := True;
167 fServerIn.Active := True;
168
169 fServerOut.Active := False;
170 fServerOut.ServerID := NameForServer;
171 if not ServerRunning then
172 begin
173 Cmd := ServerExe + ' --ipcname ' + NameForServer;
174 if Hide then Cmd := Cmd + ' --hide';
175 {$IFDEF darwin}
176 if DirectoryExistsUTF8(ServerEXE+'.app') then
177 ServerEXE+='.app';
178 debugln(['TLHelpConnection.StartHelpServer ',ServerEXE]);
179 if DirectoryExistsUTF8(ServerEXE) then
180 begin
181 // application bundle
182 // to put lhelp into the foreground, use "open -n"
183 Cmd:='/usr/bin/open -n '+ServerEXE+' --args --ipcname ' + NameForServer;
184 end;
185 {$ENDIF}
186 with TProcessUTF8.Create(nil) do
187 begin
188 InheritHandles := false;
189 ShowWindow:=swoShowNormal;
190 ParseCmdLine(Cmd);
191 debugln('TLHelpConnection.StartHelpServer: going to start help server by executing '+Cmd);
192 Execute;
193 Free;
194 end;
195 // give the server some time to get started
196 for X := 0 to 40 do
197 begin
198 // use fServerOut.ServerRunning here instead of Self.ServerRunning to avoid a race condition
199 if not fServerOut.ServerRunning then
200 Sleep(200)
201 else
202 break;
203 end;
204 end;
205 if fServerOut.ServerRunning then
206 begin
207 fServerOut.Active := True;
208 Result := True;
209 end
210 else
211 begin
212 debugln('Could not get lhelp running with command '+Cmd);
213 end;
214 end;
215
OpenURLnull216 function TLHelpConnection.OpenURL(HelpFileName: String; Url: String): TLHelpResponse;
217 var
218 UrlRequest: TUrlRequest;
219 Stream: TMemoryStream;
220 begin
221 Stream := TMemoryStream.Create;
222 try
223 UrlRequest.FileRequest.FileName := HelpFileName+#0;
224 UrlRequest.FileRequest.RequestType := rtURL;
225 UrlRequest.Url := Url+#0;
226 Result := srNoAnswer;
227 try
228 Stream.Write(UrlRequest,SizeOf(UrlRequest));
229 Result := SendMessage(Stream);
230 except
231 // Catch stream read errors etc
232 on E: Exception do
233 begin
234 debugln('Help connection: error '+E.Message+' running UrlRequest command');
235 end;
236 end;
237 finally
238 Stream.Free;
239 end;
240 end;
241
OpenContextnull242 function TLHelpConnection.OpenContext(HelpFileName: String;
243 Context: THelpContext) : TLHelpResponse;
244 var
245 ContextRequest: TContextRequest;
246 Stream: TMemoryStream;
247 begin
248 Stream := TMemoryStream.Create;
249 Result := srNoAnswer;
250 try
251 ContextRequest.FileRequest.FileName := HelpFileName+#0;
252 ContextRequest.FileRequest.RequestType := rtContext;
253 ContextRequest.HelpContext := Context;
254 Result := srNoAnswer;
255 try
256 Stream.Write(ContextRequest, SizeOf(ContextRequest));
257 Result := SendMessage(Stream);
258 except
259 // Catch stream read errors etc
260 on E: Exception do
261 begin
262 debugln('Help connection: error '+E.Message+' running ContextRequest command');
263 end;
264 end;
265 finally
266 Stream.Free;
267 end;
268 end;
269
OpenFilenull270 function TLHelpConnection.OpenFile(HelpFileName: String): TLHelpResponse;
271 var
272 FileRequest : TFileRequest;
273 Stream: TMemoryStream;
274 begin
275 Stream := TMemoryStream.Create;
276 try
277 FileRequest.RequestType := rtFile;
278 FileRequest.FileName := HelpFileName+#0;
279 Result := srNoAnswer;
280 try
281 Stream.Write(FileRequest, SizeOf(FileRequest));
282 Result := SendMessage(Stream);
283 except
284 // Catch stream read errors etc
285 on E: Exception do
286 begin
287 debugln('Help connection: error '+E.Message+' running FileRequest command');
288 end;
289 end;
290 finally
291 Stream.Free;
292 end;
293 end;
294
BeginUpdatenull295 function TLHelpConnection.BeginUpdate: TLHelpResponse;
296 begin
297 Result := RunMiscCommand(mrBeginUpdate);
298 end;
299
EndUpdatenull300 function TLHelpConnection.EndUpdate: TLHelpResponse;
301 begin
302 Result := RunMiscCommand(mrEndUpdate);
303 end;
304
RunMiscCommandnull305 function TLHelpConnection.RunMiscCommand(CommandID: TMiscRequests): TLHelpResponse;
306 var
307 MiscRequest : TMiscRequest;
308 Stream: TMemoryStream;
309 begin
310 Stream := TMemoryStream.Create;
311 try
312 MiscRequest.FileRequest.RequestType := rtMisc;
313 MiscRequest.FileRequest.FileName := ''+#0;
314 //CommandID is ord(TMiscRequests)
315 MiscRequest.RequestID:=CommandID;
316 case CommandID of
317 mrClose: ; //no arguments required
318 mrShow: ; //no arguments required
319 mrVersion:
320 MiscRequest.FileRequest.FileName := PROTOCOL_VERSION+#0;
321 end;
322 try
323 Stream.Write(MiscRequest, SizeOf(MiscRequest));
324 Result := SendMessage(Stream);
325 except
326 // Catch stream read errors etc
327 on E: Exception do
328 begin
329 // When closing, the viewer may not respond in time, which is expected.
330 if CommandID<>mrClose then
331 debugln('Help connection: error '+E.Message+' running MiscRequest command');
332 end;
333 end;
334 finally
335 Stream.Free;
336 end;
337 end;
338
339 end.
340
341