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