Changeset 76 for trunk/NewView
- Timestamp:
- Feb 12, 2007, 9:35:45 PM (19 years ago)
- Location:
- trunk/NewView
- Files:
-
- 2 edited
-
CmdLineParameterUnit.pas (modified) (9 diffs)
-
DebugUnit.pas (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NewView/CmdLineParameterUnit.pas
r69 r76 21 21 22 22 CONST 23 SUCCESS = 0;24 ERROR_UNMATCHED_QUOTE = -1; 23 ENV_DEBUG = 'NEWVIEW_DEBUG'; 24 25 25 26 26 TYPE EParsingFailed=CLASS(Exception); … … 51 51 searchText : string; 52 52 53 // FUNCTION ReadNextPart(const aParseString : String; const aSetOfDelimiterChars : TSetOfChars): String;54 53 FUNCTION handleSwitchWithValue(const aSwitchString : String; const aSwitch : String; var aValue : String) : Boolean; 55 54 PROCEDURE parseSwitch(aSwitchString : String); … … 88 87 Implementation 89 88 uses 89 DOS, 90 90 ACLFileUtility; 91 91 … … 160 160 result := StrTrimChars(result, ['"']); 161 161 end; 162 163 162 end; 164 163 … … 181 180 tmpSwitch : String; 182 181 begin 183 LogEvent(LogStartup, 'ParseCommandLine: "' + aCmdLineString + '"'); 184 185 // store the original string for debugging 186 commandLine := aCmdLineString; 187 188 // reset the whole object 189 showUsageFlag := false; 190 searchFlag := false; 191 globalSearchFlag := false; 192 language := ''; 193 helpManagerFlag := false; 194 helpManagerWindow := 0; 195 windowPositionFlag := false; 196 ownerWindow := 0; 197 windowTitle := ''; 198 searchText := ''; 199 fileNames := ''; 200 fileNamesRaw := ''; 201 202 try 203 // start parsing 204 tmpState := WHITESPACE; 205 tmpWhitespace := ''; 206 tmpSwitch := ''; 207 tmpQuote := ''; 208 tmpQuoted := false; 209 tmpCurrentParsePosition := 1; 210 while tmpCurrentParsePosition <= length(aCmdLineString) do 211 begin 212 tmpCurrentChar := aCmdLineString[tmpCurrentParsePosition]; 213 214 Case tmpCurrentChar of 215 ' ' : 216 begin 217 Case tmpState of 218 219 WHITESPACE : 220 begin 221 tmpWhitespace := tmpWhitespace + tmpCurrentChar; 222 end; 223 224 QUOTE : 225 begin 226 tmpQuote := tmpQuote + tmpCurrentChar; 227 end; 228 229 SWITCH : 230 begin 231 if tmpQuoted then 232 begin 233 tmpSwitch := tmpSwitch + tmpCurrentChar; 234 end 235 else 236 begin 237 parseSwitch(tmpSwitch); 238 tmpState := WHITESPACE; 239 tmpWhitespace := tmpCurrentChar; 240 end 241 end; 242 243 FILENAME : 244 begin 245 if tmpQuoted then 246 begin 247 fileNames := fileNames + tmpCurrentChar; 248 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 249 end 250 else 251 begin 252 tmpState := WHITESPACE; 253 tmpWhitespace := tmpCurrentChar; 254 end 255 end; 256 257 TEXT : 258 begin 259 if tmpQuoted then 260 begin 261 searchText := searchText + tmpCurrentChar; 262 end 263 else 264 begin 265 tmpState := WHITESPACE; 266 tmpWhitespace := tmpCurrentChar; 267 end 268 end; 269 end; 270 end; 271 272 '/', '-' : 273 begin 274 Case tmpState of 275 WHITESPACE : 276 begin 277 tmpState := SWITCH; 278 tmpSwitch := ''; 279 end; 280 281 QUOTE : 282 begin 283 tmpState := SWITCH; 284 tmpSwitch := ''; 285 end; 286 287 SWITCH : 288 begin 289 parseSwitch(tmpSwitch); 290 tmpSwitch := ''; 291 end; 292 293 FILENAME : 294 begin 295 fileNames := fileNames + tmpCurrentChar; 296 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 297 end; 298 299 TEXT : 300 begin 301 searchText := searchText + tmpCurrentChar; 302 end; 303 end; 304 end; 305 306 '"' : 307 begin 308 if tmpQuoted then 309 begin 310 tmpQuoted := false; 311 Case tmpState of 312 FILENAME : 313 begin 314 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 315 end; 316 end; 317 end 318 else 319 begin 320 Case tmpState of 321 WHITESPACE : 322 begin 323 tmpState := QUOTE; 324 tmpQuote := tmpCurrentChar; 325 end; 326 FILENAME : 327 begin 328 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 329 end; 330 end; 331 tmpQuoted := true; 332 end; 333 end; 334 335 // any other char 336 else 337 begin 338 Case tmpState of 339 340 WHITESPACE : 341 begin 342 if length(fileNames) > 0 then 343 begin 344 tmpState := TEXT; 345 searchText := searchText + tmpWhitespace + tmpCurrentChar; 346 end 347 else 348 begin 349 tmpState := FILENAME; 350 fileNames := fileNames + tmpCurrentChar; 351 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 352 end; 353 end; 354 355 QUOTE : 356 begin 357 if length(fileNames) > 0 then 358 begin 359 tmpState := TEXT; 360 searchText := searchText + tmpWhitespace + tmpCurrentChar; 361 end 362 else 363 begin 364 tmpState := FILENAME; 365 fileNames := fileNames + tmpCurrentChar; 366 fileNamesRaw := fileNamesRaw + tmpQuote + tmpCurrentChar; 367 end; 368 end; 369 370 SWITCH : 371 begin 372 tmpSwitch := tmpSwitch + tmpCurrentChar; 373 end; 374 375 FILENAME : 376 begin 377 fileNames := fileNames + tmpCurrentChar; 378 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 379 end; 380 381 TEXT : 382 begin 383 searchText := searchText + tmpCurrentChar; 384 end; 385 end; 386 end; 182 // first adjust logging 183 if GetEnv(ENV_DEBUG) = '' then 184 begin 185 // TODO set boolean 186 end 187 else 188 begin 189 SetLogAspects(GetEnv(ENV_DEBUG)); 190 end; 191 192 LogEvent(LogStartup, 'ParseCommandLine: "' + aCmdLineString + '"'); 193 194 // store the original string for debugging 195 commandLine := aCmdLineString; 196 197 // reset the whole object 198 showUsageFlag := false; 199 searchFlag := false; 200 globalSearchFlag := false; 201 language := ''; 202 helpManagerFlag := false; 203 helpManagerWindow := 0; 204 windowPositionFlag := false; 205 ownerWindow := 0; 206 windowTitle := ''; 207 searchText := ''; 208 fileNames := ''; 209 fileNamesRaw := ''; 210 211 try 212 // start parsing 213 tmpState := WHITESPACE; 214 tmpWhitespace := ''; 215 tmpSwitch := ''; 216 tmpQuote := ''; 217 tmpQuoted := false; 218 tmpCurrentParsePosition := 1; 219 while tmpCurrentParsePosition <= length(aCmdLineString) do 220 begin 221 tmpCurrentChar := aCmdLineString[tmpCurrentParsePosition]; 222 223 Case tmpCurrentChar of 224 ' ' : 225 begin 226 Case tmpState of 227 228 WHITESPACE : 229 begin 230 tmpWhitespace := tmpWhitespace + tmpCurrentChar; 231 end; 232 233 QUOTE : 234 begin 235 tmpQuote := tmpQuote + tmpCurrentChar; 236 end; 237 238 SWITCH : 239 begin 240 if tmpQuoted then 241 begin 242 tmpSwitch := tmpSwitch + tmpCurrentChar; 243 end 244 else 245 begin 246 parseSwitch(tmpSwitch); 247 tmpState := WHITESPACE; 248 tmpWhitespace := tmpCurrentChar; 249 end 250 end; 251 252 FILENAME : 253 begin 254 if tmpQuoted then 255 begin 256 fileNames := fileNames + tmpCurrentChar; 257 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 258 end 259 else 260 begin 261 tmpState := WHITESPACE; 262 tmpWhitespace := tmpCurrentChar; 263 end 264 end; 265 266 TEXT : 267 begin 268 if tmpQuoted then 269 begin 270 searchText := searchText + tmpCurrentChar; 271 end 272 else 273 begin 274 tmpState := WHITESPACE; 275 tmpWhitespace := tmpCurrentChar; 276 end 277 end; 278 end; 279 end; 280 281 '/', '-' : 282 begin 283 Case tmpState of 284 WHITESPACE : 285 begin 286 tmpState := SWITCH; 287 tmpSwitch := ''; 288 end; 289 290 QUOTE : 291 begin 292 tmpState := SWITCH; 293 tmpSwitch := ''; 294 end; 295 296 SWITCH : 297 begin 298 parseSwitch(tmpSwitch); 299 tmpSwitch := ''; 300 end; 301 302 FILENAME : 303 begin 304 fileNames := fileNames + tmpCurrentChar; 305 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 306 end; 307 308 TEXT : 309 begin 310 searchText := searchText + tmpCurrentChar; 311 end; 312 end; 313 end; 314 315 '"' : 316 begin 317 if tmpQuoted then 318 begin 319 tmpQuoted := false; 320 Case tmpState of 321 FILENAME : 322 begin 323 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 324 end; 325 end; 326 end 327 else 328 begin 329 Case tmpState of 330 WHITESPACE : 331 begin 332 tmpState := QUOTE; 333 tmpQuote := tmpCurrentChar; 334 end; 335 FILENAME : 336 begin 337 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 338 end; 339 end; 340 tmpQuoted := true; 341 end; 342 end; 343 344 // any other char 345 else 346 begin 347 Case tmpState of 348 349 WHITESPACE : 350 begin 351 if length(fileNames) > 0 then 352 begin 353 tmpState := TEXT; 354 searchText := searchText + tmpWhitespace + tmpCurrentChar; 355 end 356 else 357 begin 358 tmpState := FILENAME; 359 fileNames := fileNames + tmpCurrentChar; 360 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 361 end; 362 end; 363 364 QUOTE : 365 begin 366 if length(fileNames) > 0 then 367 begin 368 tmpState := TEXT; 369 searchText := searchText + tmpWhitespace + tmpCurrentChar; 370 end 371 else 372 begin 373 tmpState := FILENAME; 374 fileNames := fileNames + tmpCurrentChar; 375 fileNamesRaw := fileNamesRaw + tmpQuote + tmpCurrentChar; 376 end; 377 end; 378 379 SWITCH : 380 begin 381 tmpSwitch := tmpSwitch + tmpCurrentChar; 382 end; 383 384 FILENAME : 385 begin 386 fileNames := fileNames + tmpCurrentChar; 387 fileNamesRaw := fileNamesRaw + tmpCurrentChar; 388 end; 389 390 TEXT : 391 begin 392 searchText := searchText + tmpCurrentChar; 393 end; 394 end; 395 end; 387 396 end; 388 397 inc(tmpCurrentParsePosition); … … 395 404 parseSwitch(tmpSwitch); 396 405 end; 397 end; 398 399 400 // TODO remove interpreted 401 406 end; 407 // TODO remove interpreted 402 408 except 403 409 on e:EParsingFailed do … … 414 420 LogEvent(LogStartup, ' Search Text: "' + searchText + '"'); 415 421 end; 416 417 418 {419 FUNCTION TCmdLineParameters.ReadNextPart(const aParseString : String; const aSetOfDelimiterChars : TSetOfChars): String;420 VAR421 i : integer;422 tmpChar : char;423 BEGIN424 result := '';425 for i:= currentParsePosition to length(aParseString) do426 begin427 tmpChar := aParseString[i];428 if tmpChar in aSetOfDelimiterChars then429 begin430 i := length(aParseString); // stop parsing431 end432 else433 begin434 result := result + tmpChar;435 end;436 end;437 END;438 }439 422 440 423 … … 517 500 var 518 501 tmpCurrentChar : char; 519 tmpText : String;520 502 tmpValue : String; 521 503 begin … … 578 560 begin 579 561 showUsageFlag := true; 580 581 // check for 'help'582 // tmpText := copy(aCmdLineString, 2, 3);583 // tmpText := lowercase(tmpText);584 585 // if ('elp' = tmpText) then586 // begin587 // end;588 562 end; 589 563 -
trunk/NewView/DebugUnit.pas
r70 r76 2 2 3 3 // NewView - a new OS/2 Help Viewer 4 // Copyright 2006 Ronald Brill (rbri at rbri dot de)4 // Copyright 2006/2007 Ronald Brill (rbri at rbri dot de) 5 5 // This software is released under the GNU Public License - see readme.txt 6 6 … … 8 8 9 9 Interface 10 11 {$define DEBUG}12 10 13 11 … … 18 16 SysUtils; 19 17 20 {$ifdef DEBUG}21 imports22 Function PmPrintfString(aString:PChar):BYTE; APIENTRY; 'PMPRINTF' NAME 'PmPrintfString';23 end;24 {$endif}25 18 26 19 // -- Logging -- … … 54 47 // Procedure PrfTraceEvent(const anEventDescription: String); 55 48 56 const 57 activeLogAspects : LogAspects = [ 58 // LogStartup, 59 // LogShutdown, 60 // LogSettings, 61 // LogParse, 62 // LogDisplay, 63 // LogSearch, 64 LogNHM, 65 // LogViewStub, 66 // LogObjConstDest, 67 LogDebug 68 ]; 49 Procedure SetLogAspects(const aCommaSeparatedListOfAspectNames : String); 50 69 51 70 52 var 71 53 startTime : ULONG; 72 54 lastTime : ULONG; 55 PMPrintfModuleHandle : HMODULE; 56 PMPrintfString : Function(aString : PChar) : ULONG; APIENTRY; 57 activeLogAspects : LogAspects; 58 59 73 60 74 61 Implementation 62 uses 63 BseDos, 64 StringUtilsUnit; 65 66 FUNCTION LoadPMPrinfFLib : integer; 67 Var 68 tmpDllName : CString; 69 tmpErrorInfo : CString; 70 tmpProcedureName : CSTRING; 71 tmpProcedureAddress : POINTER; 72 tmpRC : APIRET; 73 74 begin 75 PMPrintfString := nil; 76 77 tmpDllName:='PMPRINTF'; 78 tmpRC := DosLoadModule(tmpErrorInfo, 255, tmpDllName, PMPrintfModuleHandle); 79 if tmpRC <> 0 then 80 begin 81 PMPrintfModuleHandle := 0; 82 result := 0; 83 exit; 84 end; 85 86 tmpProcedureName := 'PmPrintfString'; 87 tmpRC := DosQueryProcAddr(PMPrintfModuleHandle, 0, tmpProcedureName, tmpProcedureAddress); 88 if tmpRC <> 0 then 89 begin 90 DosFreeModule(PMPrintfModuleHandle); 91 PMPrintfModuleHandle := 0; 92 result := 0; 93 exit; 94 end; 95 96 PMPrintfString := tmpProcedureAddress; 97 result := 0; 98 end; 99 100 101 Procedure PMPrintf(const aString : String); 102 Var 103 tmpPCharMessage : PChar; 104 Begin 105 if (0 <> PMPrintfModuleHandle) then 106 begin 107 tmpPCharMessage := StrAlloc(length(aString) + 1); 108 StrPCopy(tmpPCharMessage, aString); 109 110 PmPrintfString(tmpPCharMessage); 111 112 StrDispose(tmpPCharMessage); 113 end; 114 end; 115 75 116 76 117 Function GetAspectPrefix(const aLogAspect: LogAspect): String; … … 92 133 93 134 135 Procedure SetLogAspects(const aCommaSeparatedListOfAspectNames : String); 136 Var 137 tmpAspects : TStringList; 138 i : Integer; 139 Begin 140 tmpAspects := TStringList.Create; 141 StrExtractStrings(tmpAspects, aCommaSeparatedListOfAspectNames, [','], #0); 142 143 for i:=0 to tmpAspects.count-1 do 144 begin 145 if tmpAspects[i] = 'LogStartup' then activeLogAspects := activeLogAspects + [ LogStartup ]; 146 if tmpAspects[i] = 'LogShutdown' then activeLogAspects := activeLogAspects + [ LogShutdown ]; 147 if tmpAspects[i] = 'LogSettings' then activeLogAspects := activeLogAspects + [ LogSettings ]; 148 if tmpAspects[i] = 'LogParse' then activeLogAspects := activeLogAspects + [ LogParse ]; 149 if tmpAspects[i] = 'LogDisplay' then activeLogAspects := activeLogAspects + [ LogDisplay ]; 150 if tmpAspects[i] = 'LogSearch' then activeLogAspects := activeLogAspects + [ LogSearch ]; 151 if tmpAspects[i] = 'LogNHM' then activeLogAspects := activeLogAspects + [ LogNHM ]; 152 if tmpAspects[i] = 'LogViewStub' then activeLogAspects := activeLogAspects + [ LogViewStub ]; 153 if tmpAspects[i] = 'LogObjConstDest' then activeLogAspects := activeLogAspects + [ LogObjConstDest ]; 154 if tmpAspects[i] = 'LogDebug' then activeLogAspects := activeLogAspects + [ LogDebug ]; 155 end; 156 157 tmpAspects.Destroy; 158 End; 159 160 94 161 Procedure LogEvent(const aLogAspect: LogAspect; const anEventDescription: String); 95 {$ifdef DEBUG}96 162 Var 97 163 tmpMessage : String; 98 tmpPCharMessage : PChar; 99 {$endif} 100 Begin 101 {$ifdef DEBUG} 164 Begin 102 165 if (aLogAspect IN activeLogAspects) then 103 166 begin 104 167 tmpMessage := 'Log[' + GetAspectPrefix(aLogAspect) + '] ' + anEventDescription; 105 106 tmpPCharMessage := StrAlloc(length(tmpMessage) + 1); 107 StrPCopy(tmpPCharMessage, tmpMessage); 108 109 PmPrintfString(tmpPCharMessage); 110 StrDispose(tmpPCharMessage); 111 end; 112 {$endif} 113 end; 114 115 168 PmPrintf(tmpMessage); 169 end; 170 end; 116 171 117 172 … … 124 179 Procedure PrfStartTimer; 125 180 Begin 126 {$ifdef DEBUG}127 181 startTime := GetSystemMSCount; 128 182 lastTime := startTime; 129 {$endif} 130 End; 183 End; 184 131 185 132 186 Procedure PrfStopTimer; … … 136 190 137 191 Procedure PrfTraceEvent(const anEventDescription: String); 138 {$ifdef DEBUG}139 192 Var 140 193 tmpTime : ULONG; 141 194 tmpMessage : String; 142 tmpPCharMessage : PChar; 143 {$endif} 144 Begin 145 {$ifdef DEBUG} 195 Begin 146 196 tmpTime := GetSystemMSCount; 147 197 tmpMessage := 'Prf: ' + IntToStr(tmpTime - lastTime) + 'ms ' + anEventDescription + IntToStr(tmpTime - startTime) + 'ms since start'; 148 198 149 tmpPCharMessage := StrAlloc(length(tmpMessage) + 1); 150 StrPCopy(tmpPCharMessage, tmpMessage); 151 152 PmPrintfString(tmpPCharMessage); 153 StrDispose(tmpPCharMessage); 199 PMPrintf(tmpMessage); 154 200 155 201 lastTime := GetSystemMSCount; 156 {$endif} 157 end; 202 end; 203 204 205 Initialization 206 LoadPMPrinfFLib; 158 207 END.
Note:
See TracChangeset
for help on using the changeset viewer.
