mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 07:29:25 +02:00
+ Initial implementation
This commit is contained in:
michael
parent
3897bcb765
commit
c50cbc4c18
1430
utils/fpmc/Makefile
Normal file
1430
utils/fpmc/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
28
utils/fpmc/Makefile.fpc
Normal file
28
utils/fpmc/Makefile.fpc
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
#
|
||||||
|
# Makefile.fpc for debugserver
|
||||||
|
#
|
||||||
|
|
||||||
|
[target]
|
||||||
|
programs=fpmc
|
||||||
|
programs_linux=fpmcgtk
|
||||||
|
programs_win32=fpmcgtk
|
||||||
|
rsts=frmabout frmmain frmoptions msgcomp
|
||||||
|
|
||||||
|
[clean]
|
||||||
|
units=frmmain msgcomp frmabout frmoptions
|
||||||
|
|
||||||
|
[require]
|
||||||
|
packages=fcl
|
||||||
|
|
||||||
|
[compiler]
|
||||||
|
|
||||||
|
[install]
|
||||||
|
fpcpackage=y
|
||||||
|
|
||||||
|
[default]
|
||||||
|
fpcdir=../..
|
||||||
|
|
||||||
|
[rules]
|
||||||
|
fpmc$(EXEEXT): msgcomp.pp fpmc.pp
|
||||||
|
|
||||||
|
fpmcgtk$(EXEEXT): msgcomp.pp fpmcgtk.pp $(wildcard frm*.pp)
|
||||||
24
utils/fpmc/README
Normal file
24
utils/fpmc/README
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
This is the Free Pascal Message Compiler.
|
||||||
|
|
||||||
|
It compiles a .mc file into a .rc and .msg file which can be compiled by a
|
||||||
|
resource compiler such as windres. For example:
|
||||||
|
|
||||||
|
fpmc -l 90 -e -v -i test.mc -p -r -m
|
||||||
|
windres -i test.rc -o test.res
|
||||||
|
|
||||||
|
It also produces a .pp pascal unit which contains constant definitions
|
||||||
|
for any message aliases (SymbolicName) found in the .mc file.
|
||||||
|
|
||||||
|
The compiler recognizes the following directives in the .mc file:
|
||||||
|
MessageID
|
||||||
|
SymbolicName
|
||||||
|
Language
|
||||||
|
|
||||||
|
Other directives as defined by Microsoft are not yet supported.
|
||||||
|
|
||||||
|
The readmsg program reads and dumps a .msg message file to screen.
|
||||||
|
dumpfile produces a hex dump of a file. They were mainly used for debugging.
|
||||||
|
|
||||||
|
Enjoy !
|
||||||
|
|
||||||
|
Michael.
|
||||||
27
utils/fpmc/dumpfile.pp
Normal file
27
utils/fpmc/dumpfile.pp
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
program dumpfile;
|
||||||
|
|
||||||
|
Var
|
||||||
|
F : File of Byte;
|
||||||
|
Col : Integer;
|
||||||
|
B : Byte;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Assign(F,Paramstr(1));
|
||||||
|
Reset(F);
|
||||||
|
Col:=1;
|
||||||
|
while not eof(f) do
|
||||||
|
begin
|
||||||
|
Read(F,B);
|
||||||
|
write(HexStr(B,2),' ');
|
||||||
|
Col:=Col+3;
|
||||||
|
If Col>72 then
|
||||||
|
begin
|
||||||
|
Writeln;
|
||||||
|
Col:=1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Close(f);
|
||||||
|
If Col<>1 then
|
||||||
|
Writeln;
|
||||||
|
end.
|
||||||
|
|
||||||
199
utils/fpmc/fpmc.pp
Normal file
199
utils/fpmc/fpmc.pp
Normal file
@ -0,0 +1,199 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 2003 by the Free Pascal development team
|
||||||
|
|
||||||
|
Free Pascal Message Compiler (command-line version)
|
||||||
|
|
||||||
|
See the file COPYING.FPC, included in this distribution,
|
||||||
|
for details about the copyright.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
{$mode objfpc}
|
||||||
|
{$h+}
|
||||||
|
program fpmc;
|
||||||
|
|
||||||
|
uses msgcomp,getopts,sysutils,classes;
|
||||||
|
|
||||||
|
|
||||||
|
Type
|
||||||
|
TFPMC = Class (TObject)
|
||||||
|
CmdUnitName,
|
||||||
|
InputFileName,
|
||||||
|
MsgFileName,
|
||||||
|
PascalFileName,
|
||||||
|
RCFileName : String;
|
||||||
|
LanguageID,
|
||||||
|
SubLanguageID : Integer;
|
||||||
|
CmdVerbose,
|
||||||
|
CmdUseEscape : Boolean;
|
||||||
|
Procedure DoError(Sender : TObject; Msg : String);
|
||||||
|
Procedure DoVerbose(Sender : TObject; Msg : String);
|
||||||
|
Procedure Usage(WithError : Boolean);
|
||||||
|
Procedure HandleOptions;
|
||||||
|
Procedure CompileFile;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TFPMC.DoError(Sender : TObject; Msg : String);
|
||||||
|
|
||||||
|
begin
|
||||||
|
Writeln(StdErr,Msg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TFPMC.DoVerbose(Sender : TObject; Msg : String);
|
||||||
|
|
||||||
|
begin
|
||||||
|
Writeln(Msg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TFPMC.Usage(WithError : Boolean);
|
||||||
|
|
||||||
|
begin
|
||||||
|
Writeln('Usage : ',ExtractFileName(Paramstr(0)),' <option>');
|
||||||
|
Writeln('Where options is one or more of :');
|
||||||
|
Writeln(' -a Produce all files (-m -p -r)');
|
||||||
|
Writeln(' -e Do not escape backslashes in filenames');
|
||||||
|
Writeln(' -h Usage screen');
|
||||||
|
Writeln(' -i filename Input filename');
|
||||||
|
Writeln(' -l ID Set locale (language ID)');
|
||||||
|
Writeln(' -m [msgfile] Create message file.');
|
||||||
|
Writeln(' -p [pasfile] Create pascal unit from message aliases.');
|
||||||
|
Writeln(' -r [rcfile] Create .RC file for use with message file');
|
||||||
|
Writeln(' -s ID Set sublocale (sublanguage)');
|
||||||
|
Writeln(' -u name Set unitname');
|
||||||
|
Writeln(' -v Be verbose');
|
||||||
|
Writeln('Names of output files are deduced from input filename if needed.');
|
||||||
|
Halt(Ord(WithError));
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TFPMC.Handleoptions;
|
||||||
|
|
||||||
|
Var
|
||||||
|
C : Char;
|
||||||
|
NeedPasFileName,
|
||||||
|
NeedMsgFileName,
|
||||||
|
NeedRCFileName : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
NeedPasFileName:=False;
|
||||||
|
NeedMsgFileName:=False;
|
||||||
|
NeedRCFileName :=False;
|
||||||
|
CmdUnitName:='';
|
||||||
|
LanguageID:=-1;
|
||||||
|
SubLanguageID:=-1;
|
||||||
|
CmdUseEscape:=True;
|
||||||
|
repeat
|
||||||
|
C:=GetOpt('vahei:m::l:s:u:r::p::');
|
||||||
|
Case C of
|
||||||
|
'a' : begin
|
||||||
|
NeedMsgFilename:=(MsgFileName='');
|
||||||
|
NeedPasFilename:=(PascalFileName='');
|
||||||
|
NeedRCFilename:=(RCFileName='');
|
||||||
|
end;
|
||||||
|
'e' : CmdUseEscape:=False;
|
||||||
|
'h','?' : Usage(false);
|
||||||
|
'i' : InputFileName:=OptArg;
|
||||||
|
'm' : begin
|
||||||
|
MsgFileName:=OptArg;
|
||||||
|
NeedMsgFilename:=(MsgFileName='');
|
||||||
|
end;
|
||||||
|
'l' : LanguageID:=StrToIntDef(OptArg,-1);
|
||||||
|
'p' : begin
|
||||||
|
PascalFileName:=OptArg;
|
||||||
|
NeedPasFilename:=(PascalFileName='');
|
||||||
|
end;
|
||||||
|
's' : SubLanguageID:=StrToIntDef(OptArg,-1);
|
||||||
|
'u' : CmdUnitName:=OptArg;
|
||||||
|
'r' : begin
|
||||||
|
RCFileName:=OptArg;
|
||||||
|
NeedRCFilename:=(RCFileName='');
|
||||||
|
end;
|
||||||
|
'v' : CmdVerbose:=True;
|
||||||
|
end;
|
||||||
|
Until (C=EndOfOptions);
|
||||||
|
If (InputFileName='') Then
|
||||||
|
Usage(true);
|
||||||
|
If NeedMsgFileName then
|
||||||
|
MsgFileName:=ChangeFileExt(InputFilename,'.msg');
|
||||||
|
If NeedPasFileName then
|
||||||
|
PascalFileName:=ChangeFileExt(InputFilename,'.pp');
|
||||||
|
If NeedRCFileName then
|
||||||
|
RCFileName:=ChangeFileExt(InputFilename,'.rc');
|
||||||
|
If (PascalFileName<>'') and (CmdUnitName='') then
|
||||||
|
CmdUnitName:=ChangeFileExt(ExtractFileName(PascalFileName),'');
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TFPMC.CompileFile;
|
||||||
|
|
||||||
|
Var
|
||||||
|
M,P,R,I : TStream;
|
||||||
|
|
||||||
|
Procedure SetupStreams;
|
||||||
|
|
||||||
|
begin
|
||||||
|
I:=TFileStream.Create(InputFileName,fmOpenRead);
|
||||||
|
If (PascalFileName<>'') then
|
||||||
|
P:=TFileStream.Create(PascalFileName,fmCreate);
|
||||||
|
If (MsgFileName<>'') then
|
||||||
|
M:=TFileStream.Create(MsgFileName,fmCreate);
|
||||||
|
If (RCFileName<>'') then
|
||||||
|
R:=TFileStream.Create(RCFileName,fmCreate);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure CloseStreams;
|
||||||
|
|
||||||
|
begin
|
||||||
|
M.Free;
|
||||||
|
P.Free;
|
||||||
|
R.Free;
|
||||||
|
I.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
SetupStreams;
|
||||||
|
Try
|
||||||
|
With TMessageCompiler.Create do
|
||||||
|
Try
|
||||||
|
Msg:=M;
|
||||||
|
MC:=I;
|
||||||
|
RC:=R;
|
||||||
|
Pas:=P;
|
||||||
|
OnError:=@DoError;
|
||||||
|
If CmdVerbose then
|
||||||
|
OnVerbose:=@DoVerbose;
|
||||||
|
UnitName:=CmdUnitName;
|
||||||
|
MessageFileName:=MsgFileName;
|
||||||
|
EscapeNeeded:=CmdUseEscape;
|
||||||
|
If (LanguageID<>-1) then
|
||||||
|
LocaleID:=LanguageID;
|
||||||
|
If (SubLanguageID<>-1) then
|
||||||
|
SubLocaleID:=SubLanguageID;
|
||||||
|
Compile;
|
||||||
|
Finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
Finally
|
||||||
|
CloseStreams;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
With TFPMC.Create do
|
||||||
|
Try
|
||||||
|
HandleOptions;
|
||||||
|
CompileFile;
|
||||||
|
Finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
end.
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2003-02-14 21:59:21 michael
|
||||||
|
+ Initial implementation
|
||||||
|
|
||||||
|
}
|
||||||
13
utils/fpmc/fpmcgtk.pp
Normal file
13
utils/fpmc/fpmcgtk.pp
Normal file
@ -0,0 +1,13 @@
|
|||||||
|
{$mode objfpc}
|
||||||
|
{$H+}
|
||||||
|
{$apptype gui}
|
||||||
|
program fpmcgtk;
|
||||||
|
|
||||||
|
uses fpgtk,fpglib,fpgtkext,frmmain;
|
||||||
|
|
||||||
|
begin
|
||||||
|
application := TFPgtkApplication.Create;
|
||||||
|
application.MainWindow := TMainForm.Create;
|
||||||
|
application.Run;
|
||||||
|
application.Free;
|
||||||
|
end.
|
||||||
92
utils/fpmc/frmabout.pp
Normal file
92
utils/fpmc/frmabout.pp
Normal file
@ -0,0 +1,92 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 2003 by the Free Pascal development team
|
||||||
|
|
||||||
|
About form for debug server
|
||||||
|
|
||||||
|
See the file COPYING.FPC, included in this distribution,
|
||||||
|
for details about the copyright.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
{$mode objfpc}
|
||||||
|
{$h+}
|
||||||
|
|
||||||
|
unit frmabout;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses fpgtk,gtk,classes,sysutils;
|
||||||
|
|
||||||
|
Type
|
||||||
|
TAboutForm = Class (TFPGtkWindow)
|
||||||
|
FAboutText : TFPGtkLabel;
|
||||||
|
FSeparator : TFPGtkHSeparator;
|
||||||
|
FVBox : TFPgtkVBox;
|
||||||
|
FOK,
|
||||||
|
FCancel : TFPGtkButton;
|
||||||
|
FButtonBox: TFPgtkHBox;
|
||||||
|
Constructor Create;
|
||||||
|
Procedure CreateWindow;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Implementation
|
||||||
|
|
||||||
|
Resourcestring
|
||||||
|
SAbout1 = 'Free Pascal message compiler - GTK version.';
|
||||||
|
SAbout2 = '(c) 2003, Michael Van Canneyt';
|
||||||
|
SOK = 'OK';
|
||||||
|
SCancel = 'Cancel';
|
||||||
|
|
||||||
|
Constructor TAboutForm.Create;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Inherited Create(GTK_WINDOW_DIALOG);
|
||||||
|
CreateWindow;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TAboutForm.CreateWindow;
|
||||||
|
|
||||||
|
Var
|
||||||
|
S : String;
|
||||||
|
|
||||||
|
|
||||||
|
begin
|
||||||
|
FVBox:=TFPGtkVBox.Create;
|
||||||
|
FVBox.Spacing:=4;
|
||||||
|
FVBox.Border:=8;
|
||||||
|
Add(FVBox);
|
||||||
|
// About text
|
||||||
|
S:=SAbout1+LineEnding+SAbout2;
|
||||||
|
FAboutText:=TFPgtkLabel.Create(S);
|
||||||
|
// button area
|
||||||
|
FOK:=TFpGtkButton.CreateWithLabel(SOK);
|
||||||
|
FOK.ConnectClicked(@CloseWithResult,IntToPointer(drOK));
|
||||||
|
FCancel:=TFPgtkButton.CreateWithLabel(SCancel);
|
||||||
|
FCancel.ConnectCLicked(@CloseWithResult,IntToPointer(drCancel));
|
||||||
|
FSeparator:=TFPgtkHSeparator.Create;
|
||||||
|
FButtonBox:=TfpGtkHBox.Create;
|
||||||
|
FButtonBox.Spacing:=4;
|
||||||
|
FButtonBox.PackEnd(FOK,false,false,4);
|
||||||
|
FButtonBox.PackEnd(FCancel,false,false,4);
|
||||||
|
// Add to window
|
||||||
|
FVBox.PackStart(FAboutText,True,True,0);
|
||||||
|
FVBox.PackStart(FSeparator,False,False,4);
|
||||||
|
FVBox.PackStart(FButtonBox,false,false,0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2003-02-14 21:59:21 michael
|
||||||
|
+ Initial implementation
|
||||||
|
|
||||||
|
Revision 1.1 2003/01/02 14:36:25 michael
|
||||||
|
+ Initial implementation
|
||||||
|
|
||||||
|
}
|
||||||
523
utils/fpmc/frmmain.pp
Normal file
523
utils/fpmc/frmmain.pp
Normal file
@ -0,0 +1,523 @@
|
|||||||
|
{$mode objfpc}
|
||||||
|
{$h+}
|
||||||
|
unit frmmain;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses gdk,gtk,fpgtk,fpgtkext,classes,sysutils;
|
||||||
|
|
||||||
|
Type
|
||||||
|
TMainForm = Class(TFPGtkWindow)
|
||||||
|
FModified : Boolean;
|
||||||
|
FFileName : String;
|
||||||
|
FUnitName : String;
|
||||||
|
FLanguageID : Integer;
|
||||||
|
FSubLanguageID : Integer;
|
||||||
|
FVerbose,
|
||||||
|
FCreateMsg,
|
||||||
|
FCreatePas,
|
||||||
|
FCreateRC,
|
||||||
|
FEscapePath : Boolean;
|
||||||
|
FMsgLabel : TFPgtkLabel;
|
||||||
|
FMsgList : TFPgtkScrollList;
|
||||||
|
FMsgVBox,
|
||||||
|
FVBox : TFPGtkVBox;
|
||||||
|
FVPaned : TFPgtkVPaned;
|
||||||
|
FFile,
|
||||||
|
FFileNew,
|
||||||
|
FFileOpen,
|
||||||
|
FFileSave,
|
||||||
|
FFileSaveAs,
|
||||||
|
FFileExit,
|
||||||
|
FEdit,
|
||||||
|
FEditCut,
|
||||||
|
FEditCopy,
|
||||||
|
FEditPaste,
|
||||||
|
FProject,
|
||||||
|
FProjectCompile,
|
||||||
|
FProjectOptions,
|
||||||
|
FHelp,
|
||||||
|
FHelpAbout : TFPGtkMenuItem;
|
||||||
|
FMainMenu : TFPGtkMenuBar;
|
||||||
|
FEditor : TFPGtkScrollText;
|
||||||
|
Procedure CreateWindow;
|
||||||
|
Function CheckSaved : Boolean;
|
||||||
|
Procedure SetCaption;
|
||||||
|
Function GetFileName(ATitle : String) : String;
|
||||||
|
// Callback functions.
|
||||||
|
Procedure DialogSetFilename(Sender : TFPGtkWindow;Data : Pointer; Action : Integer;Initiator : TFPGtkObject);
|
||||||
|
Procedure SaveOptions(Sender : TFPGtkWindow;Data : Pointer; Action : Integer;Initiator : TFPGtkObject);
|
||||||
|
Function OnDeleteEvent(Sender:TFPgtkWidget; Event:PGdkEvent; data:pointer): boolean;
|
||||||
|
Procedure FileNewClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
Procedure FileSaveClick(Sender : TFPgtkObject; Data : Pointer);
|
||||||
|
Procedure FileSaveAsClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
Procedure FileOpenClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
Procedure FileExitClick(Sender : TFPgtkObject ; Data : Pointer);
|
||||||
|
Procedure EditCCPClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
Procedure ProjectCompileClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
Procedure ProjectOptionsClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
Procedure HelpAboutClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
Procedure EditorChanged(Sender : TFPgtkObject; Data : Pointer);
|
||||||
|
Procedure DoError(Sender : TObject; Msg : String);
|
||||||
|
Procedure DoVerbose(Sender : TObject; Msg : String);
|
||||||
|
Public
|
||||||
|
Constructor Create;
|
||||||
|
Procedure Compile;
|
||||||
|
Procedure SetOptions;
|
||||||
|
Procedure LoadFromFile(FN : String);
|
||||||
|
Procedure SaveToFile(FN : String);
|
||||||
|
Procedure NewFile;
|
||||||
|
Procedure EditCut;
|
||||||
|
Procedure EditCopy;
|
||||||
|
Procedure EditPaste;
|
||||||
|
Property Modified : Boolean Read FModified;
|
||||||
|
Property FileName : String Read FFileName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Implementation
|
||||||
|
|
||||||
|
uses frmabout,frmoptions,msgcomp;
|
||||||
|
|
||||||
|
ResourceString
|
||||||
|
SMenuFile = '_File';
|
||||||
|
SMenuFileNew = '_New';
|
||||||
|
SMenuFileOpen = '_Open';
|
||||||
|
SMenuFileSave = '_Save';
|
||||||
|
SMenuFileSaveAs = 'Save _as';
|
||||||
|
SMenuFileExit = 'E_xit';
|
||||||
|
SMenuEdit = '_Edit';
|
||||||
|
SMenuEditCut = 'C_ut';
|
||||||
|
SMenuEditCopy = '_Copy';
|
||||||
|
SMenuEditPaste = '_Paste';
|
||||||
|
SMenuProject = '_Project';
|
||||||
|
SMenuProjectCompile = '_Compile';
|
||||||
|
SMenuProjectoptions = '_Options';
|
||||||
|
SMenuHelp = '_Help';
|
||||||
|
SMenuHelpAbout = '_About';
|
||||||
|
|
||||||
|
SCaption = 'Free Pascal message compiler';
|
||||||
|
SFileModified = 'File has changed. Save changes ?';
|
||||||
|
SSaveFile = 'Save file as';
|
||||||
|
SOpenFile = 'Select file to open';
|
||||||
|
SModified = '(modified)';
|
||||||
|
SCompilerMessages = 'Compile messages';
|
||||||
|
SErrsCompiling = 'Encountered %d errors while compiling.';
|
||||||
|
SSuccesCompiling = 'Succesfully compiled messages.';
|
||||||
|
SErrUnexpected = 'The following unexpected error occurred when compiling:%s';
|
||||||
|
|
||||||
|
{ ---------------------------------------------------------------------
|
||||||
|
Form Creation
|
||||||
|
---------------------------------------------------------------------}
|
||||||
|
|
||||||
|
Constructor TMainForm.Create;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Inherited create (gtk_window_dialog);
|
||||||
|
FCreateMsg:=True;
|
||||||
|
FCreatePas:=True;
|
||||||
|
FCreateRC:=True;
|
||||||
|
FEscapePath:=True;
|
||||||
|
FVerbose:=True;
|
||||||
|
Createwindow;
|
||||||
|
If ParamCount>0 then
|
||||||
|
LoadFromFile(Paramstr(1));
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMainForm.CreateWindow;
|
||||||
|
|
||||||
|
Var
|
||||||
|
FAccelGroup : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FVBox:=TFPgtkVBox.Create;
|
||||||
|
FAccelGroup:=AccelGroupNew;
|
||||||
|
FFileNew:=NewMenuItem(SMenuFileNew,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_N,[amcontrol]),@FileNewClick,Nil);
|
||||||
|
FFileOpen:=NewMenuItem(SMenuFileOpen,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_O,[amcontrol]),@FileOpenClick,Nil);
|
||||||
|
FFileSave:=NewMenuItem(SMenuFileSave,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_S,[amcontrol]),@FileSaveClick,Nil);
|
||||||
|
FFileSaveAs:=NewMenuItem(SMenuFileSaveAs,'','', @FileSaveAsClick,Nil);
|
||||||
|
FFileExit:=NewMenuItem(SMenuFileExit,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_Q,[amcontrol]),@FileExitClick,Nil);
|
||||||
|
FFile:=NewSubMenu(SmenuFile,'','',[FFileNew,FFileOpen,FFileSave,FFileSaveAs,NewLine,FFileExit]);
|
||||||
|
FEditCut:=NewMenuItem(SMenuEditCut,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_X,[amcontrol]),@EditCCPClick,Nil);
|
||||||
|
FEditCopy:=NewMenuItem(SMenuEditCopy,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_C,[amcontrol]),@EditCCPClick,Nil);
|
||||||
|
FEditPaste:=NewMenuItem(SMenuEditPaste,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_V,[amcontrol]),@EditCCPClick,Nil);
|
||||||
|
FEdit:=NewSubMenu(SMenuEdit,'','',[FEditCut,FEditCopy,FEditPaste]);
|
||||||
|
FProjectCompile:=NewMenuItem(SMenuProjectCompile,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_F9,[amcontrol]),@ProjectCompileClick,Nil);
|
||||||
|
FProjectOptions:=NewMenuItem(SMenuProjectOptions,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_F11,[amcontrol,amshift]),@ProjectOptionsClick,Nil);
|
||||||
|
FProject := NewSubMenu(SMenuProject,'','',[FProjectCompile,FProjectoptions]);
|
||||||
|
FHelpAbout:=NewMenuItem(SMenuHelpAbout ,'','',@HelpAboutClick,Nil);
|
||||||
|
FHelp := NewSubMenu(SMenuHelp,'','',[FHelpAbout]);
|
||||||
|
FMainMenu:=NewMenuBar([FFile,FEdit,FProject,FHelp]);
|
||||||
|
FEditor:=TFPgtkScrollText.Create;
|
||||||
|
Feditor.TheText.ConnectChanged(@EditorChanged,Nil);
|
||||||
|
// Compiling messages
|
||||||
|
FMsgLabel:=TFPgtkLabel.Create(SCompilerMessages);
|
||||||
|
FMsgList:=TFPgtkScrollList.Create;
|
||||||
|
FMsgVBox:=TFPgtkVbox.Create;
|
||||||
|
FMsgVBox.PackStart(FMsgLabel,False,False,0);
|
||||||
|
FMsgVBox.PackStart(FMsgList,True,True,0);
|
||||||
|
FVPaned:=TFPgtkVPaned.Create;
|
||||||
|
FVPaned.Add1(FEditor);
|
||||||
|
FVPaned.Add2(FMsgVBox);
|
||||||
|
FVPaned.Position:=350;
|
||||||
|
FVBox.PackStart(FmainMenu,False,False,0);
|
||||||
|
FVBox.PackStart(FVPaned,true, true, 0);
|
||||||
|
ConnectDeleteEvent(@OnDeleteEvent,Nil);
|
||||||
|
Add(FVBox);
|
||||||
|
SetUSize(640,480);
|
||||||
|
SetCaption;
|
||||||
|
FEditor.TheText.GrabFocus;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ---------------------------------------------------------------------
|
||||||
|
Callback events
|
||||||
|
---------------------------------------------------------------------}
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.FileNewClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
begin
|
||||||
|
If CheckSaved then
|
||||||
|
NewFile;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function TMainForm.OnDeleteEvent(Sender:TFPgtkWidget; Event:PGdkEvent; data:pointer): boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=Not CheckSaved;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.FileSaveClick(Sender : TFPgtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
begin
|
||||||
|
If (FFileName='') then
|
||||||
|
FileSaveAsClick(Sender,Data)
|
||||||
|
else
|
||||||
|
SaveToFile(FFileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.FileSaveAsClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
Var
|
||||||
|
FN : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FN:=GetFileName(SSaveFile);
|
||||||
|
If (FN<>'') then
|
||||||
|
SavetoFile(FN);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.FileOpenClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
Var
|
||||||
|
FN : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FN:=GetFileName(SOpenFile);
|
||||||
|
If (FN<>'') then
|
||||||
|
LoadFromFile(FN);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.EditorChanged(Sender : TFPgtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
begin
|
||||||
|
If FModified<>True then
|
||||||
|
begin
|
||||||
|
FModified:=True;
|
||||||
|
SetCaption;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMainForm.EditCCPClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
begin
|
||||||
|
If Sender=FEditCut then
|
||||||
|
EditCut
|
||||||
|
else if Sender=FEditCopy then
|
||||||
|
EditCopy
|
||||||
|
else
|
||||||
|
EditPaste;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMainForm.FileExitClick(Sender : TFPgtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
begin
|
||||||
|
If CheckSaved then
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.HelpAboutClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
begin
|
||||||
|
With TAboutForm.Create do
|
||||||
|
Execute(Nil,Nil,Nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMainForm.ProjectCompileClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
begin
|
||||||
|
Compile;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMainForm.ProjectOptionsClick(Sender : TFPGtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
begin
|
||||||
|
SetOptions;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMainform.DoError(Sender : TObject; Msg : String);
|
||||||
|
|
||||||
|
begin
|
||||||
|
FMsgList.list.Add(TFPGtkListItem.CreateWithLabel(Msg));
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMainform.DoVerbose(Sender : TObject; Msg : String);
|
||||||
|
|
||||||
|
begin
|
||||||
|
FMsgList.list.Add(TFPGtkListItem.CreateWithLabel(Msg));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ ---------------------------------------------------------------------
|
||||||
|
Auxiliary methods
|
||||||
|
---------------------------------------------------------------------}
|
||||||
|
|
||||||
|
Procedure TMainForm.SetCaption;
|
||||||
|
|
||||||
|
Var
|
||||||
|
S : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
S:=SCaption;
|
||||||
|
If (FFileName<>'') then
|
||||||
|
S:=S+' : '+ExtractFileName(FFileName);
|
||||||
|
If FModified then
|
||||||
|
S:=S+' '+SModified;
|
||||||
|
Title:=S;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TMainForm.CheckSaved : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=Not FModified;
|
||||||
|
If Not Result then
|
||||||
|
Case MessageDlg(SFileModified,mtInformation,mbYesNoCancel,0) of
|
||||||
|
mrYes : begin
|
||||||
|
FileSaveClick(Self,Nil);
|
||||||
|
Result:=True;
|
||||||
|
end;
|
||||||
|
mrNo : Result:=True;
|
||||||
|
mrCancel : Result:=False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TMainForm.GetFileName(ATitle : String) : String;
|
||||||
|
|
||||||
|
var
|
||||||
|
FS : TFPgtkFileSelection;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:='';
|
||||||
|
FS := TFPgtkFileSelection.Create (gtk_window_dialog);
|
||||||
|
with FS do
|
||||||
|
begin
|
||||||
|
Title:=ATitle;
|
||||||
|
OKButton.ConnectClicked (@(CloseWithResult), inttopointer(drOk));
|
||||||
|
CancelButton.ConnectClicked (@(CloseWindow), nil);
|
||||||
|
if Not execute (nil, @Result, @DialogSetFilename) = drOk then
|
||||||
|
Result:='';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMainForm.DialogSetFilename(Sender : TFPGtkWindow;Data : Pointer; Action : Integer;Initiator : TFPGtkObject);
|
||||||
|
|
||||||
|
type
|
||||||
|
PString = ^AnsiString;
|
||||||
|
|
||||||
|
begin
|
||||||
|
PString(Data)^:=(Sender as TFPgtkFileSelection).Filename;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ ---------------------------------------------------------------------
|
||||||
|
Public methods
|
||||||
|
---------------------------------------------------------------------}
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.LoadFromFile(FN : String);
|
||||||
|
|
||||||
|
Var
|
||||||
|
S : TStringList;
|
||||||
|
|
||||||
|
begin
|
||||||
|
S:=TStringList.Create;
|
||||||
|
try
|
||||||
|
S.LoadFromFile(FN);
|
||||||
|
FEditor.TheText.Text:=S.Text;
|
||||||
|
FModified:=False;
|
||||||
|
Finally
|
||||||
|
S.Free;
|
||||||
|
end;
|
||||||
|
FFileName:=FN;
|
||||||
|
SetCaption;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.SaveToFile(FN : String);
|
||||||
|
|
||||||
|
begin
|
||||||
|
FFileName:=FN;
|
||||||
|
FEditor.TheText.Lines.SaveToFile(FN);
|
||||||
|
FModified:=False;
|
||||||
|
SetCaption;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.EditCut;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FEditor.TheText.CutClipBoard;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.EditCopy;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FEditor.TheText.CopyCLipBoard;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.EditPaste;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FEditor.TheText.PasteClipBoard;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.NewFile;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Feditor.TheText.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMainForm.Compile;
|
||||||
|
|
||||||
|
Var
|
||||||
|
M,P,R,I : TStream;
|
||||||
|
S,MsgFileName : String;
|
||||||
|
|
||||||
|
Procedure SetupStreams;
|
||||||
|
|
||||||
|
begin
|
||||||
|
I:=TFileStream.Create(FFileName,fmOpenRead);
|
||||||
|
If FCreatePas then
|
||||||
|
P:=TFileStream.Create(ChangeFileExt(FFileName,'.pp'),fmCreate);
|
||||||
|
If FCreateMsg then
|
||||||
|
begin
|
||||||
|
MsgFileName:=ChangeFileExt(FFileName,'.msg');
|
||||||
|
M:=TFileStream.Create(MsgFileName,fmCreate);
|
||||||
|
end;
|
||||||
|
If FCreateRC then
|
||||||
|
R:=TFileStream.Create(ChangeFileExt(FFileName,'.rc'),fmCreate);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure CloseStreams;
|
||||||
|
|
||||||
|
begin
|
||||||
|
M.Free;
|
||||||
|
P.Free;
|
||||||
|
R.Free;
|
||||||
|
I.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FileSaveClick(Self,Nil);
|
||||||
|
If (FUnitName='') then
|
||||||
|
FUnitName:=ExtractFileName(FFileName);
|
||||||
|
FMsgList.List.ClearAll;
|
||||||
|
Try
|
||||||
|
SetupStreams;
|
||||||
|
Try
|
||||||
|
With TMessageCompiler.Create do
|
||||||
|
Try
|
||||||
|
Msg:=M;
|
||||||
|
MC:=I;
|
||||||
|
RC:=R;
|
||||||
|
Pas:=P;
|
||||||
|
OnError:=@DoError;
|
||||||
|
If FVerbose then
|
||||||
|
OnVerbose:=@DoVerbose;
|
||||||
|
UnitName:=FUnitName;
|
||||||
|
MessageFileName:=MsgFileName;
|
||||||
|
EscapeNeeded:=FEscapePath;
|
||||||
|
If (FLanguageID<>-1) then
|
||||||
|
LocaleID:=FLanguageID;
|
||||||
|
If (FSubLanguageID<>-1) then
|
||||||
|
SubLocaleID:=FSubLanguageID;
|
||||||
|
If Compile then
|
||||||
|
DoVerbose(Nil,SSuccesCompiling)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
S:=Format(SErrsCompiling,[Errors]);
|
||||||
|
DoVerbose(Nil,S);
|
||||||
|
MessageDlg(S,mtError,[mbOK],0);
|
||||||
|
end;
|
||||||
|
Finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
Finally
|
||||||
|
CloseStreams;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
On E : Exception do
|
||||||
|
MessageDlg(SErrUnexpected,[E.Message],mtError,[mbOK],0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMainForm.SaveOptions(Sender : TFPGtkWindow;Data : Pointer; Action : Integer;Initiator : TFPGtkObject);
|
||||||
|
|
||||||
|
begin
|
||||||
|
With TOptionsForm(Data) do
|
||||||
|
begin
|
||||||
|
FUnitName:=UnitName;
|
||||||
|
FLanguageID:=StrToIntDef(Trim(Locale),0);
|
||||||
|
FSubLanguageID:=StrToIntDef(Trim(SubLocale),0);
|
||||||
|
FVerbose:=Verbose;
|
||||||
|
FCreateMsg:=CreateMsgFile;
|
||||||
|
FCreatePas:=CreatePasFile;
|
||||||
|
FCreateRC:=CreateRCFile;
|
||||||
|
FEscapePath:=EscapePath;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMainForm.SetOptions;
|
||||||
|
|
||||||
|
Var
|
||||||
|
F : TOptionsForm;
|
||||||
|
|
||||||
|
begin
|
||||||
|
If (FUnitName='') and (FFileName<>'') then
|
||||||
|
FUnitName:=ExtractFileName(FFileName);
|
||||||
|
F:=TOptionsForm.Create;
|
||||||
|
With F do
|
||||||
|
begin
|
||||||
|
UnitName:=FUnitName;
|
||||||
|
Locale:=IntToStr(FLanguageID);
|
||||||
|
SubLocale:=IntToStr(FSubLanguageID);
|
||||||
|
Verbose:=Fverbose;
|
||||||
|
CreateMsgFile:=FCreateMsg;
|
||||||
|
CreatePasFile:=FCreatePas;
|
||||||
|
CreateRCFile:=FCreateRC;
|
||||||
|
EscapePath:=FEscapePath;
|
||||||
|
Execute(Nil,F,@SaveOptions);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
228
utils/fpmc/frmoptions.pp
Normal file
228
utils/fpmc/frmoptions.pp
Normal file
@ -0,0 +1,228 @@
|
|||||||
|
{$mode objfpc}
|
||||||
|
{$h+}
|
||||||
|
|
||||||
|
unit frmoptions;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses fpgtk,gtk,classes,sysutils;
|
||||||
|
|
||||||
|
Type
|
||||||
|
TOptionsForm = Class (TFPGtkWindow)
|
||||||
|
Private
|
||||||
|
FTable : TFPGtkTable;
|
||||||
|
FLVerbose,
|
||||||
|
FLCreateMsgFile,
|
||||||
|
FLCreateRCFile,
|
||||||
|
FLCreatePasFile,
|
||||||
|
FLEscapePath,
|
||||||
|
FLLocale,
|
||||||
|
FLSubLocale,
|
||||||
|
FLUnitName : TFPGtkLabel;
|
||||||
|
FVerbose,
|
||||||
|
FCreateMsgFile,
|
||||||
|
FCreatePasFile,
|
||||||
|
FCreateRCFile,
|
||||||
|
FEscapePath : TFPGtkToggleButton;
|
||||||
|
FUnitName,
|
||||||
|
FLocale,
|
||||||
|
FSubLocale : TFPGtkEntry;
|
||||||
|
FMaxRecentUsed : TFPGtkSpinButton;
|
||||||
|
FSeparator : TFPGtkHSeparator;
|
||||||
|
FVBox : TFPgtkVBox;
|
||||||
|
FHBox : TFPgtkHBox;
|
||||||
|
FOK,
|
||||||
|
FCancel : TFPGtkButton;
|
||||||
|
FButtonBox: TFPgtkHBox;
|
||||||
|
Public
|
||||||
|
Constructor Create;
|
||||||
|
Procedure CreateWindow;
|
||||||
|
Procedure OnShow(Sender : TFpGtkObject;Data : Pointer);
|
||||||
|
Procedure SaveResult(Sender : TFpGtkObject;Data : Pointer);
|
||||||
|
Function GetBoolProp (Index : Integer) : Boolean;
|
||||||
|
Procedure SetBoolProp (Index : Integer; Value : Boolean);
|
||||||
|
Function GetStringProp (Index : Integer) : String;
|
||||||
|
Procedure SetStringProp (Index : Integer; Value : String);
|
||||||
|
Property CreateMsgFile : Boolean Index 1 Read GetBoolProp Write SetBoolProp;
|
||||||
|
Property CreatePasFile : Boolean Index 2 Read GetBoolProp Write SetBoolProp;
|
||||||
|
Property CreateRCFile : Boolean Index 3 Read GetBoolProp Write SetBoolProp;
|
||||||
|
Property EscapePath : Boolean Index 4 Read GetBoolProp Write SetBoolProp;
|
||||||
|
Property Verbose : Boolean Index 5 Read GetBoolProp Write SetBoolProp;
|
||||||
|
Property Locale : String Index 1 Read GetStringProp Write SetStringProp;
|
||||||
|
Property SubLocale : String Index 2 Read GetStringProp Write SetStringProp;
|
||||||
|
Property UnitName : String Index 3 Read GetStringProp Write SetStringProp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Implementation
|
||||||
|
|
||||||
|
ResourceString
|
||||||
|
SOptCreateMsgFile = 'Create message file';
|
||||||
|
SOptCreateRCFile = 'Create RC file';
|
||||||
|
SOptCreatePasFile = 'Create pascal file';
|
||||||
|
SOptEscapePath = 'Escape path delimiters';
|
||||||
|
SOptLocale = 'Locale ID';
|
||||||
|
SOptSubLocale = 'Sublocale ID';
|
||||||
|
SOptUnitName = 'Unit name';
|
||||||
|
SOK = 'OK';
|
||||||
|
SCancel = 'Cancel';
|
||||||
|
SOptVerbose = 'Be verbose';
|
||||||
|
|
||||||
|
Function MakeLabel(Caption : String) : TFPgtkLabel;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=TFPGtkLabel.Create(Caption);
|
||||||
|
Result.Justify:=GTK_JUSTIFY_RIGHT;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function MakeCheck : TFPgtkToggleButton;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=TFPgtkToggleButton.create;
|
||||||
|
Result.SetUsize(14,14);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Constructor TOptionsForm.Create;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Inherited Create(GTK_WINDOW_DIALOG);
|
||||||
|
CreateWindow;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function PackBox(W : TFpGtkWidget) : TFpGtkHbox;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=TFPGtkHBox.Create;
|
||||||
|
Result.PackStart(W,True,False,0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure ToptionsForm.CreateWindow;
|
||||||
|
|
||||||
|
Var
|
||||||
|
OH,OV : TgtkAttachOPtions;
|
||||||
|
B : TfpgtkHbox;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FVBox:=TFPGtkVBox.Create;
|
||||||
|
FVBox.Spacing:=4;
|
||||||
|
FVBox.Border:=8;
|
||||||
|
Add(FVBox);
|
||||||
|
|
||||||
|
// Table area
|
||||||
|
FTable:=TFPGtkTable.Create(2,8);
|
||||||
|
|
||||||
|
FLVerbose:=MakeLabel(SOptVerbose);
|
||||||
|
FLCreateMsgFile:=MakeLabel(SOptCreateMsgFile);
|
||||||
|
FLCreateRCFile:=MakeLabel(SOptCreateRCFile);
|
||||||
|
FLCreatePasFile:=MakeLabel(SOptCreatePasFile);
|
||||||
|
FLEscapePath:=MakeLabel(SOptEscapePath);
|
||||||
|
FLLocale:=MakeLabel(SOptLocale);
|
||||||
|
FLSubLocale:=MakeLabel(SOptSubLocale);
|
||||||
|
FLUnitName:=MakeLabel(SOptUnitName);
|
||||||
|
|
||||||
|
FVerbose:=MakeCheck;
|
||||||
|
FEscapePath:=MakeCheck;
|
||||||
|
FCreateMsgFile:=MakeCheck;
|
||||||
|
FCreateRCFile:=MakeCheck;
|
||||||
|
FCreatePasFile:=MakeCheck;
|
||||||
|
FUnitName:=TFpGtkEntry.Create;
|
||||||
|
FLocale:=TFpGtkEntry.Create;
|
||||||
|
FSubLocale:=TFpGtkEntry.Create;
|
||||||
|
|
||||||
|
OH:=GTK_EXPAND or GTK_FILL;
|
||||||
|
FTable.Attach(FLVerbose ,0,1,0,1,GTK_FILL,0,4,4);
|
||||||
|
FTable.Attach(FLCreateMsgFile ,0,1,1,2,GTK_FILL,0,4,4);
|
||||||
|
FTable.Attach(FLCreatePasFile ,0,1,2,3,GTK_FILL,0,4,4);
|
||||||
|
FTable.Attach(FLCreateRCFile ,0,1,3,4,GTK_FILL,0,4,4);
|
||||||
|
FTable.Attach(FLEscapePath ,0,1,4,5,GTK_FILL,0,4,4);
|
||||||
|
FTable.Attach(FLUnitName ,0,1,5,6,GTK_FILL,0,4,4);
|
||||||
|
FTable.Attach(FLLocale ,0,1,6,7,GTK_FILL,0,4,4);
|
||||||
|
FTable.Attach(FLSubLocale ,0,1,7,8,GTK_FILL,0,4,4);
|
||||||
|
|
||||||
|
FTable.Attach(PackBox(FVerbose) ,1,2,0,1,0,GTK_FILL,4,4);
|
||||||
|
FTable.Attach(PackBox(FCreateMsgFile) ,1,2,1,2,0,GTK_FILL,4,4);
|
||||||
|
FTable.Attach(PackBox(FCreatePasFile) ,1,2,2,3,0,GTK_FILL,4,4);
|
||||||
|
FTable.Attach(PackBox(FCreateRCFile) ,1,2,3,4,0,GTK_FILL,4,4);
|
||||||
|
FTable.Attach(PackBox(FEscapePath) ,1,2,4,5,0,GTK_FILL,4,4);
|
||||||
|
FTable.Attach(FUnitName ,1,2,5,6,0,GTK_FILL,4,4);
|
||||||
|
FTable.Attach(FLocale ,1,2,6,7,0,GTK_FILL,4,4);
|
||||||
|
FTable.Attach(FSubLocale ,1,2,7,8,0,GTK_FILL,4,4);
|
||||||
|
|
||||||
|
// button area
|
||||||
|
FOK:=TFpGtkButton.CreateWithLabel(SOK);
|
||||||
|
FOK.ConnectClicked(@SaveResult,Nil);
|
||||||
|
FCancel:=TFPgtkButton.CreateWithLabel(SCancel);
|
||||||
|
FCancel.ConnectCLicked(@CloseWindow,Nil);
|
||||||
|
FSeparator:=TFPgtkHSeparator.Create;
|
||||||
|
FButtonBox:=TfpGtkHBox.Create;
|
||||||
|
FButtonBox.Spacing:=4;
|
||||||
|
FButtonBox.PackEnd(FOK,false,false,4);
|
||||||
|
FButtonBox.PackEnd(FCancel,false,false,4);
|
||||||
|
// Add to window
|
||||||
|
FVBox.PackStart(FTable,False,False,0);
|
||||||
|
FVBox.PackStart(FSeparator,False,False,4);
|
||||||
|
FVBox.PackStart(FButtonBox,false,false,0);
|
||||||
|
// Some events;
|
||||||
|
ConnectShow(@OnShow,Nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TOptionsForm.OnShow(Sender : TFpgtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
begin
|
||||||
|
FocusedWidget(FCreateMsgFile);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TOptionsForm.SaveResult(Sender : TFpgtkObject; Data : Pointer);
|
||||||
|
|
||||||
|
begin
|
||||||
|
CloseWithResult(Sender,IntToPointer(drOK));
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TOptionsForm.GetBoolProp (Index : Integer) : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=False;
|
||||||
|
Case Index of
|
||||||
|
1 : Result:=FCreateMsgFile.Active;
|
||||||
|
2 : Result:=FCreatePasFile.Active;
|
||||||
|
3 : Result:=FCreateRCFile.Active;
|
||||||
|
4 : Result:=FEscapePath.Active;
|
||||||
|
5 : Result:=FVerbose.Active;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TOptionsForm.SetBoolProp (Index : Integer; Value : Boolean);
|
||||||
|
|
||||||
|
begin
|
||||||
|
Case Index of
|
||||||
|
1 : FCreateMsgFile.Active:=Value;
|
||||||
|
2 : FCreatePasFile.Active:=Value;
|
||||||
|
3 : FCreateRCFile.Active:=Value;
|
||||||
|
4 : FEscapePath.Active:=Value;
|
||||||
|
5 : FVerbose.Active:=Value;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TOptionsForm.GetStringProp (Index : Integer) : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:='';
|
||||||
|
Case Index of
|
||||||
|
1 : Result:=Flocale.Text;
|
||||||
|
2 : Result:=FSublocale.Text;
|
||||||
|
3 : Result:=FUnitName.Text;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TOptionsForm.SetStringProp (Index : Integer; Value : String);
|
||||||
|
|
||||||
|
begin
|
||||||
|
Case Index of
|
||||||
|
1 : Flocale.Text:=Value;
|
||||||
|
2 : FSublocale.Text:=Value;
|
||||||
|
3 : FUnitName.Text:=Value;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
434
utils/fpmc/msgcomp.pp
Normal file
434
utils/fpmc/msgcomp.pp
Normal file
@ -0,0 +1,434 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 2003 by the Free Pascal development team
|
||||||
|
|
||||||
|
Windows message compiler unit.
|
||||||
|
|
||||||
|
See the file COPYING.FPC, included in this distribution,
|
||||||
|
for details about the copyright.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
{$ifdef fpc}
|
||||||
|
{$mode objfpc}
|
||||||
|
{$h+}
|
||||||
|
{$endif}
|
||||||
|
unit msgcomp;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
Uses Classes;
|
||||||
|
|
||||||
|
Type
|
||||||
|
TMessagehandler = Procedure(Sender : Tobject; Msg : String) Of Object;
|
||||||
|
|
||||||
|
TMessageCompiler = Class
|
||||||
|
Private
|
||||||
|
FErrors : Integer;
|
||||||
|
FEscapeNeeded : Boolean;
|
||||||
|
FOnVerbose,
|
||||||
|
FOnError : TMessageHandler;
|
||||||
|
FCompiling : Boolean;
|
||||||
|
FMC: TStream;
|
||||||
|
FPas: TStream;
|
||||||
|
FRC: TStream;
|
||||||
|
FMsg: TStream;
|
||||||
|
FLocaleID: Integer;
|
||||||
|
FSubLocaleID: Integer;
|
||||||
|
FMsgFileName: String;
|
||||||
|
FUnitName: String;
|
||||||
|
Procedure SWriteLn(S : String; Stream : TStream);
|
||||||
|
Procedure CompileError(EMsg : String;Line : Integer; Value : String);
|
||||||
|
Procedure ProcessMessages(Lines : TStrings; MsgList : Tlist);
|
||||||
|
Procedure WriteMsgFile(MsgList : TList; Stream : TStream);
|
||||||
|
Procedure WriteRCFile(MsgList : TList; Stream : TStream);
|
||||||
|
Procedure WritePasFile(MsgList : TList; Stream : TStream);
|
||||||
|
Procedure ClearList(MsgList : Tlist);
|
||||||
|
procedure SetStream(const Index: Integer; const Value: TStream);
|
||||||
|
Function GetStream(const Index: Integer) : TStream;
|
||||||
|
Procedure Verbose(Fmt : String;Args : Array of const);
|
||||||
|
Public
|
||||||
|
Constructor Create;
|
||||||
|
Function Compile : Boolean;
|
||||||
|
Property MC : TStream index 1 Read GetStream Write SetStream;
|
||||||
|
Property Msg : TStream index 2 Read GetStream Write SetStream;
|
||||||
|
Property Pas : TStream index 3 Read GetStream Write SetStream;
|
||||||
|
Property RC : TStream Index 4 Read GetStream Write SetStream;
|
||||||
|
Property LocaleID : Integer Read FLocaleID Write FlocaleID;
|
||||||
|
Property SubLocaleID : Integer Read FSubLocaleID Write FSublocaleID;
|
||||||
|
Property MessageFileName : String Read FMsgFileName Write FMsgFileName;
|
||||||
|
Property UnitName : String Read FUnitName Write FUnitName;
|
||||||
|
Property EscapeNeeded : Boolean Read FEscapeNeeded Write FEscapeNeeded;
|
||||||
|
Property OnVerbose : TMessageHandler Read FOnVerbose Write FOnVerbose;
|
||||||
|
Property OnError : TMessageHandler Read FOnError Write FOnError;
|
||||||
|
Property Errors : Integer Read FErrors;
|
||||||
|
End;
|
||||||
|
|
||||||
|
TMessageEntry = Class(TObject)
|
||||||
|
MessageID : Cardinal;
|
||||||
|
TotalMessageOfs : Cardinal;
|
||||||
|
MessageAlias,
|
||||||
|
Language,
|
||||||
|
MessageText : String;
|
||||||
|
Function OffsetToNext : Cardinal;
|
||||||
|
End;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
Uses SysUtils ;
|
||||||
|
|
||||||
|
Const
|
||||||
|
SC = SizeOF(Cardinal);
|
||||||
|
|
||||||
|
Resourcestring
|
||||||
|
SErrSetStreamNotAllowed = 'Setting stream during compile is not allowed.';
|
||||||
|
SUnknownLine = 'Unknown error: "%s"';
|
||||||
|
SNoMessage = 'Message starts without MessageID : "%s"';
|
||||||
|
SErrUnknownDirective = 'Unknown directive "%s"';
|
||||||
|
SErrInLine = 'Error: line %d: %s';
|
||||||
|
SFoundMessageID = 'Found messageID : %s';
|
||||||
|
SStartCompiling = 'Start compiling: %d lines.';
|
||||||
|
SErrUnexpected = 'Unexpected error : %s';
|
||||||
|
SWritingMessageFile = 'Writing %d entries to message file.';
|
||||||
|
SWritingPasFile = 'Writing to unit "%s"';
|
||||||
|
SWrotePasFile = 'Wrote %d constants to unit "%s"';
|
||||||
|
SWritingRCFile = 'Writing rc file.';
|
||||||
|
SErrNoNumber = 'Not a valid integer: %s';
|
||||||
|
|
||||||
|
procedure TMessageCompiler.ClearList(MsgList: Tlist);
|
||||||
|
|
||||||
|
Var
|
||||||
|
I : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
For I:=0 to MsgList.Count-1 do
|
||||||
|
TMessageEntry(MsgList[I]).Free;
|
||||||
|
MsgList.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TMessageCompiler.Compile : Boolean;
|
||||||
|
|
||||||
|
Var
|
||||||
|
Lines : TStrings;
|
||||||
|
MsgList : TList;
|
||||||
|
|
||||||
|
Begin
|
||||||
|
FErrors:=0;
|
||||||
|
MsgList:=TList.Create;
|
||||||
|
try
|
||||||
|
Lines:=TStringList.Create;
|
||||||
|
Try
|
||||||
|
Lines.LoadFromStream(MC);
|
||||||
|
ProcessMessages(Lines,MSgList);
|
||||||
|
If (FErrors=0) then
|
||||||
|
begin
|
||||||
|
If Assigned(Msg) then
|
||||||
|
WriteMsgFile(MsgList,Msg);
|
||||||
|
if Assigned(Pas) then
|
||||||
|
WritePasFile(MsgList,Pas);
|
||||||
|
if Assigned(RC) then
|
||||||
|
WriteRCFile(MsgList,RC);
|
||||||
|
end;
|
||||||
|
Finally
|
||||||
|
Lines.Free;
|
||||||
|
end;
|
||||||
|
Finally
|
||||||
|
ClearList(MsgList);
|
||||||
|
end;
|
||||||
|
Result:=(FErrors=0);
|
||||||
|
End;
|
||||||
|
|
||||||
|
Procedure TMessageCompiler.Verbose(Fmt : String;Args : Array of const);
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Assigned(FOnverbose) then
|
||||||
|
FOnVerBose(Self,Format(Fmt,Args));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function HexToInt(Hex : String) : Integer;
|
||||||
|
|
||||||
|
Const HexSymbols : String = '0123456789ABCDEF';
|
||||||
|
|
||||||
|
Var I,J : Integer;
|
||||||
|
|
||||||
|
Begin
|
||||||
|
Hex := UpperCase(Hex);
|
||||||
|
Result := 0;
|
||||||
|
J := Length(Hex);
|
||||||
|
For I := 1 to J do
|
||||||
|
Result := Result+((Pos(Hex[J-I+1],HexSymbols)-1) shl ((I-1)*4));
|
||||||
|
End;
|
||||||
|
|
||||||
|
Constructor TMessageCompiler.Create;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// English
|
||||||
|
LocaleID:=9;
|
||||||
|
SubLocaleID:=1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Procedure TMessageCompiler.CompileError(EMsg : String;Line : Integer; Value : String);
|
||||||
|
|
||||||
|
begin
|
||||||
|
Inc(FErrors);
|
||||||
|
EMsg:=Format(EMsg,[Value]);
|
||||||
|
If Assigned(FOnError) then
|
||||||
|
FOnError(Self,Format(SErrInLine,[Line,EMsg]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMessageCompiler.ProcessMessages(Lines : TStrings; MsgList : TList);
|
||||||
|
|
||||||
|
Var
|
||||||
|
Line : Integer;
|
||||||
|
Me : TMessageEntry;
|
||||||
|
|
||||||
|
Function Pad(S : String; Len : Integer) : String;
|
||||||
|
Var I : Integer;
|
||||||
|
Begin
|
||||||
|
For I := Length(S) to Len-1 do S := S+' ';
|
||||||
|
Result := S;
|
||||||
|
End;
|
||||||
|
|
||||||
|
Function SkipLine(Var S : String) : Boolean;
|
||||||
|
|
||||||
|
Var
|
||||||
|
I : Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
I:=Pos(';',S);
|
||||||
|
If (I<>0) then
|
||||||
|
S:=Copy(S,1,I-1);
|
||||||
|
Result:=Length(S)=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure DoDirective(S : String; I : Integer);
|
||||||
|
|
||||||
|
Var
|
||||||
|
MsgID : Integer;
|
||||||
|
T : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
T := UpperCase(Copy(S,1,I-1));
|
||||||
|
Delete(S,1,I);
|
||||||
|
S:=Trim(S);
|
||||||
|
If (T='MESSAGEID') Then
|
||||||
|
begin
|
||||||
|
Verbose(SFoundMessageID,[S]);
|
||||||
|
S:=Uppercase(S);
|
||||||
|
If Pos('0X',S)<>0 then
|
||||||
|
begin
|
||||||
|
Delete(S,1,2);
|
||||||
|
MsgId:=HexToInt(S);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
MsgID:=StrToIntDef(S,-1);
|
||||||
|
If (MsgID=-1) then
|
||||||
|
CompileError(Format(SErrNoNumber,[S]),Line,T)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Me:=TMessageENtry.Create;
|
||||||
|
Me.MessageID:=MsgID;
|
||||||
|
end;
|
||||||
|
End
|
||||||
|
Else If (T = 'SYMBOLICNAME') Then
|
||||||
|
Begin
|
||||||
|
If Assigned(me) then
|
||||||
|
Me.MessageAlias:=S;
|
||||||
|
End
|
||||||
|
Else If (T = 'LANGUAGE') Then
|
||||||
|
begin
|
||||||
|
If assigned(ME) then
|
||||||
|
Me.Language:=S;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
CompileError(SErrUnknownDirective,Line,T);
|
||||||
|
End;
|
||||||
|
|
||||||
|
Var
|
||||||
|
I,Count : Integer;
|
||||||
|
S : String;
|
||||||
|
|
||||||
|
Begin
|
||||||
|
Count := Lines.Count-1;
|
||||||
|
Verbose(SStartCOmpiling,[Count]);
|
||||||
|
Line:=0;
|
||||||
|
Me:=Nil;
|
||||||
|
While Line<=Count do
|
||||||
|
Begin
|
||||||
|
Try
|
||||||
|
S:=Lines[Line];
|
||||||
|
If Not SkipLine(S) then
|
||||||
|
begin
|
||||||
|
I:=Pos('=',S);
|
||||||
|
If (I<>0) then
|
||||||
|
DoDirective(S,I)
|
||||||
|
else
|
||||||
|
If (Me=Nil) Then
|
||||||
|
CompileError(SNoMessage,Line,S)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// Message starts.
|
||||||
|
While (S<>'.') do
|
||||||
|
begin
|
||||||
|
If Length(Me.MessageText)>0 then
|
||||||
|
Me.MessageText:=Me.MessageText+#13#10+S
|
||||||
|
else
|
||||||
|
Me.MessageText:=S;
|
||||||
|
Inc(Line);
|
||||||
|
If Line<=Count then
|
||||||
|
S:=Lines[Line]
|
||||||
|
end;
|
||||||
|
MsgList.Add(Me);
|
||||||
|
Me:=Nil;
|
||||||
|
end;
|
||||||
|
End;
|
||||||
|
Except
|
||||||
|
On E : Exception do
|
||||||
|
CompileError(SErrUnexpected,Line,E.Message);
|
||||||
|
End;
|
||||||
|
Inc(Line);
|
||||||
|
end;
|
||||||
|
End;
|
||||||
|
|
||||||
|
procedure TMessageCompiler.SetStream(const Index: Integer;
|
||||||
|
const Value: TStream);
|
||||||
|
begin
|
||||||
|
If FCompiling then
|
||||||
|
Raise Exception.Create(SErrSetStreamNotAllowed);
|
||||||
|
Case index of
|
||||||
|
1 : FMC := Value;
|
||||||
|
2 : FMsg := Value;
|
||||||
|
3 : FPas := Value;
|
||||||
|
4 : FRC := Value;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TMessageCompiler.GetStream(const Index: Integer) : TStream;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Case index of
|
||||||
|
1 : Result:=FMC;
|
||||||
|
2 : Result:=FMsg;
|
||||||
|
3 : Result:=FPas;
|
||||||
|
4 : Result:=FRC;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMessageCompiler.SWriteLn(S: String; Stream: TStream);
|
||||||
|
begin
|
||||||
|
S:=S+#13#10;
|
||||||
|
Stream.Write(S[1],Length(S));
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TMessageCompiler.WriteMSGFile(MsgList : Tlist; Stream : TStream);
|
||||||
|
|
||||||
|
|
||||||
|
Var
|
||||||
|
I,Count : Integer;
|
||||||
|
HeaderEntry,NullEntry: Array[1..3] of cardinal;
|
||||||
|
O,BO : Cardinal;
|
||||||
|
M : TMessageEntry;
|
||||||
|
S : String;
|
||||||
|
|
||||||
|
Begin
|
||||||
|
Verbose(SWritingMessageFile,[MsgList.Count]);
|
||||||
|
NullEntry[1]:=0;
|
||||||
|
NullEntry[2]:=0;
|
||||||
|
NullEntry[3]:=0;
|
||||||
|
Count:=MsgList.Count;
|
||||||
|
Stream.Write(Count,SC);
|
||||||
|
BO:=((SC*3)*Count)+SC; // Header size...
|
||||||
|
// Loop 1: Header entries.
|
||||||
|
For I:=0 to Count-1 do
|
||||||
|
begin
|
||||||
|
M:=TMessageEntry(MsgList[I]);
|
||||||
|
HeaderEntry[1]:=M.MessageID;
|
||||||
|
HeaderEntry[2]:=M.MessageID;
|
||||||
|
HeaderEntry[3]:=BO;
|
||||||
|
BO:=BO+M.OffsetToNext;
|
||||||
|
Stream.Write(HeaderEntry,SizeOf(HeaderEntry));
|
||||||
|
end;
|
||||||
|
For I:=0 to Count-1 do
|
||||||
|
begin
|
||||||
|
M:=TMessageEntry(MsgList[I]);
|
||||||
|
O:=M.OffsetToNext;
|
||||||
|
Stream.Write(O,SizeOf(O));
|
||||||
|
Dec(O,SC);
|
||||||
|
S:=M.MessageText;
|
||||||
|
Stream.Write(S[1],Length(S));
|
||||||
|
If (Length(S)<O) then
|
||||||
|
Stream.Write(NullEntry,O-Length(S));
|
||||||
|
end;
|
||||||
|
End;
|
||||||
|
|
||||||
|
procedure TMessageCompiler.WritePasFile(MsgList: TList; Stream: TStream);
|
||||||
|
|
||||||
|
Var
|
||||||
|
I,Count : Integer;
|
||||||
|
ME : TMessageEntry;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Verbose(SWritingPasFile,[UnitName]);
|
||||||
|
SWriteln(Format('Unit %s;',[UnitName]),Stream);
|
||||||
|
SWriteln('',Stream);
|
||||||
|
SWriteln('Interface',Stream);
|
||||||
|
SWriteln('',Stream);
|
||||||
|
SWriteln('Const',Stream);
|
||||||
|
Count:=0;
|
||||||
|
For I:=0 to MsgList.Count-1 do
|
||||||
|
begin
|
||||||
|
Me:=TMessageEntry(MsgList[I]);
|
||||||
|
With Me do
|
||||||
|
If (MessageAlias<>'') then
|
||||||
|
begin
|
||||||
|
Swriteln(Format(' %s = %d; ',[MessageAlias,MessageID]),Stream);
|
||||||
|
Inc(Count);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
SWriteln('',Stream);
|
||||||
|
SWriteln('Implementation',Stream);
|
||||||
|
SWriteln('',Stream);
|
||||||
|
SWriteln('end.',Stream);
|
||||||
|
Verbose(SWrotePasFile,[Count,UnitName]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMessageCompiler.WriteRCFile(MsgList: TList; Stream: TStream);
|
||||||
|
|
||||||
|
Const
|
||||||
|
LangLine = 'LANGUAGE 0x%s,0x%s';
|
||||||
|
FileLine = '1 11 "%s"';
|
||||||
|
|
||||||
|
Var
|
||||||
|
S : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Verbose(SWritingRCFile,[]);
|
||||||
|
S:=Format(LangLine,[IntToHex(LocaleID,1),IntToHex(SubLocaleID,1)]);
|
||||||
|
SWriteLn(S,Stream);
|
||||||
|
S:=MessageFileName;
|
||||||
|
If EscapeNeeded Then
|
||||||
|
S:=StringReplace(S,'\','\\',[rfReplaceAll]);
|
||||||
|
SWriteLn(Format(FileLine,[S]),Stream);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TMessageEntry }
|
||||||
|
|
||||||
|
function TMessageEntry.OffsetToNext: Cardinal;
|
||||||
|
begin
|
||||||
|
Result:=((Length(MessageText) div SC) +2) * SC;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2003-02-14 21:59:21 michael
|
||||||
|
+ Initial implementation
|
||||||
|
|
||||||
|
}
|
||||||
93
utils/fpmc/readmsg.pp
Normal file
93
utils/fpmc/readmsg.pp
Normal file
@ -0,0 +1,93 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 1999-2000 by the Free Pascal development team
|
||||||
|
|
||||||
|
reads and dumps a message file to screen.
|
||||||
|
|
||||||
|
See the file COPYING.FPC, included in this distribution,
|
||||||
|
for details about the copyright.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
{$mode objfpc}
|
||||||
|
{$h+}
|
||||||
|
program readmsg;
|
||||||
|
|
||||||
|
Type
|
||||||
|
PCardinal = ^Cardinal;
|
||||||
|
|
||||||
|
Var
|
||||||
|
F : File of Cardinal;
|
||||||
|
PO,PI : PCardinal;
|
||||||
|
I,J,Count,C,S : Cardinal;
|
||||||
|
Buf : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Assign(F,Paramstr(1));
|
||||||
|
Reset(F);
|
||||||
|
Read(F,Count);
|
||||||
|
Writeln('Message count: ',Count);
|
||||||
|
S:=SizeOf(Cardinal)*Count+1;
|
||||||
|
GetMem(PO,S);
|
||||||
|
GetMem(PI,S);
|
||||||
|
FillChar(PI^,S,0);
|
||||||
|
FillChar(PO^,S,0);
|
||||||
|
For I:=1 to Count do
|
||||||
|
begin
|
||||||
|
Read(F,C);
|
||||||
|
PI[I]:=C;
|
||||||
|
Read(F,C);
|
||||||
|
If (C<>PI[I]) then
|
||||||
|
Writeln('Error in ID: ',C,'<>ID',PI[I])
|
||||||
|
else
|
||||||
|
Writeln('Found ID ',C);
|
||||||
|
Read(F,C);
|
||||||
|
PO[I]:=C;
|
||||||
|
Writeln('Found offset : ',C);
|
||||||
|
end;
|
||||||
|
For I:=1 to Count do
|
||||||
|
begin
|
||||||
|
Seek(F,PO[I] div 4);
|
||||||
|
Read(F,S);
|
||||||
|
Writeln('Found offset ',S,' at item ',i,' offset ',PO[I]);
|
||||||
|
For J:=1 to (S div 4)-1 do
|
||||||
|
begin
|
||||||
|
Read(F,C);
|
||||||
|
Move(C,Buf[J*4-3],4);
|
||||||
|
end;
|
||||||
|
J:=S-4;
|
||||||
|
While Buf[J]=#0 do
|
||||||
|
dec(J);
|
||||||
|
SetLength(Buf,J);
|
||||||
|
Writeln('String (',J,') : ',Buf);
|
||||||
|
end;
|
||||||
|
Writeln('Seqential read : ');
|
||||||
|
Seek(F,PO[1] div 4);
|
||||||
|
For I:=1 to Count do
|
||||||
|
begin
|
||||||
|
Read(F,S);
|
||||||
|
Writeln('Found offset ',S,' at item ',i,' offset ',FilePos(F));
|
||||||
|
For J:=1 to (S div 4)-1 do
|
||||||
|
begin
|
||||||
|
Read(F,C);
|
||||||
|
Move(C,Buf[J*4-3],4);
|
||||||
|
end;
|
||||||
|
J:=S-4;
|
||||||
|
While Buf[J]=#0 do
|
||||||
|
dec(J);
|
||||||
|
SetLength(Buf,J);
|
||||||
|
Writeln('String (',J,') : ',Buf);
|
||||||
|
end;
|
||||||
|
Close(F);
|
||||||
|
end.
|
||||||
|
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2003-02-14 21:59:21 michael
|
||||||
|
+ Initial implementation
|
||||||
|
|
||||||
|
}
|
||||||
64
utils/fpmc/test.mc
Normal file
64
utils/fpmc/test.mc
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
;******************************************************
|
||||||
|
; Default messages for FPC eventlog class
|
||||||
|
;******************************************************
|
||||||
|
; Categories are mapped from 1 to 4
|
||||||
|
; 1 : etInfo
|
||||||
|
; 2 : etWarning
|
||||||
|
; 3 : etError
|
||||||
|
; 4 : etDebug
|
||||||
|
;
|
||||||
|
; Categories (1-4)
|
||||||
|
MessageId=1
|
||||||
|
SymbolicName=ECInfo
|
||||||
|
Language=English
|
||||||
|
Information
|
||||||
|
.
|
||||||
|
|
||||||
|
MessageId=2
|
||||||
|
SymbolicName=ECWarning
|
||||||
|
Language=English
|
||||||
|
Warning
|
||||||
|
.
|
||||||
|
|
||||||
|
MessageId=3
|
||||||
|
SymbolicName=ECError
|
||||||
|
Language=English
|
||||||
|
Error
|
||||||
|
.
|
||||||
|
|
||||||
|
MessageId=4
|
||||||
|
SymbolicName=ECDebug
|
||||||
|
Language=English
|
||||||
|
Debug
|
||||||
|
.
|
||||||
|
|
||||||
|
;
|
||||||
|
; Message Definitions (1000-1004)
|
||||||
|
MessageId=1000
|
||||||
|
Language=English
|
||||||
|
%1.
|
||||||
|
.
|
||||||
|
|
||||||
|
; Information
|
||||||
|
MessageId=1001
|
||||||
|
Language=English
|
||||||
|
Information: %1
|
||||||
|
.
|
||||||
|
|
||||||
|
; Warnings
|
||||||
|
MessageId=1002
|
||||||
|
Language=English
|
||||||
|
Warning: %1
|
||||||
|
.
|
||||||
|
|
||||||
|
; Error
|
||||||
|
MessageId=1003
|
||||||
|
Language=English
|
||||||
|
Error: %1
|
||||||
|
.
|
||||||
|
|
||||||
|
; Debug
|
||||||
|
MessageId=1004
|
||||||
|
Language=English
|
||||||
|
Debug: %1
|
||||||
|
.
|
||||||
Loading…
Reference in New Issue
Block a user