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