1{$mode objfpc}
2{$h+}
3unit frmmain;
4
5interface
6
7uses gdk,gtk,fpgtk,fpgtkext,classes,sysutils;
8
9Type
10  TMainForm = Class(TFPGtkWindow)
11    FModified : Boolean;
12    FFileName : String;
13    FUnitName : String;
14    FLanguageID : Integer;
15    FSubLanguageID : Integer;
16    FVerbose,
17    FCreateMsg,
18    FCreatePas,
19    FCreateRC,
20    FEscapePath : Boolean;
21    FMsgLabel : TFPgtkLabel;
22    FMsgList : TFPgtkScrollList;
23    FMsgVBox,
24    FVBox : TFPGtkVBox;
25    FVPaned : TFPgtkVPaned;
26    FFile,
27    FFileNew,
28    FFileOpen,
29    FFileSave,
30    FFileSaveAs,
31    FFileExit,
32    FEdit,
33    FEditCut,
34    FEditCopy,
35    FEditPaste,
36    FProject,
37    FProjectCompile,
38    FProjectOptions,
39    FHelp,
40    FHelpAbout : TFPGtkMenuItem;
41    FMainMenu : TFPGtkMenuBar;
42    FEditor : TFPGtkScrollText;
43    Procedure CreateWindow;
44    Function CheckSaved : Boolean;
45    Procedure SetCaption;
46    Function GetFileName(ATitle : String) : String;
47    // Callback functions.
48    Procedure DialogSetFilename(Sender : TFPGtkWindow;Data : Pointer; Action : Integer;Initiator : TFPGtkObject);
49    Procedure SaveOptions(Sender : TFPGtkWindow;Data : Pointer; Action : Integer;Initiator : TFPGtkObject);
50    Function  OnDeleteEvent(Sender:TFPgtkWidget; Event:PGdkEvent; data:pointer): boolean;
51    Procedure FileNewClick(Sender : TFPGtkObject; Data : Pointer);
52    Procedure FileSaveClick(Sender : TFPgtkObject; Data : Pointer);
53    Procedure FileSaveAsClick(Sender : TFPGtkObject; Data : Pointer);
54    Procedure FileOpenClick(Sender : TFPGtkObject; Data : Pointer);
55    Procedure FileExitClick(Sender : TFPgtkObject ; Data : Pointer);
56    Procedure EditCCPClick(Sender : TFPGtkObject; Data : Pointer);
57    Procedure ProjectCompileClick(Sender : TFPGtkObject; Data : Pointer);
58    Procedure ProjectOptionsClick(Sender : TFPGtkObject; Data : Pointer);
59    Procedure HelpAboutClick(Sender : TFPGtkObject; Data : Pointer);
60    Procedure EditorChanged(Sender : TFPgtkObject; Data : Pointer);
61    Procedure DoError(Sender : TObject; Msg : String);
62    Procedure DoVerbose(Sender : TObject; Msg : String);
63  Public
64    Constructor Create;
65    Procedure Compile;
66    Procedure SetOptions;
67    Procedure LoadFromFile(FN : String);
68    Procedure SaveToFile(FN : String);
69    Procedure NewFile;
70    Procedure EditCut;
71    Procedure EditCopy;
72    Procedure EditPaste;
73    Property Modified : Boolean Read FModified;
74    Property FileName : String Read FFileName;
75  end;
76
77Implementation
78
79uses frmabout,frmoptions,msgcomp;
80
81ResourceString
82  SMenuFile           = '_File';
83  SMenuFileNew        = '_New';
84  SMenuFileOpen       = '_Open';
85  SMenuFileSave       = '_Save';
86  SMenuFileSaveAs     = 'Save _as';
87  SMenuFileExit       = 'E_xit';
88  SMenuEdit           = '_Edit';
89  SMenuEditCut        = 'C_ut';
90  SMenuEditCopy       = '_Copy';
91  SMenuEditPaste      = '_Paste';
92  SMenuProject        = '_Project';
93  SMenuProjectCompile = '_Compile';
94  SMenuProjectoptions = '_Options';
95  SMenuHelp           = '_Help';
96  SMenuHelpAbout      = '_About';
97
98  SCaption        = 'Free Pascal message compiler';
99  SFileModified  = 'File has changed. Save changes ?';
100  SSaveFile      = 'Save file as';
101  SOpenFile      = 'Select file to open';
102  SModified      = '(modified)';
103  SCompilerMessages = 'Compile messages';
104  SErrsCompiling    = 'Encountered %d errors while compiling.';
105  SSuccesCompiling = 'Succesfully compiled messages.';
106  SErrUnexpected  = 'The following unexpected error occurred when compiling:%s';
107
108{ ---------------------------------------------------------------------
109    Form Creation
110  ---------------------------------------------------------------------}
111
112Constructor TMainForm.Create;
113
114begin
115  Inherited create (gtk_window_dialog);
116  FCreateMsg:=True;
117  FCreatePas:=True;
118  FCreateRC:=True;
119  FEscapePath:=True;
120  FVerbose:=True;
121  Createwindow;
122  If ParamCount>0 then
123    LoadFromFile(Paramstr(1));
124end;
125
126Procedure TMainForm.CreateWindow;
127
128Var
129  FAccelGroup : Integer;
130
131begin
132  FVBox:=TFPgtkVBox.Create;
133  FAccelGroup:=AccelGroupNew;
134  FFileNew:=NewMenuItem(SMenuFileNew,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_N,[amcontrol]),@FileNewClick,Nil);
135  FFileOpen:=NewMenuItem(SMenuFileOpen,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_O,[amcontrol]),@FileOpenClick,Nil);
136  FFileSave:=NewMenuItem(SMenuFileSave,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_S,[amcontrol]),@FileSaveClick,Nil);
137  FFileSaveAs:=NewMenuItem(SMenuFileSaveAs,'','', @FileSaveAsClick,Nil);
138  FFileExit:=NewMenuItem(SMenuFileExit,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_Q,[amcontrol]),@FileExitClick,Nil);
139  FFile:=NewSubMenu(SmenuFile,'','',[FFileNew,FFileOpen,FFileSave,FFileSaveAs,NewLine,FFileExit]);
140  FEditCut:=NewMenuItem(SMenuEditCut,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_X,[amcontrol]),@EditCCPClick,Nil);
141  FEditCopy:=NewMenuItem(SMenuEditCopy,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_C,[amcontrol]),@EditCCPClick,Nil);
142  FEditPaste:=NewMenuItem(SMenuEditPaste,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_V,[amcontrol]),@EditCCPClick,Nil);
143  FEdit:=NewSubMenu(SMenuEdit,'','',[FEditCut,FEditCopy,FEditPaste]);
144  FProjectCompile:=NewMenuItem(SMenuProjectCompile,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_F9,[amcontrol]),@ProjectCompileClick,Nil);
145  FProjectOptions:=NewMenuItem(SMenuProjectOptions,'','', MakeAccelKeyDef(Self,FaccelGroup,GDK_F11,[amcontrol,amshift]),@ProjectOptionsClick,Nil);
146  FProject := NewSubMenu(SMenuProject,'','',[FProjectCompile,FProjectoptions]);
147  FHelpAbout:=NewMenuItem(SMenuHelpAbout ,'','',@HelpAboutClick,Nil);
148  FHelp := NewSubMenu(SMenuHelp,'','',[FHelpAbout]);
149  FMainMenu:=NewMenuBar([FFile,FEdit,FProject,FHelp]);
150  FEditor:=TFPgtkScrollText.Create;
151  Feditor.TheText.ConnectChanged(@EditorChanged,Nil);
152  // Compiling messages
153  FMsgLabel:=TFPgtkLabel.Create(SCompilerMessages);
154  FMsgList:=TFPgtkScrollList.Create;
155  FMsgVBox:=TFPgtkVbox.Create;
156  FMsgVBox.PackStart(FMsgLabel,False,False,0);
157  FMsgVBox.PackStart(FMsgList,True,True,0);
158  FVPaned:=TFPgtkVPaned.Create;
159  FVPaned.Add1(FEditor);
160  FVPaned.Add2(FMsgVBox);
161  FVPaned.Position:=350;
162  FVBox.PackStart(FmainMenu,False,False,0);
163  FVBox.PackStart(FVPaned,true, true, 0);
164  ConnectDeleteEvent(@OnDeleteEvent,Nil);
165  Add(FVBox);
166  SetUSize(640,480);
167  SetCaption;
168  FEditor.TheText.GrabFocus;
169end;
170
171{ ---------------------------------------------------------------------
172    Callback events
173  ---------------------------------------------------------------------}
174
175
176Procedure TMainForm.FileNewClick(Sender : TFPGtkObject; Data : Pointer);
177
178begin
179  If CheckSaved then
180    NewFile;
181end;
182
183
184Function TMainForm.OnDeleteEvent(Sender:TFPgtkWidget; Event:PGdkEvent; data:pointer): boolean;
185
186begin
187  Result:=Not CheckSaved;
188end;
189
190
191Procedure TMainForm.FileSaveClick(Sender : TFPgtkObject; Data : Pointer);
192
193begin
194  If (FFileName='') then
195    FileSaveAsClick(Sender,Data)
196  else
197    SaveToFile(FFileName);
198end;
199
200
201Procedure TMainForm.FileSaveAsClick(Sender : TFPGtkObject; Data : Pointer);
202
203Var
204  FN : String;
205
206begin
207  FN:=GetFileName(SSaveFile);
208  If (FN<>'') then
209    SavetoFile(FN);
210end;
211
212
213Procedure TMainForm.FileOpenClick(Sender : TFPGtkObject; Data : Pointer);
214
215Var
216  FN : String;
217
218begin
219  FN:=GetFileName(SOpenFile);
220  If (FN<>'') then
221    LoadFromFile(FN);
222end;
223
224
225Procedure TMainForm.EditorChanged(Sender : TFPgtkObject; Data : Pointer);
226
227begin
228  If FModified<>True then
229    begin
230    FModified:=True;
231    SetCaption;
232    end;
233end;
234
235Procedure TMainForm.EditCCPClick(Sender : TFPGtkObject; Data : Pointer);
236
237begin
238  If Sender=FEditCut then
239    EditCut
240  else if Sender=FEditCopy then
241    EditCopy
242  else
243    EditPaste;
244end;
245
246Procedure TMainForm.FileExitClick(Sender : TFPgtkObject;  Data : Pointer);
247
248begin
249  If CheckSaved then
250    Close;
251end;
252
253
254Procedure TMainForm.HelpAboutClick(Sender : TFPGtkObject; Data : Pointer);
255
256begin
257  With TAboutForm.Create do
258    Execute(Nil,Nil,Nil);
259end;
260
261Procedure TMainForm.ProjectCompileClick(Sender : TFPGtkObject; Data : Pointer);
262
263begin
264  Compile;
265end;
266
267Procedure TMainForm.ProjectOptionsClick(Sender : TFPGtkObject; Data : Pointer);
268
269begin
270  SetOptions;
271end;
272
273Procedure TMainform.DoError(Sender : TObject; Msg : String);
274
275begin
276  FMsgList.list.Add(TFPGtkListItem.CreateWithLabel(Msg));
277end;
278
279Procedure TMainform.DoVerbose(Sender : TObject; Msg : String);
280
281begin
282  FMsgList.list.Add(TFPGtkListItem.CreateWithLabel(Msg));
283end;
284
285
286{ ---------------------------------------------------------------------
287    Auxiliary methods
288  ---------------------------------------------------------------------}
289
290Procedure TMainForm.SetCaption;
291
292Var
293  S : String;
294
295begin
296  S:=SCaption;
297  If (FFileName<>'') then
298    S:=S+' : '+ExtractFileName(FFileName);
299  If FModified then
300    S:=S+' '+SModified;
301  Title:=S;
302end;
303
304Function TMainForm.CheckSaved : Boolean;
305
306begin
307  Result:=Not FModified;
308  If Not Result then
309    Case MessageDlg(SFileModified,mtInformation,mbYesNoCancel,0) of
310      mrYes : begin
311              FileSaveClick(Self,Nil);
312              Result:=True;
313              end;
314      mrNo  : Result:=True;
315      mrCancel : Result:=False;
316    end;
317end;
318
319Function TMainForm.GetFileName(ATitle : String) : String;
320
321var
322  FS : TFPgtkFileSelection;
323
324begin
325  Result:='';
326  FS := TFPgtkFileSelection.Create (gtk_window_dialog);
327  with FS do
328    begin
329    Title:=ATitle;
330    OKButton.ConnectClicked (@(CloseWithResult), inttopointer(drOk));
331    CancelButton.ConnectClicked (@(CloseWindow), nil);
332    if Not execute (nil, @Result, @DialogSetFilename) = drOk then
333      Result:='';
334    end;
335end;
336
337Procedure TMainForm.DialogSetFilename(Sender : TFPGtkWindow;Data : Pointer; Action : Integer;Initiator : TFPGtkObject);
338
339type
340  PString = ^AnsiString;
341
342begin
343  PString(Data)^:=(Sender as TFPgtkFileSelection).Filename;
344end;
345
346
347{ ---------------------------------------------------------------------
348    Public methods
349  ---------------------------------------------------------------------}
350
351
352Procedure TMainForm.LoadFromFile(FN : String);
353
354Var
355  S : TStringList;
356
357begin
358  S:=TStringList.Create;
359  try
360    S.LoadFromFile(FN);
361    FEditor.TheText.Text:=S.Text;
362    FModified:=False;
363  Finally
364    S.Free;
365  end;
366  FFileName:=FN;
367  SetCaption;
368end;
369
370
371Procedure TMainForm.SaveToFile(FN : String);
372
373begin
374  FFileName:=FN;
375  FEditor.TheText.Lines.SaveToFile(FN);
376  FModified:=False;
377  SetCaption;
378end;
379
380
381Procedure TMainForm.EditCut;
382
383begin
384  FEditor.TheText.CutClipBoard;
385end;
386
387
388Procedure TMainForm.EditCopy;
389
390begin
391  FEditor.TheText.CopyCLipBoard;
392end;
393
394
395Procedure TMainForm.EditPaste;
396
397begin
398  FEditor.TheText.PasteClipBoard;
399end;
400
401
402Procedure TMainForm.NewFile;
403
404begin
405  Feditor.TheText.Clear;
406end;
407
408Procedure TMainForm.Compile;
409
410Var
411  M,P,R,I : TStream;
412  S,MsgFileName : String;
413
414  Procedure SetupStreams;
415
416  begin
417    I:=TFileStream.Create(FFileName,fmOpenRead);
418    If FCreatePas then
419      P:=TFileStream.Create(ChangeFileExt(FFileName,'.pp'),fmCreate);
420    If FCreateMsg then
421      begin
422      MsgFileName:=ChangeFileExt(FFileName,'.msg');
423      M:=TFileStream.Create(MsgFileName,fmCreate);
424      end;
425    If FCreateRC then
426      R:=TFileStream.Create(ChangeFileExt(FFileName,'.rc'),fmCreate);
427  end;
428
429  Procedure CloseStreams;
430
431  begin
432    M.Free;
433    P.Free;
434    R.Free;
435    I.Free;
436  end;
437
438begin
439  FileSaveClick(Self,Nil);
440  If (FUnitName='') then
441    FUnitName:=ExtractFileName(FFileName);
442  FMsgList.List.ClearAll;
443  Try
444    SetupStreams;
445    Try
446    With TMessageCompiler.Create do
447      Try
448        Msg:=M;
449        MC:=I;
450        RC:=R;
451        Pas:=P;
452        OnError:=@DoError;
453        If FVerbose then
454          OnVerbose:=@DoVerbose;
455        UnitName:=FUnitName;
456        MessageFileName:=MsgFileName;
457        EscapeNeeded:=FEscapePath;
458        If (FLanguageID<>-1) then
459          LocaleID:=FLanguageID;
460        If (FSubLanguageID<>-1) then
461          SubLocaleID:=FSubLanguageID;
462        If Compile then
463          DoVerbose(Nil,SSuccesCompiling)
464        else
465          begin
466          S:=Format(SErrsCompiling,[Errors]);
467          DoVerbose(Nil,S);
468          MessageDlg(S,mtError,[mbOK],0);
469          end;
470      Finally
471        Free;
472      end;
473    Finally
474      CloseStreams;
475    end;
476  except
477    On E : Exception do
478      MessageDlg(SErrUnexpected,[E.Message],mtError,[mbOK],0);
479  end;
480end;
481
482Procedure TMainForm.SaveOptions(Sender : TFPGtkWindow;Data : Pointer; Action : Integer;Initiator : TFPGtkObject);
483
484begin
485  With TOptionsForm(Data) do
486    begin
487    FUnitName:=UnitName;
488    FLanguageID:=StrToIntDef(Trim(Locale),0);
489    FSubLanguageID:=StrToIntDef(Trim(SubLocale),0);
490    FVerbose:=Verbose;
491    FCreateMsg:=CreateMsgFile;
492    FCreatePas:=CreatePasFile;
493    FCreateRC:=CreateRCFile;
494    FEscapePath:=EscapePath;
495    end;
496end;
497
498
499Procedure TMainForm.SetOptions;
500
501Var
502  F : TOptionsForm;
503
504begin
505  If (FUnitName='') and (FFileName<>'') then
506    FUnitName:=ExtractFileName(FFileName);
507  F:=TOptionsForm.Create;
508  With F do
509    begin
510    UnitName:=FUnitName;
511    Locale:=IntToStr(FLanguageID);
512    SubLocale:=IntToStr(FSubLanguageID);
513    Verbose:=Fverbose;
514    CreateMsgFile:=FCreateMsg;
515    CreatePasFile:=FCreatePas;
516    CreateRCFile:=FCreateRC;
517    EscapePath:=FEscapePath;
518    Execute(Nil,F,@SaveOptions);
519    end;
520end;
521
522
523end.
524