source: trunk/NewView/CmdLineParameterUnit.pas@ 29

Last change on this file since 29 was 29, checked in by RBRi, 19 years ago

more parser fixes and new unit tests
  • Property svn:eol-style set to native
File size: 15.2 KB
Line 
1Unit CmdLineParameterUnit;
2
3// NewView - a new OS/2 Help Viewer
4// Copyright 2006 Ronald Brill (rbri at rbri dot de)
5// This software is released under the Gnu Public License - see readme.txt
6
7// Helper functions to address the command line parameters newview
8// is started with
9
10Interface
11
12uses
13 Os2Def, BseTib, BseDos,
14 SysUtils,
15 Classes,
16
17 PMWIN,
18
19 ACLStringUtility,
20 ACLProfile,
21 ACLFileUtility;
22
23 CONST
24 SUCCESS = 0;
25 ERROR_UNMATCHED_QUOTE = -1;
26
27 TYPE
28 TWindowPosition = record
29 left: longint;
30 bottom: longint;
31 width: longint;
32 height: longint;
33 end;
34 TYPE
35 TCmdLineParameters = class
36 private
37 showUsageFlag : boolean;
38 searchTextFlag : boolean;
39 searchText : string;
40 globalSearchTextFlag : boolean;
41 globalSearchText : string;
42 language : string;
43 helpManagerFlag : boolean;
44 helpManagerWindow : integer;
45 windowPositionFlag: boolean;
46 windowPosition: TWindowPosition;
47 ownerWindow : integer;
48 windowTitle : string;
49 fileNames : string;
50 topics : string;
51
52 public
53 FUNCTION getShowUsageFlag : boolean;
54 FUNCTION getSearchTextFlag : boolean;
55 FUNCTION getSearchText : string;
56 FUNCTION getGlobalSearchTextFlag : boolean;
57 FUNCTION getGlobalSearchText : string;
58 FUNCTION getLanguage : string;
59 FUNCTION getHelpManagerFlag : boolean;
60 FUNCTION setHelpManagerFlag(aNewValue : boolean) : boolean;
61 FUNCTION getHelpManagerWindow : integer;
62 FUNCTION getWindowPositionFlag : boolean;
63 FUNCTION getWindowPosition : TWindowPosition;
64 FUNCTION getOwnerWindow : integer;
65 FUNCTION getWindowTitle : string;
66 FUNCTION getFileNames : string;
67 FUNCTION getTopics : string;
68 PROCEDURE parseCmdLine(aSplittedCmdLine : TStringList);
69 end;
70
71 // returns a string containing the whole
72 // command line parametes
73 FUNCTION nativeOS2GetCmdLineParameter : STRING;
74
75 // returns a string containing the whole
76 // command line parametes
77 FUNCTION splitCmdLineParameter(aCmdLineString : String; var aResult : TStringList) : integer;
78
79 // Return true if param matches the form
80 // /Flag:value
81 // dash (-) can be used instead of slash (/)
82 // colon can be omitted
83 FUNCTION MatchValueParam( const aParam: string; const aFlag: string; var aValue: string): boolean;
84
85 // Return true if param matches the form
86 // /Flag
87 // dash (-) can be used instead of slash (/)
88 FUNCTION MatchFlagParam( const aParam: string; const aFlag: string): boolean;
89
90 // Extract a single element of a window position spec
91 // - take a value from comma-separated list
92 // - convert to numeric
93 // - if the number ends with P then take as
94 // a percentage of given dimension
95 FUNCTION ExtractPositionElement(Var aParamValue: string; aScreenDimension: longint) : longint;
96
97 // Extract a specified window position:
98 // X,Y,W,H
99 FUNCTION ExtractPositionSpec(aParamValue: string; Var aPosition: TWindowPosition ): boolean;
100Implementation
101
102 FUNCTION TCmdLineParameters.getShowUsageFlag : boolean;
103 begin
104 result := showUsageFlag;
105 end;
106
107
108 FUNCTION TCmdLineParameters.getSearchTextFlag : boolean;
109 begin
110 result := searchTextFlag;
111 end;
112
113
114 FUNCTION TCmdLineParameters.getSearchText : string;
115 begin
116 result := searchText;
117 end;
118
119
120 FUNCTION TCmdLineParameters.getGlobalSearchTextFlag : boolean;
121 begin
122 result := globalSearchTextFlag;
123 end;
124
125
126 FUNCTION TCmdLineParameters.getGlobalSearchText : string;
127 begin
128 result := globalSearchText;
129 end;
130
131
132 FUNCTION TCmdLineParameters.getLanguage : string;
133 begin
134 result := language;
135 end;
136
137
138 FUNCTION TCmdLineParameters.getHelpManagerFlag : boolean;
139 begin
140 result := helpManagerFlag;
141 end;
142
143
144 FUNCTION TCmdLineParameters.setHelpManagerFlag(aNewValue : boolean) : boolean;
145 begin
146 helpManagerFlag := aNewValue;
147 result := helpManagerFlag;
148 end;
149
150
151 FUNCTION TCmdLineParameters.getHelpManagerWindow : integer;
152 begin
153 result := helpManagerWindow;
154 end;
155
156
157 FUNCTION TCmdLineParameters.getWindowPositionFlag : boolean;
158 begin
159 result := windowPositionFlag;
160 end;
161
162
163 FUNCTION TCmdLineParameters.getWindowPosition : TWindowPosition;
164 begin
165 result := windowPosition;
166 end;
167
168
169 FUNCTION TCmdLineParameters.getOwnerWindow : integer;
170 begin
171 result := ownerWindow;
172 end;
173
174
175 FUNCTION TCmdLineParameters.getWindowTitle : string;
176 begin
177 result := windowTitle;
178 end;
179
180
181 FUNCTION TCmdLineParameters.getFileNames : string;
182 begin
183 result := fileNames;
184 end;
185
186
187 FUNCTION TCmdLineParameters.getTopics : string;
188 begin
189 result := topics;
190 end;
191
192
193 procedure TCmdLineParameters.parseCmdLine(aSplittedCmdLine : TStringList);
194 var
195 tmpParamIndex : integer;
196 tmpParameter : string;
197 tmpParameterValue : string;
198 begin
199 ProfileEvent( 'ParseCommandLineParameters started' );
200
201 // reset the whole object
202 showUsageFlag := false;
203 searchTextFlag := false;
204 searchText := '';
205 globalSearchTextFlag := false;
206 globalSearchText := '';
207 language := '';
208 helpManagerFlag := false;
209 helpManagerWindow := 0;
210 windowPositionFlag := false;
211 // windowPosition;
212 ownerWindow := 0;
213 windowTitle := '';
214
215 filenames := '';
216 topics := '';
217
218 // start parsing
219 for tmpParamIndex := 0 to aSplittedCmdLine.Count -1 do
220 begin
221 tmpParameter := aSplittedCmdLine[tmpParamIndex];
222
223 if MatchFlagParam(tmpParameter, '?')
224 or MatchFlagParam(tmpParameter, 'H')
225 or MatchFlagParam(tmpParameter, 'HELP') then
226 begin
227 showUsageFlag := true
228 end
229 else if MatchValueParam(tmpParameter, 'G', globalSearchText) then
230 begin
231 globalSearchTextFlag := true;
232 end
233 else if MatchValueParam(tmpParameter, 'S', searchText) then
234 begin
235 searchTextFlag := true;
236 end
237 else if MatchValueParam(tmpParameter, 'LANG', language) then
238 begin
239 // nothing to do
240 end
241 else if MatchValueParam(tmpParameter, 'HM', tmpParameterValue) then
242 begin
243 try
244 helpManagerWindow := StrToInt(tmpParameterValue);
245 helpManagerFlag := true;
246 except
247 // ignore invalid window value
248 end;
249 end
250 else if MatchValueParam(tmpParameter, 'OWNER', tmpParameterValue) then
251 begin
252 try
253 ownerWindow := StrToInt(tmpParameterValue);
254 except
255 // ignore invalid owner value
256 end;
257 end
258 else if MatchValueParam(tmpParameter, 'TITLE', windowTitle) then
259 begin
260 // nothing to do
261 end
262 else if MatchFlagParam(tmpParameter, 'PROFILE') then
263 begin
264 StartProfile(GetLogFilesDir + 'newview.prf' );
265 end
266 else if MatchValueParam(tmpParameter, 'POS', tmpParameterValue ) then
267 begin
268 // set window position/size
269 if ExtractPositionSpec(tmpParameterValue, windowPosition) then
270 begin
271 windowPositionFlag := true;
272 end
273 else
274 begin
275 // invalid...
276 showUsageFlag := true;
277 end;
278 end
279 else
280 begin
281 if length(filenames) = 0 then
282 begin
283 // filename
284 fileNames := tmpParameter;
285 end
286 else
287 begin
288 // search (topic) parameter... append all remaining thingies
289 if topics <> '' then
290 begin
291 topics := topics + ' ';
292 end;
293 topics := topics + tmpParameter;
294 end;
295 end;
296 end;
297
298 ProfileEvent('Parameters parsed');
299 ProfileEvent(' Filename(s): ' + fileNames);
300 ProfileEvent(' Topic(s): ' + topics);
301 ProfileEvent( '...done' );
302 end;
303
304
305FUNCTION nativeOS2GetCmdLineParameter : STRING;
306 VAR
307 tmpPtib : PTIB; /* thread information block */
308 tmpPpib : PPIB; /* process information block */
309 tmpCmd : PCHAR;
310 tmpResult : PCHAR;
311
312 BEGIN
313 DosGetInfoBlocks(tmpPtib, tmpPpib);
314 tmpCmd := tmpPpib^.pib_pchcmd;
315 tmpResult := tmpCmd + StrLen(tmpCmd) + 1;
316 nativeOS2GetCmdLineParameter := StrPas(tmpResult);
317 END;
318
319
320FUNCTION splitCmdLineParameter(aCmdLineString : String; var aResult : TStringList) : integer;
321 CONST
322 STATE_BEFORE = 0;
323 STATE_INSIDE = 1;
324 STATE_START_QUOTE = 2;
325 STATE_INSIDE_QUOTED = 3;
326 STATE_INSIDE_QUOTED_START_QUOTE = 4;
327// STATE_INSIDE_QUOTED_QUOTE_PROCESSED = 5;
328 VAR
329 i : Integer;
330 tmpCurrentChar : char;
331 tmpState : INTEGER;
332 tmpCurrentCommand : String;
333
334 BEGIN
335 result := SUCCESS;
336 aResult.Clear;
337
338 tmpState := STATE_BEFORE;
339 tmpCurrentCommand := '';
340 for i:=1 to length(aCmdLineString) do
341 begin
342 tmpCurrentChar := aCmdLineString[i];
343
344 Case tmpCurrentChar of
345 ' ' :
346 begin
347 Case tmpState of
348 STATE_BEFORE : {do nothing};
349 STATE_INSIDE :
350 begin
351 aResult.add(tmpCurrentCommand);
352 tmpCurrentCommand := '';
353 tmpState := STATE_BEFORE;
354 end;
355 STATE_INSIDE_QUOTED_START_QUOTE :
356 begin
357 aResult.add(tmpCurrentCommand);
358 tmpCurrentCommand := '';
359 tmpState := STATE_BEFORE;
360 end;
361 ELSE
362 begin
363 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
364 end;
365 end;
366 end;
367
368 '"' :
369 begin
370 Case tmpState of
371 STATE_START_QUOTE :
372 begin
373 tmpState := STATE_INSIDE_QUOTED_START_QUOTE;
374 end;
375 STATE_INSIDE_QUOTED :
376 tmpState := STATE_INSIDE_QUOTED_START_QUOTE;
377 STATE_INSIDE_QUOTED_START_QUOTE :
378 begin
379 tmpState := STATE_INSIDE_QUOTED;
380// tmpState := STATE_INSIDE_QUOTED_QUOTE_PROCESSED;
381 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
382 end;
383// STATE_INSIDE_QUOTED_QUOTE_PROCESSED :
384// tmpState := STATE_INSIDE_QUOTED_START_QUOTE;
385 ELSE
386 tmpState := STATE_START_QUOTE;
387 end;
388 end;
389 ELSE
390 begin
391 Case tmpState of
392 STATE_BEFORE :
393 begin
394 tmpState := STATE_INSIDE;
395 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
396 end;
397 STATE_INSIDE :
398 begin
399 tmpState := STATE_INSIDE;
400 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
401 end;
402 STATE_START_QUOTE :
403 begin
404 tmpState := STATE_INSIDE_QUOTED;
405 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
406 end;
407 STATE_INSIDE_QUOTED :
408 begin
409 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
410 end;
411 STATE_INSIDE_QUOTED_START_QUOTE :
412 begin
413 tmpState := STATE_INSIDE;
414 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
415 end;
416// STATE_INSIDE_QUOTED_QUOTE_PROCESSED :
417// begin
418// tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
419// end;
420 end;
421 end;
422 end;
423 end;
424
425 Case tmpState of
426 STATE_BEFORE : { nothing to do};
427 STATE_INSIDE :
428 begin
429 aResult.add(tmpCurrentCommand);
430 end;
431 STATE_START_QUOTE :
432 begin
433 result := ERROR_UNMATCHED_QUOTE;
434 end;
435 STATE_INSIDE_QUOTED_START_QUOTE :
436 begin
437 if (0 < length(tmpCurrentCommand)) then
438 begin
439 aResult.add(tmpCurrentCommand);
440 end;
441 end;
442 STATE_INSIDE_QUOTED :
443 begin
444 result := ERROR_UNMATCHED_QUOTE;
445 if (0 < length(tmpCurrentCommand)) then
446 begin
447 aResult.add(tmpCurrentCommand);
448 end;
449 end;
450// STATE_INSIDE_QUOTED_QUOTE_PROCESSED :
451// begin
452// result := ERROR_UNMATCHED_QUOTE;
453// if (1 < length(tmpCurrentCommand)) then
454// begin
455// aResult.add(copy(tmpCurrentCommand, 1, length(tmpCurrentCommand)-0));
456// end
457// end;
458 ELSE
459 begin
460 result := ERROR_UNMATCHED_QUOTE;
461 if (0 < length(tmpCurrentCommand)) then
462 begin
463 aResult.add(tmpCurrentCommand);
464 end;
465 end;
466 end;
467 END;
468
469
470FUNCTION MatchValueParam( const aParam: string; const aFlag: string; var aValue: string ): boolean;
471begin
472 Result := false;
473
474 if aParam = '' then
475 exit;
476
477 if ( aParam[ 1 ] <> '/' )
478 and ( aParam[ 1 ] <> '-' ) then
479 exit;
480
481 if CompareText(copy(aParam, 2, length(aFlag)), aFlag) <> 0 then
482 exit;
483
484 Result := true;
485
486 aValue := copy(aParam, 2 + length(aFlag), length(aParam));
487 if aValue <> '' then
488 if aValue[ 1 ] = ':' then
489 delete(aValue, 1, 1 );
490end;
491
492
493FUNCTION MatchFlagParam(const aParam: string; const aFlag: string ): boolean;
494begin
495 Result := false;
496
497 if aParam = '' then
498 exit;
499
500 if (aParam[ 1 ] <> '/' )
501 and (aParam[ 1 ] <> '-' ) then
502 exit;
503 Result := CompareText(copy(aParam, 2, length(aParam)-1), aFlag) = 0;
504end;
505
506
507FUNCTION ExtractPositionElement(Var aParamValue: string; aScreenDimension: longint ): longint;
508var
509 tmpElement: string;
510begin
511 tmpElement := ExtractNextValue(aParamValue, ',' );
512 if tmpElement = '' then
513 raise Exception.Create('Missing position element');
514 if StrEnds('P', tmpElement) then
515 begin
516 Delete(tmpElement, length(tmpElement), 1);
517 if tmpElement = '' then
518 raise Exception.Create('Missing position element');
519 Result := StrToInt(tmpElement);
520 if Result < 0 then
521 Result := 0;
522 if Result > 100 then
523 Result := 100;
524 Result := Round(Result / 100 * aScreenDimension);
525 end
526 else
527 begin
528 Result := StrToInt(tmpElement);
529 end;
530end;
531
532FUNCTION SystemMetrics(aSystemMetric : LONG) : LongInt;
533Begin
534 Result := WinQuerySysValue(HWND_DESKTOP, aSystemMetric);
535end;
536
537FUNCTION ExtractPositionSpec(aParamValue: string; Var aPosition: TWindowPosition ): boolean;
538begin
539 try
540 aPosition.Left := ExtractPositionElement(aParamValue, SystemMetrics(SV_CXSCREEN));
541 aPosition.Bottom := ExtractPositionElement(aParamValue, SystemMetrics(SV_CYSCREEN));
542 aPosition.Width := ExtractPositionElement(aParamValue, SystemMetrics(SV_CXSCREEN));
543 if aPosition.Width < 50 then
544 aPosition.Width := 50;
545 aPosition.Height := ExtractPositionElement(aParamValue, SystemMetrics(SV_CYSCREEN));
546 if aPosition.Height < 50 then
547 aPosition.Height := 50;
548 Result := true;
549 except
550 Result := false;
551 end;
552end;
553
554
555END.
Note: See TracBrowser for help on using the repository browser.