home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / messages.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-24  |  4.7 KB  |  235 lines
  1. {
  2.     $Id: messages.pas,v 1.1.1.1.2.1 1998/08/18 13:56:28 carl Exp $
  3.     Copyright (c) 1998 by Peter Vreman
  4.  
  5.     This unit implements the message object
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23. unit Messages;
  24. interface
  25.  
  26. type
  27.   ppchar=^pchar;
  28.  
  29.   PMessage=^TMessage;
  30.   TMessage=object
  31.     msgfilename : string;
  32.     msgsize,
  33.     msgs        : longint;
  34.     msgtxt      : pchar;
  35.     msgidx      : ppchar;
  36.     constructor Init(p:pointer;n:longint);
  37.     constructor InitExtern(const fn:string;n:longint);
  38.     destructor Done;
  39.     function Get(nr:longint):string;
  40.     function Get3(nr:longint;const s1,s2,s3:string):string;
  41.     function Get2(nr:longint;const s1,s2:string):string;
  42.     function Get1(nr:longint;const s1:string):string;
  43.   end;
  44.  
  45. implementation
  46.  
  47. uses
  48.   strings;
  49.  
  50. constructor TMessage.Init(p:pointer;n:longint);
  51. var
  52.   hp  : pchar;
  53.   hpl : ppchar;
  54. begin
  55.   hp:=pchar(p);
  56.   msgtxt:=hp;
  57.   msgsize:=0;
  58.   msgs:=n;
  59.   getmem(msgidx,msgs shl 2);
  60.   hpl:=msgidx;
  61.   n:=0;
  62.   while (n<msgs) do
  63.    begin
  64.      hpl^:=hp;
  65.      hpl:=pointer(longint(hpl)+4);
  66.      inc(n);
  67.      hp:=pchar(@hp[strlen(hp)+1]);
  68.    end;
  69. end;
  70.  
  71.  
  72. constructor TMessage.InitExtern(const fn:string;n:longint);
  73. var
  74.   f       : file;
  75.   bufread : word;
  76.   i,j     : longint;
  77.   p       : pchar;
  78.   hpl     : ppchar;
  79. begin
  80.   msgs:=0;
  81.   msgsize:=0;
  82.   msgidx:=nil;
  83. {Read the message file}
  84.   msgfilename:=fn;
  85.   assign(f,fn);
  86.   {$I-}
  87.    reset(f,1);
  88.   {$I+}
  89.   if ioresult<>0 then
  90.    begin
  91.      WriteLn('*** message file '+msgfilename+' not found ***');
  92.      exit;
  93.    end;
  94.   msgsize:=filesize(f);
  95.   getmem(msgtxt,msgsize+1);
  96.   blockread(f,msgtxt^,msgsize,bufread);
  97.   msgtxt[msgsize]:=#10;
  98.   close(f);
  99.   inc(msgsize);
  100. {Parse buffer in msgtxt and create indexs}
  101.   msgs:=n;
  102.   getmem(msgidx,msgs shl 2);
  103.   hpl:=msgidx;
  104.   p:=msgtxt;
  105.   i:=0;
  106.   n:=0;
  107.   while (i<bufread) and (n<msgs) do
  108.    begin
  109.      j:=0;
  110.      while (not (p[j] in [#10,#13])) and (j<255) and (i<bufread) do
  111.       begin
  112.         inc(i);
  113.         inc(j);
  114.       end;
  115.      if not (p[0] in [';','#']) then
  116.       begin
  117.         hpl^:=p;
  118.         hpl:=pointer(longint(hpl)+4);
  119.         inc(n);
  120.         if (p[0]='<') and (p[1]='l') and (p[2]='f') and (p[3]='>') then
  121.          p[0]:=#0
  122.         else
  123.          p[j]:=#0;
  124.       end;
  125.      repeat
  126.        inc(i);
  127.        inc(j);
  128.      until (i > bufread) OR not (p[j] in [#10,#13]);
  129.      if i > bufread then
  130.         break;
  131.      p:=pchar(@p[j]);
  132.    end;
  133. end;
  134.  
  135.  
  136.  
  137. destructor TMessage.Done;
  138. begin
  139.   if not (msgidx=nil) then
  140.    freemem(msgidx,msgs shl 2);
  141.   if msgsize>0 then
  142.    freemem(msgtxt,msgsize);
  143. end;
  144.  
  145.  
  146. function TMessage.Get(nr:longint):string;
  147. var
  148.   s : string[16];
  149.   hp : pchar;
  150. begin
  151.   if msgidx=nil then
  152.    hp:=nil
  153.   else
  154.    hp:=pchar(pointer(longint(msgidx)+nr shl 2)^);
  155.   if hp=nil then
  156.    begin
  157.      Str(nr,s);
  158.      Get:='msg nr '+s;
  159.    end
  160.   else
  161.    Get:=StrPas(hp);
  162. end;
  163.  
  164.  
  165. function TMessage.Get3(nr:longint;const s1,s2,s3:string):string;
  166. var
  167.   i : longint;
  168.   s : string;
  169. begin
  170.   s:=Get(nr);
  171. { $1 -> s1 }
  172.   repeat
  173.     i:=pos('$1',s);
  174.     if i>0 then
  175.      begin
  176.        Delete(s,i,2);
  177.        Insert(s1,s,i);
  178.      end;
  179.   until i=0;
  180. { $2 -> s2 }
  181.   repeat
  182.     i:=pos('$2',s);
  183.     if i>0 then
  184.      begin
  185.        Delete(s,i,2);
  186.        Insert(s2,s,i);
  187.      end;
  188.   until i=0;
  189. { $3 -> s3 }
  190.   repeat
  191.     i:=pos('$3',s);
  192.     if i>0 then
  193.      begin
  194.        Delete(s,i,2);
  195.        Insert(s3,s,i);
  196.      end;
  197.   until i=0;
  198.   Get3:=s;
  199. end;
  200.  
  201.  
  202. function TMessage.Get2(nr:longint;const s1,s2:string):string;
  203. begin
  204.   Get2:=Get3(nr,s1,s2,'');
  205. end;
  206.  
  207.  
  208. function TMessage.Get1(nr:longint;const s1:string):string;
  209. begin
  210.   Get1:=Get3(nr,s1,'','');
  211. end;
  212.  
  213.  
  214. end.
  215. {
  216.   $Log: messages.pas,v $
  217.   Revision 1.1.1.1.2.1  1998/08/18 13:56:28  carl
  218.     * bugfix crash with InitExtern
  219.  
  220.   Revision 1.1.1.1  1998/03/25 11:18:13  root
  221.   * Restored version
  222.  
  223.   Revision 1.3  1998/03/10 01:17:20  peter
  224.     * all files have the same header
  225.     * messages are fully implemented, EXTDEBUG uses Comment()
  226.     + AG... files for the Assembler generation
  227.  
  228.   Revision 1.2  1998/03/05 02:44:12  peter
  229.     * options cleanup and use of .msg file
  230.  
  231.   Revision 1.1  1998/03/02 01:55:19  peter
  232.     + Initial implementation
  233.  
  234. }
  235.