msghandler.pp 2.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  1. {
  2. FPCResLipo - Free Pascal External Resource Thinner
  3. Part of the Free Pascal distribution
  4. Copyright (C) 2008 by Giulio Bernardi
  5. Output messages handler
  6. See the file COPYING, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. }
  12. unit msghandler;
  13. {$MODE OBJFPC}
  14. interface
  15. uses
  16. Classes, SysUtils;
  17. type
  18. { TMessages }
  19. TMessages = class
  20. private
  21. fVerboseSet : boolean;
  22. fVerbose : boolean;
  23. fVerbCache : TStringList;
  24. fStdOut : text;
  25. fStdErr : text;
  26. procedure SetVerbose(const aValue : boolean);
  27. protected
  28. public
  29. constructor Create;
  30. destructor Destroy; override;
  31. procedure DoError(const aMsg : string);
  32. procedure DoVerbose(const aMsg : string);
  33. property Verbose : boolean read fVerbose write SetVerbose;
  34. end;
  35. var Messages : TMessages;
  36. implementation
  37. { TMessages }
  38. procedure TMessages.SetVerbose(const aValue: boolean);
  39. var i : integer;
  40. begin
  41. fVerbose:=aValue;
  42. if fVerboseSet then exit;
  43. fVerboseSet:=true;
  44. if fVerbose then //output all verbose messages we didn't output before
  45. for i:=0 to fVerbCache.Count-1 do
  46. writeln(fStdOut,'Debug: '+fVerbCache[i]);
  47. FreeAndNil(fVerbCache);
  48. end;
  49. constructor TMessages.Create;
  50. begin
  51. fVerbose:=false;
  52. fVerboseSet:=false;
  53. fVerbCache:=TStringList.Create;
  54. fStdOut:=stdout;
  55. fStdErr:=stderr;
  56. end;
  57. destructor TMessages.Destroy;
  58. begin
  59. if fVerbCache<>nil then
  60. fVerbCache.Free;
  61. end;
  62. procedure TMessages.DoError(const aMsg: string);
  63. begin
  64. writeln(fStdErr,'Error: '+aMsg);
  65. end;
  66. procedure TMessages.DoVerbose(const aMsg: string);
  67. begin
  68. if not fVerboseSet then
  69. begin
  70. fVerbCache.Add(aMsg);
  71. exit;
  72. end;
  73. if fVerbose then
  74. writeln(fStdOut,'Debug: '+aMsg);
  75. end;
  76. initialization
  77. Messages:=TMessages.Create;
  78. finalization
  79. Messages.Free;
  80. end.