fixes for debugging lazarus

git-svn-id: trunk@4296 -

components/codetools/basiccodetools.pas

@@ -2084,8 +2084,6 @@ function TrimCodeSpace(const ACode: string): string;
 // space is combined to one char
 // space which is not needed is removed.
 // space is only needed between two words or between 2-char operators
-const
-  NonSpaceSymbols = [',',';','(',')','[',']'];
 var CodePos, ResultPos, CodeLen, SpaceEndPos: integer;
   c1, c2: char;
 begin

components/codetools/eventcodetool.pas

@@ -97,15 +97,13 @@ type
         Attr: TProcHeadAttributes): string;
   end;
 
-
-implementation
-
 const
   MethodKindAsString: array[TMethodKind] of shortstring = (
         'procedure', 'function', 'constructor', 'destructor',
         'class procedure', 'class function'
       );
 
+implementation
 
 { TEventsCodeTool }
 

components/codetools/fileprocs.pas

@@ -485,23 +485,6 @@ end;
 
 function SearchFileInPath(const Filename, BasePath, SearchPath,
   Delimiter: string; SearchLoUpCase: boolean): string;
-  
-  function FileDoesExists(const AFilename: string): boolean;
-  var s: string;
-  begin
-    s:=ExpandFilename(TrimFilename(AFilename));
-    Result:=FileExists(s);
-    if Result then begin
-      SearchFileInPath:=s;
-      exit;
-    end;
-    {$IFNDEF Win32}
-    if SearchLoUpCase then begin
-
-    end;
-    {$ENDIF}
-  end;
-  
 var
   p, StartPos, l: integer;
   CurPath, Base: string;

components/codetools/linkscanner.pas

@@ -1484,10 +1484,6 @@ function TLinkScanner.GuessMisplacedIfdefEndif(StartCursorPos: integer;
     TDirectiveType = (dtUnknown, dtIf, dtIfDef, dtIfNDef, dtIfOpt,
                       dtElse, dtEndif);
     
-  const
-    DirectiveTypeLen: array[TDirectiveType] of integer = (0,2,5,6,5,4,5);
-    
-    
   function FindNextToken(const ASrc: string; var AToken: TToken): boolean;
   var
     ASrcLen: integer;

ide/buildlazdialog.pas

@@ -214,6 +214,7 @@ function SaveIDEMakeOptions(Options: TBuildLazarusOptions;
   Macros: TTransferMacroList;
   const PackageOptions: string; Flags: TBuildLazarusFlags): TModalResult;
 function GetMakeIDEConfigFilename: string;
+function GetTranslatedMakeModes(MakeMode: TMakeMode): string;
 
 
 implementation

ide/codetoolsoptions.pas

@@ -235,6 +235,7 @@ var CodeToolsOpts: TCodeToolsOptions;
 
 function ShowCodeToolsOptions(Options: TCodeToolsOptions;
   OnGetSynEditSettings: TNotifyEvent): TModalResult;
+function GetTranslatedAtomTypes(a: TAtomType): string;
 
 
 implementation

ide/lazarus.pp

@@ -62,12 +62,14 @@ begin
   TMainIDE.ParseCmdLineOptions;
 
   // Show splashform
-  SplashForm := TSplashForm.Create(nil);
-  with SplashForm do begin
-    Show;
-    Paint;
+  if ShowSplashScreen then begin
+    SplashForm := TSplashForm.Create(nil);
+    with SplashForm do begin
+      Show;
+      Paint;
+    end;
+    Application.ProcessMessages; // process splash paint message
   end;
-  Application.ProcessMessages; // process splash paint message
 
   Application.CreateForm(TMainIDE, MainIDE);
   MainIDE.CreateOftenUsedForms;
@@ -75,14 +77,17 @@ begin
   CheckHeapWrtMemCnt('lazarus.pp: TMainIDE created');
   {$ENDIF}
 
-  SplashForm.StartTimer;
+  if (SplashForm<>nil) then
+    SplashForm.StartTimer;
   try
     Application.Run;
   except
     writeln('lazarus.pp - unhandled exception');
   end;
-  SplashForm.Free;
-  SplashForm:=nil;
+  if (SplashForm<>nil) then begin
+    SplashForm.Free;
+    SplashForm:=nil;
+  end;
 
   writeln('LAZARUS END - cleaning up ...');
 
@@ -94,6 +99,9 @@ end.
 
 {
   $Log$
+  Revision 1.46  2003/06/23 09:42:09  mattias
+  fixes for debugging lazarus
+
   Revision 1.45  2003/05/30 12:41:46  mattias
   added checks and texts for mixing gtk1 and gtk2
 

ide/lazarusidestrconsts.pas

@@ -57,6 +57,7 @@ resourcestring
   lisIDEOptions = 'IDE Options:';
   lisCmdLineLCLInterfaceSpecificOptions =
     'LCL Interface specific options:';
+  lisDoNotShowSplashScreen = 'Do not show splash screen';
   lissecondaryConfigDirectoryWhereLazarusSearchesFor =
     '                      secondary config '
     +'directory, where Lazarus searches for config template files. Default is ';

lcl/forms.pp

@@ -643,7 +643,8 @@ type
   TApplicationFlag = (
     AppWaiting,
     AppIdleEndSent,
-    AppHandlingException
+    AppHandlingException,
+    AppNoExceptionMessages
     );
   TApplicationFlags = set of TApplicationFlag;
 
@@ -719,6 +720,7 @@ type
     function HelpContext(Context: THelpContext): Boolean;
     function HelpJump(const JumpID: string): Boolean;
     function HelpKeyword(const Keyword: String): Boolean;
+    procedure HideAllFormsWithStayOnTop;
     function IsWaiting: boolean;
     procedure CancelHint;
     procedure HideHint;
@@ -878,6 +880,7 @@ procedure FreeInterfaceObject;
 
 procedure Register;
 
+
 implementation
 
 
@@ -887,6 +890,8 @@ uses
 var
   FocusMessages: Boolean;
   FocusCount: Integer;
+  HandlingException: boolean;
+  HaltingProgram: boolean;
 
 procedure Register;
 begin
@@ -905,17 +910,20 @@ end;
 
 
 //------------------------------------------------------------------------------
-procedure ExceptionOccurred(Sender : TObject; Addr,Frame : Pointer);
-var
-  Mess : String;
+procedure ExceptionOccurred(Sender: TObject; Addr,Frame: Pointer);
 Begin
-  Writeln('[FORMS.PP] ExceptionOccurred Procedure');
-  Mess := Format(rsErrorOccurredInAtAddressFrame, [Sender.ClassName, #13#10,
-    HexStr(Cardinal(Addr), 8), #13#10, HexStr(Cardinal(Frame), 8)]);
+  Writeln('[FORMS.PP] ExceptionOccurred ');
+  if HaltingProgram or HandlingException then Halt;
+  HandlingException:=true;
+  if Sender<>nil then begin
+    writeln('  Sender=',Sender.ClassName);
+    if Sender is Exception then
+      writeln('  Exception=',Exception(Sender).Message);
+  end else
+    writeln('  Sender=nil');
   if Application<>nil then
-    Application.MessageBox(PChar(Mess), PChar(rsException), mb_IconError+mb_Ok)
-  else
-    writeln(Mess);
+    Application.HandleException(Sender);
+  HandlingException:=false;
 end;
 
 //------------------------------------------------------------------------------
@@ -1340,6 +1348,8 @@ end;
 initialization
   FocusCount := 0;
   Focusmessages := True;
+  HandlingException := false;
+  HaltingProgram := false;
   HintWindowClass := THintWindow;
   LCLProc.OwnerFormDesignerModifiedProc:=@IfOwnerIsFormThenDesignerModified;
   Screen:= TScreen.Create(nil);

lcl/grids.pas

@@ -685,7 +685,8 @@ DeleteObject(Pen);
 ReleaseDC(Handle, Dc);
 FMoveLast:=P;
 }
-Function RndStr:String;
+
+{Function RndStr:String;
 Var
   i: Integer;
 Begin
@@ -693,16 +694,15 @@ Begin
   For i:=1 to 10 do begin
     Result:=Result+ Char(Ord('A')+Random(20));
   End;
-End;
+End;}
 Function PointIgual(Const P1,P2: TPoint): Boolean;
 begin
   result:=(P1.X=P2.X)And(P1.Y=P2.Y);
 End;
-Function RectIgual(Const R1,R2: TRect): Boolean;
+{Function RectIgual(Const R1,R2: TRect): Boolean;
 begin
   Result:=CompareMem(@R1,@R2, SizeOf(R1));
-
-End;
+End;}
 Function Min(Const I,J: Integer): Integer;
 begin
   If I<J then Result:=I
@@ -750,7 +750,7 @@ begin
   End;
 end;
 
-procedure DebugAttr(Msg: String; Attr: TCellAttr);
+{procedure DebugAttr(Msg: String; Attr: TCellAttr);
 Begin
   With Attr do begin
     WriteLn(Msg);
@@ -766,7 +766,7 @@ Begin
       WriteLn('TextStyle.SystemFont',systemFont);
     End;
   End;
-End;
+End;}
 
 Function LoadCellAttrFromXMLPath(Cfg: TXMLConfig; Path: String): TCellAttr;
 begin
@@ -1228,7 +1228,7 @@ begin
       End;
       
       If HorzScrollBar.Range>ClientWidth Then
-        HScrDiv:= (ColCount-FixedRows-1)/(HorzScrollBar.range-ClientWidth);
+        HScrDiv:= Double(ColCount-FixedRows-1)/(HorzScrollBar.range-ClientWidth);
 
       {$Ifdef dbgScroll}
       Writeln('TotWidth=',GridWidth,'ClientWidth=',ClientWidth,' Horz Range=',HorzScrolLBar.Range);
@@ -1248,7 +1248,7 @@ begin
       End;
 
       If VertScrolLBar.Range>ClientHeight Then
-        VScrDiv:= (RowCount-FixedRows-1)/(VertScrollBar.Range-ClientHeight);
+        VScrDiv:= Double(RowCount-FixedRows-1)/(VertScrollBar.Range-ClientHeight);
 
       {$Ifdef dbgScroll}
       Writeln('TotHeight=',GridHeight,'ClientHeight=',ClientHeight,' Vert Range=',VertScrolLBar.Range);

lcl/include/application.inc

@@ -89,9 +89,7 @@ begin
   ApplicationActionComponent:=Self;
 
   inherited Create(AOwner);
-  // MG: if you prefer message boxes instead of terminal error messages uncomment
-  // the following line
-  //ExceptProc := @ExceptionOccurred;
+  ExceptProc := @ExceptionOccurred;
 end;
 
 {------------------------------------------------------------------------------}
@@ -99,8 +97,11 @@ end;
 {------------------------------------------------------------------------------}
 destructor TApplication.Destroy;
 begin
+  // shutting down
   CancelHint;
   ShowHint := False;
+  
+  // destroying
   ApplicationActionComponent:=nil;
   FreeThenNil(FIcon);
   FreeThenNil(FList);
@@ -646,16 +647,26 @@ end;
  ------------------------------------------------------------------------------}
 procedure TApplication.HandleException(Sender: TObject);
 begin
+  if Self=nil then exit;
   if AppHandlingException in FFlags then begin
     // there was an exception during showing the exception -> break the circle
     writeln('TApplication.HandleException: ',
-      'there was a second exception during showing the first exception');
+      'there was another exception during showing the first exception');
     exit;
   end;
   Include(FFlags,AppHandlingException);
-  if GetCapture <> 0 then SendMessage(GetCapture, LM_CANCELMODE, 0, 0);
+  // before we do anything, write it down
   if ExceptObject is Exception then begin
     writeln('TApplication.HandleException ',Exception(ExceptObject).Message);
+  end;
+  // release capture and hide all forms with stay on top, so that
+  // a message can be shown
+  if GetCapture <> 0 then SendMessage(GetCapture, LM_CANCELMODE, 0, 0);
+  HideAllFormsWithStayOnTop;
+  // handle the exception
+  if ExceptObject is Exception then begin
+    writeln('TApplication.HandleException Handling ',
+            '"',Exception(ExceptObject).Message,'" ...');
     if not (ExceptObject is EAbort) then
       if Assigned(FOnException) then
         FOnException(Sender, Exception(ExceptObject))
@@ -723,6 +734,24 @@ begin
     Result := false;
 end;
 
+{------------------------------------------------------------------------------
+  procedure TApplication.HideAllFormsWithStayOnTop;
+------------------------------------------------------------------------------}
+procedure TApplication.HideAllFormsWithStayOnTop;
+var
+  i: Integer;
+  AForm: TCustomForm;
+begin
+  if (Screen=nil) then exit;
+  for i:=0 to Screen.CustomFormCount-1 do begin
+    AForm:=Screen.CustomForms[i];
+    if AForm.FormStyle=fsStayOnTop then begin
+      writeln('TApplication.HideAllFormsWithStayOnTop ',AForm.Name,':',AForm.ClassName);
+      AForm.Hide;
+    end;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   function TApplication.IsWaiting: boolean;
 ------------------------------------------------------------------------------}
@@ -757,8 +786,8 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-       TApplication Run
-       MainForm is loaded and control is passed to event processor.
+  TApplication Run
+  MainForm is loaded and control is passed to event processor.
 ------------------------------------------------------------------------------}
 procedure TApplication.Run;
 begin
@@ -841,12 +870,20 @@ end;
 procedure TApplication.ShowException(E: Exception);
 var
   Msg: string;
+  MsgResult: Integer;
 begin
+  if AppNoExceptionMessages in FFlags then exit;
   Msg := E.Message;
-  if (Msg <> '') and (Msg[length(Msg)] > '.') then Msg := Msg + '.';
-  if (not FTerminate) and (Self<>nil) then
-    MessageBox(PChar(Msg), PChar(GetTitle), MB_OK + MB_ICONERROR)
-  else
+  if (Msg <> '') and (Msg[length(Msg)] <> '.') then Msg := Msg + '.';
+  if (not FTerminate) and (Self<>nil) then begin
+    MsgResult:=MessageBox(PChar(Msg),PChar(GetTitle),
+                          MB_OKCANCEL + MB_ICONERROR);
+    if MsgResult<>mrOk then begin
+      Include(FFlags,AppNoExceptionMessages);
+      HaltingProgram:=true;
+      Halt;
+    end;
+  end else
     SysUtils.ShowException(ExceptObject, ExceptAddr);
 end;
 
@@ -1027,6 +1064,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.57  2003/06/23 09:42:09  mattias
+  fixes for debugging lazarus
+
   Revision 1.56  2003/06/02 21:37:30  mattias
   fixed debugger stop
 

lcl/include/customform.inc

@@ -315,8 +315,6 @@ end;
   ShowWindow event handler.
  ------------------------------------------------------------------------------}
 procedure TCustomForm.WMShowWindow(var message: TLMShowWindow);
-const
-  SHOW_TEXT: array[Boolean] of string = ('Hide', 'Show');
 begin
   {$IFDEF VerboseFocus}
   write('TCustomForm.WMShowWindow A ',Name,':',ClassName,' fsShowing=',fsShowing in FFormState,' Msg.Show=',Message.Show);
@@ -1434,6 +1432,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.106  2003/06/23 09:42:09  mattias
+  fixes for debugging lazarus
+
   Revision 1.105  2003/06/16 23:12:59  mattias
   fixed TCustomForm.ShowModal when Self=nil
 

lcl/include/customupdown.inc

@@ -128,7 +128,7 @@ begin
   aw := width div 2;
 
   if (FUpDown.Orientation = udHorizontal) then begin
-    tmp := (ah+1)/2;
+    tmp := double(ah+1)/2;
     if (tmp > aw) then begin
       ah := 2*aw - 1;
       aw := (ah+1) div 2;
@@ -141,7 +141,7 @@ begin
     ah := max(ah, 5);
   end
   else begin
-    tmp := (aw+1)/2;
+    tmp := double(aw+1)/2;
 
     if (tmp > ah) then begin
       aw := 2*ah - 1;

lcl/include/filectrl.inc

@@ -808,23 +808,6 @@ end;
  ------------------------------------------------------------------------------}
 function SearchFileInPath(const Filename, BasePath, SearchPath,
   Delimiter: string; Flags: TSearchFileInPathFlags): string;
-
-  function FileDoesExists(const AFilename: string): boolean;
-  var s: string;
-  begin
-    s:=ExpandFilename(TrimFilename(AFilename));
-    Result:=FileExists(s);
-    if Result then begin
-      SearchFileInPath:=s;
-      exit;
-    end;
-    {$IFNDEF Win32}
-    if sffSearchLoUpCase in Flags then begin
-
-    end;
-    {$ENDIF}
-  end;
-
 var
   p, StartPos, l: integer;
   CurPath, Base: string;
@@ -894,6 +877,9 @@ end;
 
 {
   $Log$
+  Revision 1.26  2003/06/23 09:42:09  mattias
+  fixes for debugging lazarus
+
   Revision 1.25  2003/05/28 21:16:47  mattias
   added a help and a more button tot he package editor
 

lcl/include/promptdialog.inc

@@ -24,12 +24,12 @@ const
     bkOk, bkCancel, bkHelp, bkYes, bkNo, bkClose, bkAbort, bkRetry,
     bkIgnore, bkAll, bkCustom, bkCustom);
 
-  DialogButtonText : Array[idButtonOK..idButtonNoToAll] of String = (
+  {DialogButtonText : Array[idButtonOK..idButtonNoToAll] of String = (
     rsmbOk, rsmbCancel, rsmbHelp, rsmbYes, rsmbNo, rsmbClose, rsmbAbort,
-    rsmbRetry, rsmbIgnore, rsmbAll, rsmbYesToAll, rsmbNoToAll);
+    rsmbRetry, rsmbIgnore, rsmbAll, rsmbYesToAll, rsmbNoToAll);}
 
-  DialogCaption : Array[idDialogWarning..idDialogConfirm] of String = (
-    rsMtWarning, rsMtError, rsMtInformation, rsMtConfirmation);
+  {DialogCaption : Array[idDialogWarning..idDialogConfirm] of String = (
+    rsMtWarning, rsMtError, rsMtInformation, rsMtConfirmation);}
 
 type
   TPromptDialog = class(TForm)
@@ -379,6 +379,9 @@ end;
 
 {
    $Log$
+   Revision 1.5  2003/06/23 09:42:09  mattias
+   fixes for debugging lazarus
+
    Revision 1.4  2003/03/25 10:45:41  mattias
    reduced focus handling and improved focus setting
 

lcl/include/toolbar.inc

@@ -1287,13 +1287,6 @@ begin
 end;
 
 
-function ToolMenuGetMsgHook(Code: Integer; WParam: Longint;
-  var Msg: TMsg): Longint; stdcall;
-Begin
-  // ToDo
-  Result:=0;
-end;
-
 procedure InitToolMenuHooks;
 begin
 end;
@@ -1302,14 +1295,6 @@ procedure ReleaseToolMenuHooks;
 begin
 end;
 
-
-function ToolMenuKeyMsgHook(Code: Integer; WParam: Longint;
-  var Msg: TMsg): Longint; stdcall;
-begin
-  // ToDo
-  Result:=0;
-end;
-
 procedure InitToolMenuKeyHooks;
 begin
 end;
@@ -1506,6 +1491,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.11  2003/06/23 09:42:09  mattias
+  fixes for debugging lazarus
+
   Revision 1.10  2002/12/29 11:10:45  mattias
   fixed form FActive, cleanups
 

lcl/lresources.pp

@@ -296,7 +296,6 @@ end;
 
 procedure TLResourceList.Add(const Name,ValueType: AnsiString;
   Values: array of string);
-const ProcName = 'TLResourceList.Add';
 var
   NewLResource: TLResource;
   i, TotalLen, ValueCount, p: integer;
@@ -513,11 +512,11 @@ begin
   ReadError(rsInvalidPropertyValue);
 end;
 
-procedure PropertyNotFound(const Name: string);
+{procedure PropertyNotFound(const Name: string);
 begin
   ReadError(Format(rsPropertyDoesNotExist,[Name]));
 end;
-
+}
 procedure TDelphiReader.SkipBytes(Count: Integer);
 begin
   FStream.Position:=FStream.Position+Count;

lcl/menus.pp

@@ -314,12 +314,12 @@ implementation
 var
   CommandPool: TBits;
 
-function UniqueCommand: Word;
+{function UniqueCommand: Word;
 begin
   Result := CommandPool.OpenBit;
   CommandPool[Result] := True;
 end;
-
+}
 function ShortCutToText(ShortCut: TShortCut): string;
 begin
   Result:=ShortCutToShortCutText(ShortCut);
@@ -374,6 +374,9 @@ end.
 
 {
   $Log$
+  Revision 1.45  2003/06/23 09:42:09  mattias
+  fixes for debugging lazarus
+
   Revision 1.44  2003/06/09 09:20:27  mattias
   removed menubar.inc
 

lcl/stdctrls.pp

@@ -966,10 +966,6 @@ implementation
 
 
 type
-  TSelection = record
-    Startpos, EndPos: Integer;
-  end;
-
   TMemoStrings = class(TStrings)
   private
     FMemo: TCustomMemo;
@@ -1463,6 +1459,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.99  2003/06/23 09:42:09  mattias
+  fixes for debugging lazarus
+
   Revision 1.98  2003/06/16 22:47:19  mattias
   fixed keeping TForm.Visible=false
 

packager/packagelinks.pas

@@ -123,9 +123,6 @@ var
 implementation
 
 
-const
-  UserPkgLinkFile = 'packagefiles.xml';
-
 function ComparePackageLinks(Data1, Data2: Pointer): integer;
 var
   Link1: TPackageLink;