source: trunk/NewView/CmdLineParameterUnit.pas@ 32

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

% more source cleanup (uses)
  • Property svn:eol-style set to native
File size: 13.3 KB
RevLine 
[23]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
[32]13 Os2Def,
14 BseTib,
15 BseDos,
[23]16 SysUtils,
17 Classes,
18 PMWIN,
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;
[25]49 fileNames : string;
50 topics : string;
[23]51
52 public
[32]53 PROPERTY getShowUsageFlag : boolean read showUsageFlag;
54 PROPERTY getSearchTextFlag : boolean read searchTextFlag;
55 PROPERTY getSearchText : string read searchText;
56 PROPERTY getGlobalSearchTextFlag : boolean read globalSearchTextFlag;
57 PROPERTY getGlobalSearchText : string read globalSearchText;
58 PROPERTY getLanguage : string read language;
59 PROPERTY getHelpManagerFlag : boolean read helpManagerFlag;
[25]60 FUNCTION setHelpManagerFlag(aNewValue : boolean) : boolean;
[32]61 PROPERTY getHelpManagerWindow : integer read helpManagerWindow;
62 PROPERTY getWindowPositionFlag : boolean read windowPositionFlag;
63 PROPERTY getWindowPosition : TWindowPosition read windowPosition;
64 PROPERTY getOwnerWindow : integer read ownerWindow;
65 PROPERTY getWindowTitle : string read windowTitle;
66 PROPERTY getFileNames : string read fileNames;
67 PROPERTY getTopics : string read topics;
[23]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
[25]77 FUNCTION splitCmdLineParameter(aCmdLineString : String; var aResult : TStringList) : integer;
[23]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
[25]102 FUNCTION TCmdLineParameters.setHelpManagerFlag(aNewValue : boolean) : boolean;
103 begin
104 helpManagerFlag := aNewValue;
105 result := helpManagerFlag;
106 end;
107
108
[23]109 procedure TCmdLineParameters.parseCmdLine(aSplittedCmdLine : TStringList);
110 var
111 tmpParamIndex : integer;
112 tmpParameter : string;
113 tmpParameterValue : string;
114 begin
[25]115 ProfileEvent( 'ParseCommandLineParameters started' );
116
[23]117 // reset the whole object
118 showUsageFlag := false;
119 searchTextFlag := false;
120 searchText := '';
121 globalSearchTextFlag := false;
122 globalSearchText := '';
123 language := '';
124 helpManagerFlag := false;
125 helpManagerWindow := 0;
126 windowPositionFlag := false;
127 // windowPosition;
128 ownerWindow := 0;
129 windowTitle := '';
130
[25]131 filenames := '';
132 topics := '';
[23]133
134 // start parsing
135 for tmpParamIndex := 0 to aSplittedCmdLine.Count -1 do
136 begin
137 tmpParameter := aSplittedCmdLine[tmpParamIndex];
138
139 if MatchFlagParam(tmpParameter, '?')
140 or MatchFlagParam(tmpParameter, 'H')
141 or MatchFlagParam(tmpParameter, 'HELP') then
142 begin
143 showUsageFlag := true
144 end
145 else if MatchValueParam(tmpParameter, 'G', globalSearchText) then
146 begin
147 globalSearchTextFlag := true;
148 end
149 else if MatchValueParam(tmpParameter, 'S', searchText) then
150 begin
151 searchTextFlag := true;
152 end
153 else if MatchValueParam(tmpParameter, 'LANG', language) then
154 begin
155 // nothing to do
156 end
157 else if MatchValueParam(tmpParameter, 'HM', tmpParameterValue) then
158 begin
159 try
160 helpManagerWindow := StrToInt(tmpParameterValue);
161 helpManagerFlag := true;
162 except
163 // ignore invalid window value
164 end;
165 end
166 else if MatchValueParam(tmpParameter, 'OWNER', tmpParameterValue) then
167 begin
168 try
169 ownerWindow := StrToInt(tmpParameterValue);
170 except
171 // ignore invalid owner value
172 end;
173 end
174 else if MatchValueParam(tmpParameter, 'TITLE', windowTitle) then
175 begin
176 // nothing to do
177 end
178 else if MatchFlagParam(tmpParameter, 'PROFILE') then
179 begin
180 StartProfile(GetLogFilesDir + 'newview.prf' );
181 end
182 else if MatchValueParam(tmpParameter, 'POS', tmpParameterValue ) then
183 begin
184 // set window position/size
185 if ExtractPositionSpec(tmpParameterValue, windowPosition) then
186 begin
187 windowPositionFlag := true;
188 end
189 else
190 begin
191 // invalid...
192 showUsageFlag := true;
193 end;
194 end
195 else
196 begin
[25]197 if length(filenames) = 0 then
[23]198 begin
199 // filename
[25]200 fileNames := tmpParameter;
[23]201 end
202 else
203 begin
204 // search (topic) parameter... append all remaining thingies
[25]205 if topics <> '' then
[23]206 begin
[25]207 topics := topics + ' ';
[23]208 end;
[25]209 topics := topics + tmpParameter;
[23]210 end;
211 end;
212 end;
[25]213
214 ProfileEvent('Parameters parsed');
215 ProfileEvent(' Filename(s): ' + fileNames);
216 ProfileEvent(' Topic(s): ' + topics);
217 ProfileEvent( '...done' );
[23]218 end;
219
220
221FUNCTION nativeOS2GetCmdLineParameter : STRING;
222 VAR
223 tmpPtib : PTIB; /* thread information block */
224 tmpPpib : PPIB; /* process information block */
225 tmpCmd : PCHAR;
226 tmpResult : PCHAR;
227
228 BEGIN
229 DosGetInfoBlocks(tmpPtib, tmpPpib);
230 tmpCmd := tmpPpib^.pib_pchcmd;
231 tmpResult := tmpCmd + StrLen(tmpCmd) + 1;
232 nativeOS2GetCmdLineParameter := StrPas(tmpResult);
233 END;
234
235
[25]236FUNCTION splitCmdLineParameter(aCmdLineString : String; var aResult : TStringList) : integer;
[23]237 CONST
238 STATE_BEFORE = 0;
239 STATE_INSIDE = 1;
240 STATE_START_QUOTE = 2;
241 STATE_INSIDE_QUOTED = 3;
242 STATE_INSIDE_QUOTED_START_QUOTE = 4;
243 VAR
244 i : Integer;
245 tmpCurrentChar : char;
246 tmpState : INTEGER;
247 tmpCurrentCommand : String;
248
249 BEGIN
[25]250 result := SUCCESS;
251 aResult.Clear;
252
[28]253 tmpState := STATE_BEFORE;
[23]254 tmpCurrentCommand := '';
255 for i:=1 to length(aCmdLineString) do
256 begin
257 tmpCurrentChar := aCmdLineString[i];
258
259 Case tmpCurrentChar of
260 ' ' :
261 begin
262 Case tmpState of
263 STATE_BEFORE : {do nothing};
264 STATE_INSIDE :
265 begin
[25]266 aResult.add(tmpCurrentCommand);
[23]267 tmpCurrentCommand := '';
268 tmpState := STATE_BEFORE;
269 end;
270 STATE_INSIDE_QUOTED_START_QUOTE :
271 begin
[25]272 aResult.add(tmpCurrentCommand);
[23]273 tmpCurrentCommand := '';
274 tmpState := STATE_BEFORE;
275 end;
276 ELSE
277 begin
278 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
279 end;
280 end;
281 end;
282
283 '"' :
284 begin
285 Case tmpState of
286 STATE_START_QUOTE :
287 begin
[28]288 tmpState := STATE_INSIDE_QUOTED_START_QUOTE;
[23]289 end;
290 STATE_INSIDE_QUOTED :
291 tmpState := STATE_INSIDE_QUOTED_START_QUOTE;
292 STATE_INSIDE_QUOTED_START_QUOTE :
293 begin
294 tmpState := STATE_INSIDE_QUOTED;
295 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
296 end;
297 ELSE
298 tmpState := STATE_START_QUOTE;
299 end;
300 end;
301 ELSE
302 begin
303 Case tmpState of
304 STATE_BEFORE :
305 begin
306 tmpState := STATE_INSIDE;
307 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
308 end;
309 STATE_INSIDE :
310 begin
311 tmpState := STATE_INSIDE;
312 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
313 end;
314 STATE_START_QUOTE :
315 begin
316 tmpState := STATE_INSIDE_QUOTED;
317 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
318 end;
319 STATE_INSIDE_QUOTED :
320 begin
321 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
322 end;
323 STATE_INSIDE_QUOTED_START_QUOTE :
324 begin
325 tmpState := STATE_INSIDE;
326 tmpCurrentCommand := tmpCurrentCommand + tmpCurrentChar;
327 end;
328 end;
329 end;
330 end;
331 end;
332
333 Case tmpState of
334 STATE_BEFORE : { nothing to do};
335 STATE_INSIDE :
336 begin
[25]337 aResult.add(tmpCurrentCommand);
[23]338 end;
[29]339 STATE_START_QUOTE :
340 begin
341 result := ERROR_UNMATCHED_QUOTE;
342 end;
[23]343 STATE_INSIDE_QUOTED_START_QUOTE :
344 begin
[29]345 if (0 < length(tmpCurrentCommand)) then
346 begin
347 aResult.add(tmpCurrentCommand);
348 end;
[23]349 end;
[29]350 STATE_INSIDE_QUOTED :
351 begin
352 result := ERROR_UNMATCHED_QUOTE;
353 if (0 < length(tmpCurrentCommand)) then
354 begin
355 aResult.add(tmpCurrentCommand);
356 end;
357 end;
[23]358 ELSE
359 begin
[25]360 result := ERROR_UNMATCHED_QUOTE;
[29]361 if (0 < length(tmpCurrentCommand)) then
362 begin
363 aResult.add(tmpCurrentCommand);
364 end;
[23]365 end;
366 end;
367 END;
368
369
370FUNCTION MatchValueParam( const aParam: string; const aFlag: string; var aValue: string ): boolean;
371begin
372 Result := false;
373
374 if aParam = '' then
375 exit;
376
377 if ( aParam[ 1 ] <> '/' )
378 and ( aParam[ 1 ] <> '-' ) then
379 exit;
380
381 if CompareText(copy(aParam, 2, length(aFlag)), aFlag) <> 0 then
382 exit;
383
384 Result := true;
385
386 aValue := copy(aParam, 2 + length(aFlag), length(aParam));
387 if aValue <> '' then
388 if aValue[ 1 ] = ':' then
389 delete(aValue, 1, 1 );
390end;
391
392
393FUNCTION MatchFlagParam(const aParam: string; const aFlag: string ): boolean;
394begin
395 Result := false;
396
397 if aParam = '' then
398 exit;
399
400 if (aParam[ 1 ] <> '/' )
401 and (aParam[ 1 ] <> '-' ) then
402 exit;
403 Result := CompareText(copy(aParam, 2, length(aParam)-1), aFlag) = 0;
404end;
405
406
407FUNCTION ExtractPositionElement(Var aParamValue: string; aScreenDimension: longint ): longint;
408var
409 tmpElement: string;
410begin
411 tmpElement := ExtractNextValue(aParamValue, ',' );
412 if tmpElement = '' then
413 raise Exception.Create('Missing position element');
414 if StrEnds('P', tmpElement) then
415 begin
416 Delete(tmpElement, length(tmpElement), 1);
417 if tmpElement = '' then
418 raise Exception.Create('Missing position element');
419 Result := StrToInt(tmpElement);
420 if Result < 0 then
421 Result := 0;
422 if Result > 100 then
423 Result := 100;
424 Result := Round(Result / 100 * aScreenDimension);
425 end
426 else
427 begin
428 Result := StrToInt(tmpElement);
429 end;
430end;
431
432FUNCTION SystemMetrics(aSystemMetric : LONG) : LongInt;
433Begin
434 Result := WinQuerySysValue(HWND_DESKTOP, aSystemMetric);
435end;
436
437FUNCTION ExtractPositionSpec(aParamValue: string; Var aPosition: TWindowPosition ): boolean;
438begin
439 try
440 aPosition.Left := ExtractPositionElement(aParamValue, SystemMetrics(SV_CXSCREEN));
441 aPosition.Bottom := ExtractPositionElement(aParamValue, SystemMetrics(SV_CYSCREEN));
442 aPosition.Width := ExtractPositionElement(aParamValue, SystemMetrics(SV_CXSCREEN));
443 if aPosition.Width < 50 then
444 aPosition.Width := 50;
445 aPosition.Height := ExtractPositionElement(aParamValue, SystemMetrics(SV_CYSCREEN));
446 if aPosition.Height < 50 then
447 aPosition.Height := 50;
448 Result := true;
449 except
450 Result := false;
451 end;
452end;
453
[25]454
[23]455END.
Note: See TracBrowser for help on using the repository browser.