home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / dmpprg20.zip / DUMP2MSG.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-20  |  3KB  |  112 lines
  1. program Dump2Msg;
  2. { Message filter for use with DUMPPROG in the Borland Pascal IDE
  3.   (and possibly the BC IDE, but I haven't tried it).  Suggested
  4.   tool menu command line:
  5.  
  6.    $CAP MSG(dump2msg)               necessary to invoke filter
  7.    $SAVE PROMPT                     so that Dumpprog doesn't see stale
  8.                                     source
  9.    $PROMPT                          Optional; lets you fiddle with the
  10.                                     args to Dumpprog
  11.    $EXENAME                         The current program
  12.    $CURTOKEN                        Selects the token the cursor is on
  13.    $EDNAME#$LINE                    Selects the source line the cursor
  14.                                     is on.
  15.  
  16.   These should all be put onto one big line; be sure to compile with the
  17.   Linker Options set for a detailed .MAP file.
  18. }
  19.  
  20.  
  21. {$I-,S-}
  22.  
  23. var
  24.   LineNo, E: Word;
  25.   Line: String;
  26.   InputBuffer: array[0..4095] of Char;
  27.   OutputBuffer: array[0..4095] of Char;
  28.  
  29. procedure WriteHeader;
  30. begin
  31.   Write('BI#PIP#OK'#0);
  32. end;
  33.  
  34. procedure WriteNewFile(const FileName: String);
  35. begin
  36.   Write(#0, FileName, #0);
  37. end;
  38.  
  39. procedure WriteMessage(Line, Col: Word; const Message: String);
  40. begin
  41.   Write(#1, Chr(Lo(Line)), Chr(Hi(Line)), Chr(Lo(Col)), Chr(Hi(Col)),
  42.     Message, #0);
  43. end;
  44.  
  45. procedure WriteEnd;
  46. begin
  47.  
  48.   Write(#127);
  49. end;
  50.  
  51. function TrimLeft(S:String): String;
  52. var
  53.   i: Integer;
  54.   n: String;
  55. begin
  56.   i := 1;
  57.   while (i <= Length(s)) and (s[i] = #32) do Inc(i);
  58.   if i <= Length(s) then
  59.   begin
  60.     Move(s[i], n[1], Length(s) - i + 1);
  61.     n[0] := Char(Length(s) - i + 1);
  62.   end
  63.   else n[0] := #0;
  64.   TrimLeft := n;
  65. end;
  66.  
  67. var
  68.   hashpos,colonpos : word;
  69.   filename,newname : string;
  70. begin
  71.   SetTextBuf(Input, InputBuffer);
  72.   SetTextBuf(Output, OutputBuffer);
  73.   WriteHeader;
  74.   if not Eof then
  75.   begin
  76.     Readln(line);
  77.     WriteMessage(0,0, '  '+TrimLeft(Line)); { Copies banner }
  78.   end;
  79.  
  80.   while (not Eof) and (pos('Selection',line) = 0) do
  81.     ReadLn(line);                           { Skips other header lines }
  82.   if not Eof then
  83.     WriteMessage(0,0, '  '+TrimLeft(Line)); { Writes selection line }
  84.  
  85.   filename := '';
  86.   LineNo   := 0;
  87.  
  88.   while not Eof do
  89.   begin
  90.     ReadLn(Line);
  91.     if Line <> '' then
  92.     begin
  93.       hashpos := pos('#',line);
  94.       colonpos := Pos(':', Line);
  95.       if (hashpos > 0) and (colonpos > hashpos) then
  96.       begin
  97.         newname := Copy(Line, 1, hashpos-1);
  98.         if newname <> filename then
  99.         begin
  100.           filename := newname;
  101.           WriteNewFile(Copy(Line, 1, hashpos-1));
  102.         end;
  103.         Val(Copy(Line,Hashpos+1,colonpos-hashpos-1), LineNo, E);
  104.         if E = 0 then WriteMessage(LineNo, 1, TrimLeft(Copy(Line,colonpos+1,132)));
  105.       end
  106.       else
  107.         WriteMessage(LineNo, 1, '  '+TrimLeft(Line));
  108.     end;
  109.   end;
  110.   WriteEnd;
  111. end.
  112.