1{ 2 /*************************************************************************** 3 idemacros.pp - macros for tools 4 --------------------------------- 5 6 ***************************************************************************/ 7 8 ***************************************************************************** 9 See the file COPYING.modifiedLGPL.txt, included in this distribution, 10 for details about the license. 11 ***************************************************************************** 12 13 Author: Mattias Gaertner 14 15 Abstract: 16 This unit defines the classes TTransferMacro and TTransferMacroList. These 17 classes store and substitute macros in strings. Transfer macros are an 18 easy way to transfer some ide variables to programs like the compiler, 19 the debugger and all the other tools. 20 Transfer macros have the form $(macro_name). It is also possible to define 21 macro functions, which have the form $macro_func_name(parameter). 22 The default macro functions are: 23 $Ext(filename) - equal to ExtractFileExt 24 $Path(filename) - equal to ExtractFilePath 25 $Name(filename) - equal to ExtractFileName 26 $NameOnly(filename) - equal to ExtractFileName but without extension. 27 $MakeDir(filename) - append path delimiter 28 $MakeFile(filename) - chomp path delimiter 29 $Trim(filename) - equal to TrimFilename 30 31 ToDo: 32 sort items to accelerate find 33 34} 35unit TransferMacros; 36 37{$mode objfpc}{$H+} 38 39interface 40 41uses 42 Classes, SysUtils, 43 // LazUtils 44 LazFileUtils, LazUTF8, 45 // CodeTools 46 FileProcs, CodeToolManager, 47 // BuildIntf 48 MacroIntf, MacroDefIntf, 49 // IDE 50 LazarusIDEStrConsts; 51 52type 53 54 { TTransferMacroList } 55 56 TTransferMacroList = class 57 private 58 fItems: TFPList; // list of TTransferMacro 59 FMarkUnhandledMacros: boolean; 60 FMaxUsePerMacro: integer; 61 fOnSubstitution: TOnSubstitution; 62 fBusy: TStringList; // current working Macros, used for circle detection 63 function GetItems(Index: integer): TTransferMacro; 64 procedure SetItems(Index: integer; NewMacro: TTransferMacro); 65 procedure SetMarkUnhandledMacros(const AValue: boolean); 66 protected 67 function MF_Ext(const Filename:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean):string; virtual; 68 function MF_Path(const Filename:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean):string; virtual; 69 function MF_Name(const Filename:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean):string; virtual; 70 function MF_NameOnly(const Filename:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean):string; virtual; 71 function MF_MakeDir(const Filename:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean):string; virtual; 72 function MF_MakeFile(const Filename:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean):string; virtual; 73 function MF_Trim(const Filename:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean):string; virtual; 74 procedure DoSubstitution(TheMacro: TTransferMacro; const MacroName: string; 75 var s:string; const Data: PtrInt; var Handled, Abort: boolean; 76 Depth: integer); virtual; 77 public 78 constructor Create; 79 destructor Destroy; override; 80 property Items[Index: integer]: TTransferMacro 81 read GetItems write SetItems; default; 82 procedure SetValue(const MacroName, NewValue: string); 83 function Count: integer; 84 procedure Clear; 85 procedure Delete(Index: integer); 86 procedure Add(NewMacro: TTransferMacro); 87 function FindByName(const MacroName: string): TTransferMacro; virtual; 88 function SubstituteStr(var s: string; const Data: PtrInt = 0; 89 Depth: integer = 0): boolean; virtual; 90 procedure ExecuteMacro(const MacroName: string; 91 var MacroParam: string; const Data: PtrInt; out Handled, Abort: boolean; 92 Depth: integer); 93 class function StrHasMacros(const s: string): boolean; 94 property OnSubstitution: TOnSubstitution 95 read fOnSubstitution write fOnSubstitution; 96 // error handling and loop detection 97 property MarkUnhandledMacros: boolean read FMarkUnhandledMacros 98 write SetMarkUnhandledMacros default true; 99 property MaxUsePerMacro: integer read FMaxUsePerMacro write FMaxUsePerMacro default 3; 100 end; 101 102{ TLazIDEMacros } 103 104type 105 TLazIDEMacros = class(TIDEMacros) 106 public 107 function StrHasMacros(const s: string): boolean; override; 108 function SubstituteMacros(var s: string): boolean; override; 109 function IsMacro(const Name: string): boolean; override; 110 procedure Add(NewMacro: TTransferMacro);override; 111 end; 112 113var 114 GlobalMacroList: TTransferMacroList = nil; 115 116//type 117// TCompilerParseStampIncreasedEvent = procedure of object; 118var 119 CompilerParseStamp: integer = 0; // TimeStamp of base value for macros 120 //CompilerParseStampIncreased: TCompilerParseStampIncreasedEvent = nil; 121 BuildMacroChangeStamp: integer = 0; // TimeStamp of base value for build macros 122 123procedure IncreaseCompilerParseStamp; 124// Called when a package dependency changes or when project build macro values change. 125// Automatically calls IncreaseCompilerParseStamp 126procedure IncreaseBuildMacroChangeStamp; 127 128implementation 129 130var 131 IsIdentChar: array[char] of boolean; 132 133procedure IncreaseCompilerParseStamp; 134begin 135 if IDEMacros<>nil then 136 IDEMacros.IncreaseBaseStamp; 137 CTIncreaseChangeStamp(CompilerParseStamp); 138 CodeToolBoss.DefineTree.ClearCache; 139 //if Assigned(CompilerParseStampIncreased) then 140 // CompilerParseStampIncreased(); 141end; 142 143procedure IncreaseBuildMacroChangeStamp; 144begin 145 if IDEMacros<>Nil then 146 IDEMacros.IncreaseGraphStamp; 147 IncreaseCompilerParseStamp; 148 CTIncreaseChangeStamp(BuildMacroChangeStamp); 149end; 150 151{ TTransferMacroList } 152 153constructor TTransferMacroList.Create; 154begin 155 inherited Create; 156 fItems:=TFPList.Create; 157 FMarkUnhandledMacros:=true; 158 FMaxUsePerMacro:=3; 159 Add(TTransferMacro.Create('Ext', '', lisTMFunctionExtractFileExtension, @MF_Ext, [])); 160 Add(TTransferMacro.Create('Path', '', lisTMFunctionExtractFilePath, @MF_Path, [])); 161 Add(TTransferMacro.Create('Name', '', lisTMFunctionExtractFileNameExtension, @MF_Name,[])); 162 Add(TTransferMacro.Create('NameOnly', '', lisTMFunctionExtractFileNameOnly, @MF_NameOnly,[])); 163 Add(TTransferMacro.Create('MakeDir', '', lisTMFunctionAppendPathDelimiter, @MF_MakeDir,[])); 164 Add(TTransferMacro.Create('MakeFile', '', lisTMFunctionChompPathDelimiter, @MF_MakeFile,[])); 165end; 166 167destructor TTransferMacroList.Destroy; 168begin 169 Clear; 170 FreeAndNil(fItems); 171 FreeAndNil(fBusy); 172 inherited Destroy; 173end; 174 175function TTransferMacroList.GetItems(Index: integer): TTransferMacro; 176begin 177 Result:=TTransferMacro(fItems[Index]); 178end; 179 180procedure TTransferMacroList.SetItems(Index: integer; NewMacro: TTransferMacro); 181begin 182 fItems[Index]:=NewMacro; 183end; 184 185procedure TTransferMacroList.SetMarkUnhandledMacros(const AValue: boolean); 186begin 187 if FMarkUnhandledMacros=AValue then exit; 188 FMarkUnhandledMacros:=AValue; 189end; 190 191procedure TTransferMacroList.SetValue(const MacroName, NewValue: string); 192var AMacro:TTransferMacro; 193begin 194 AMacro:=FindByName(MacroName); 195 if AMacro<>nil then AMacro.Value:=NewValue; 196end; 197 198function TTransferMacroList.Count: integer; 199begin 200 Result:=fItems.Count; 201end; 202 203procedure TTransferMacroList.Clear; 204var i:integer; 205begin 206 for i:=0 to fItems.Count-1 do Items[i].Free; 207 fItems.Clear; 208end; 209 210procedure TTransferMacroList.Delete(Index: integer); 211begin 212 Items[Index].Free; 213 fItems.Delete(Index); 214end; 215 216procedure TTransferMacroList.Add(NewMacro: TTransferMacro); 217var 218 l: Integer; 219 r: Integer; 220 m: Integer; 221 cmp: Integer; 222begin 223 l:=0; 224 r:=fItems.Count-1; 225 m:=0; 226 while l<=r do begin 227 m:=(l+r) shr 1; 228 cmp:=UTF8CompareLatinTextFast(NewMacro.Name,Items[m].Name); 229 if cmp<0 then 230 r:=m-1 231 else if cmp>0 then 232 l:=m+1 233 else 234 break; 235 end; 236 if (m<fItems.Count) and (UTF8CompareLatinTextFast(NewMacro.Name,Items[m].Name)>0) then 237 inc(m); 238 fItems.Insert(m,NewMacro); 239 //if NewMacro.MacroFunction<>nil then 240 // debugln('TTransferMacroList.Add A ',NewMacro.Name); 241end; 242 243function TTransferMacroList.SubstituteStr(var s:string; const Data: PtrInt; 244 Depth: integer): boolean; 245 246 function SearchBracketClose(Position: integer): integer; 247 var BracketClose:char; 248 begin 249 if s[Position]='(' then BracketClose:=')' 250 else BracketClose:='}'; 251 inc(Position); 252 while (Position<=length(s)) and (s[Position]<>BracketClose) do begin 253 if (s[Position] in ['(','{']) then 254 Position:=SearchBracketClose(Position); 255 inc(Position); 256 end; 257 Result:=Position; 258 end; 259 260var 261 MacroStart,MacroEnd: integer; 262 MacroName, MacroStr, MacroParam: string; 263 Handled, Abort: boolean; 264 OldMacroLen: Integer; 265 sLen: Integer; 266 InUse: Integer; 267 i: Integer; 268 LoopDepth: Integer; 269 LoopPos: Integer; 270begin 271 if Depth>10 then begin 272 Result:=false; 273 s:='(macro loop detected)'+s; 274 exit; 275 end; 276 Result:=true; 277 sLen:=length(s); 278 MacroStart:=1; 279 LoopDepth:=1; 280 LoopPos:=1; 281 repeat 282 while (MacroStart<sLen) do begin 283 if (s[MacroStart]<>'$') then 284 inc(MacroStart) 285 else if (s[MacroStart+1]='$') then // skip $$ 286 inc(MacroStart,2) 287 else 288 break; 289 end; 290 if MacroStart>=sLen then break; 291 292 MacroEnd:=MacroStart+1; 293 while (MacroEnd<=sLen) and (IsIdentChar[s[MacroEnd]]) do 294 inc(MacroEnd); 295 296 if (MacroEnd<sLen) and (s[MacroEnd] in ['(','{']) then begin 297 MacroName:=copy(s,MacroStart+1,MacroEnd-MacroStart-1); 298 //debugln(['TTransferMacroList.SubstituteStr FUNC ',MacroName]); 299 MacroEnd:=SearchBracketClose(MacroEnd)+1; 300 if MacroEnd>sLen+1 then 301 break; // missing closing bracket 302 OldMacroLen:=MacroEnd-MacroStart; 303 MacroStr:=copy(s,MacroStart,OldMacroLen); 304 // Macro found 305 Handled:=false; 306 Abort:=false; 307 if MacroName='' then begin 308 // Macro variable 309 MacroName:=copy(s,MacroStart+2,OldMacroLen-3); 310 MacroParam:=''; 311 end else begin 312 // Macro function -> substitute macro parameter first 313 //if MacroName='LCLWidgetSet' then DebugLn(['TTransferMacroList.SubstituteStr MacroStr="',MacroStr,'"']); 314 MacroParam:=copy(MacroStr,length(MacroName)+3, 315 length(MacroStr)-length(MacroName)-3); 316 end; 317 //if MacroName='PATH' then 318 // debugln(['TTransferMacroList.SubstituteStr START MacroName=',MacroName,' Param="',MacroParam,'"']); 319 // check for endless loop 320 InUse:=0; 321 if fBusy<>nil then begin 322 for i:=0 to fBusy.Count-1 do begin 323 if SysUtils.CompareText(fBusy[i],MacroName)=0 then begin 324 inc(InUse); 325 if InUse>MaxUsePerMacro then begin 326 // cycle detected 327 Handled:=true; 328 MacroStr:='<MACRO-CYCLE:'+MacroName+'>'; 329 end; 330 end; 331 end; 332 end; 333 if not Handled then begin 334 if fBusy=nil then fBusy:=TStringList.Create; 335 try 336 fBusy.Add(MacroName); 337 if MacroParam<>'' then begin 338 // substitute param 339 if not SubstituteStr(MacroParam,Data,Depth+1) then begin 340 Result:=false; 341 exit; 342 end; 343 end; 344 // find macro and get value 345 ExecuteMacro(MacroName,MacroParam,Data,Handled,Abort,Depth+1); 346 if Abort then begin 347 Result:=false; 348 exit; 349 end; 350 finally 351 fBusy.Delete(fBusy.Count-1); 352 end; 353 MacroStr:=MacroParam; 354 end; 355 // mark unhandled macros 356 if not Handled and MarkUnhandledMacros then begin 357 MacroStr:=Format(lisTMunknownMacro, [MacroStr]); 358 Handled:=true; 359 end; 360 // replace macro with new value 361 if Handled then begin 362 if MacroStart>LoopPos then 363 LoopDepth:=1 364 else begin 365 inc(LoopDepth); 366 //DebugLn(['TTransferMacroList.SubstituteStr double macro: ',s,' Depth=',LoopDepth,' Pos=',LoopPos]); 367 end; 368 LoopPos:=MacroStart; 369 s:=copy(s,1,MacroStart-1)+MacroStr+copy(s,MacroEnd,length(s)); 370 sLen:=length(s); 371 // continue at replacement, because a macrovalue can contain macros 372 MacroEnd:=MacroStart; 373 end; 374 end; 375 MacroStart:=MacroEnd; 376 until false; 377 378 // convert $$ chars 379 MacroStart:=2; 380 while (MacroStart<sLen) do begin 381 if (s[MacroStart]='$') and (s[MacroStart+1]='$') then begin 382 System.Delete(s,MacroStart,1); 383 dec(sLen); 384 end; 385 inc(MacroStart); 386 end; 387end; 388 389procedure TTransferMacroList.ExecuteMacro(const MacroName: string; 390 var MacroParam: string; const Data: PtrInt; out Handled, Abort: boolean; 391 Depth: integer); 392var 393 Macro: TTransferMacro; 394begin 395 Handled:=false; 396 Abort:=false; 397 Macro:=FindByName(MacroName); 398 DoSubstitution(Macro,MacroName,MacroParam,Data,Handled,Abort,Depth); 399 if Abort or Handled then exit; 400 if Macro=nil then exit; 401 if Assigned(Macro.MacroFunction) then begin 402 MacroParam:=Macro.MacroFunction(MacroParam,Data,Abort); 403 if Abort then exit; 404 end else begin 405 MacroParam:=Macro.Value; 406 end; 407 Handled:=true; 408end; 409 410class function TTransferMacroList.StrHasMacros(const s: string): boolean; 411// search for $( or $xxx( 412var 413 p: Integer; 414 Len: Integer; 415begin 416 Result:=false; 417 p:=1; 418 Len:=length(s); 419 while (p<Len) do begin 420 if s[p]='$' then begin 421 inc(p); 422 if (p<Len) and (s[p]<>'$') then begin 423 // skip macro function name 424 while (p<Len) and (s[p]<>'(') do inc(p); 425 if (p<Len) then begin 426 Result:=true; 427 exit; 428 end; 429 end else begin 430 // $$ is not a macro 431 inc(p); 432 end; 433 end else 434 inc(p); 435 end; 436end; 437 438function TTransferMacroList.FindByName(const MacroName: string): TTransferMacro; 439var 440 l: Integer; 441 r: Integer; 442 m: Integer; 443 cmp: Integer; 444begin 445 l:=0; 446 r:=fItems.Count-1; 447 m:=0; 448 while l<=r do begin 449 m:=(l+r) shr 1; 450 Result:=Items[m]; 451 cmp:=UTF8CompareLatinTextFast(MacroName,Result.Name); 452 if cmp<0 then 453 r:=m-1 454 else if cmp>0 then 455 l:=m+1 456 else begin 457 exit; 458 end; 459 end; 460 Result:=nil; 461end; 462 463function TTransferMacroList.MF_Ext(const Filename:string; 464 const Data: PtrInt; var Abort: boolean):string; 465begin 466 Result:=ExtractFileExt(Filename); 467end; 468 469function TTransferMacroList.MF_Path(const Filename:string; 470 const Data: PtrInt; var Abort: boolean):string; 471begin 472 Result:=TrimFilename(ExtractFilePath(Filename)); 473 //debugln(['TTransferMacroList.MF_Path ',Filename,' Result=',Result]); 474end; 475 476function TTransferMacroList.MF_Name(const Filename:string; 477 const Data: PtrInt; var Abort: boolean):string; 478begin 479 Result:=ExtractFilename(Filename); 480end; 481 482function TTransferMacroList.MF_NameOnly(const Filename:string; 483 const Data: PtrInt; var Abort: boolean):string; 484begin 485 Result:=ChangeFileExt(ExtractFileName(Filename),''); 486end; 487 488function TTransferMacroList.MF_MakeDir(const Filename: string; 489 const Data: PtrInt; var Abort: boolean): string; 490begin 491 Result:=Filename; 492 if (Result<>'') and (Result[length(Result)]<>PathDelim) then 493 Result:=Result+PathDelim; 494 Result:=TrimFilename(Result); 495end; 496 497function TTransferMacroList.MF_MakeFile(const Filename: string; 498 const Data: PtrInt; var Abort: boolean): string; 499var 500 ChompLen: integer; 501begin 502 Result:=Filename; 503 ChompLen:=0; 504 while (length(Filename)>ChompLen) 505 and (Filename[length(Filename)-ChompLen]=PathDelim) do 506 inc(ChompLen); 507 if ChompLen>0 then 508 Result:=LeftStr(Result,length(Filename)-ChompLen); 509 Result:=TrimFilename(Result); 510end; 511 512function TTransferMacroList.MF_Trim(const Filename: string; const Data: PtrInt; 513 var Abort: boolean): string; 514begin 515 Result:=TrimFilename(Filename); 516end; 517 518procedure TTransferMacroList.DoSubstitution(TheMacro: TTransferMacro; 519 const MacroName: string; var s: string; const Data: PtrInt; var Handled, 520 Abort: boolean; Depth: integer); 521begin 522 if Assigned(OnSubstitution) then 523 OnSubstitution(TheMacro,MacroName,s,Data,Handled,Abort,Depth); 524end; 525 526{ TLazIDEMacros } 527 528function TLazIDEMacros.StrHasMacros(const s: string): boolean; 529begin 530 Result:=GlobalMacroList.StrHasMacros(s); 531end; 532 533function TLazIDEMacros.SubstituteMacros(var s: string): boolean; 534begin 535 Result:=GlobalMacroList.SubstituteStr(s); 536end; 537 538function TLazIDEMacros.IsMacro(const Name: string): boolean; 539begin 540 Result:=GlobalMacroList.FindByName(Name)<>nil; 541end; 542 543procedure TLazIDEMacros.Add(NewMacro: TTransferMacro); 544Begin 545 GlobalMacroList.Add(NewMacro); 546end; 547 548procedure InternalInit; 549var 550 c: char; 551begin 552 for c:=Low(char) to High(char) do begin 553 IsIdentChar[c]:=c in ['a'..'z','A'..'Z','0'..'9','_']; 554 end; 555end; 556 557initialization 558 InternalInit; 559 560end. 561