added package prettymessages - an IDE add-on to reduce FPC hints

git-svn-id: trunk@11002 -

.gitattributes

@@ -333,6 +333,14 @@ components/prettyformat/pfidesource.pas svneol=native#text/plain
 components/prettyformat/prettyformat.lpk svneol=native#text/plain
 components/prettyformat/prettyformat.pas svneol=native#text/plain
 components/prettyformat/ptopu.pp svneol=native#text/plain
+components/prettymessages/README.txt svneol=native#text/plain
+components/prettymessages/hidefpchints.pas svneol=native#text/plain
+components/prettymessages/prettymessages.lpk svneol=native#text/plain
+components/prettymessages/prettymessages.pas svneol=native#text/plain
+components/prettymessages/prettymsgoptions.pas svneol=native#text/plain
+components/prettymessages/prettymsgoptionsdlg.lfm svneol=native#text/plain
+components/prettymessages/prettymsgoptionsdlg.lrs svneol=native#text/plain
+components/prettymessages/prettymsgoptionsdlg.pas svneol=native#text/plain
 components/printers/Makefile svneol=native#text/plain
 components/printers/Makefile.fpc svneol=native#text/plain
 components/printers/design/Makefile svneol=native#text/plain
@@ -2843,6 +2851,7 @@ packager/globallinks/lazopenglcontext-0.lpl svneol=native#text/plain
 packager/globallinks/macosfiles-0.lpl svneol=native#text/plain
 packager/globallinks/popupnotifierlaz-0.lpl svneol=native#text/plain
 packager/globallinks/prettyformat-0.lpl svneol=native#text/plain
+packager/globallinks/prettymessages-0.lpl svneol=native#text/plain
 packager/globallinks/printer4lazarus-0.5.lpl svneol=native#text/plain
 packager/globallinks/printers4lazide-0.lpl svneol=native#text/plain
 packager/globallinks/projtemplates-0.lpl svneol=native#text/plain

components/codetools/basiccodetools.pas

@@ -54,7 +54,7 @@ function FindNextIncludeDirective(const ASource: string;
     out FilenameStartPos, FileNameEndPos,
     CommentStartPos, CommentEndPos: integer): integer;
 function FindNextIDEDirective(const ASource: string; StartPos: integer;
-    NestedComments: boolean): integer;
+    NestedComments: boolean; EndPos: integer = 0): integer;
 function CleanCodeFromComments(const DirtyCode: string;
     NestedComments: boolean): string;
 function FindMainUnitHint(const ASource: string; var Filename: string): boolean;
@@ -2400,11 +2400,13 @@ begin
 end;
 
 function FindNextIDEDirective(const ASource: string; StartPos: integer;
-  NestedComments: boolean): integer;
+  NestedComments: boolean; EndPos: integer): integer;
 var
   MaxPos: integer;
 begin
   MaxPos:=length(ASource);
+  if (EndPos>0) and (EndPos<=MaxPos) then
+    MaxPos:=EndPos-1;
   Result:=StartPos;
   while (Result<=MaxPos) do begin
     case ASource[Result] of
@@ -2453,7 +2455,7 @@ begin
     end;
 
   end;
-  if Result>MaxPos+1 then Result:=MaxPos+1;
+  Result:=-1;
 end;
 
 function CleanCodeFromComments(const DirtyCode: string;

components/codetools/sourcelog.pas

@@ -111,7 +111,7 @@ type
     Data: Pointer;
     function LineCount: integer;
     function GetLine(Index: integer): string;
-    procedure GetLineRange(Index: integer; var LineRange: TLineRange);
+    procedure GetLineRange(Index: integer; out LineRange: TLineRange);
     property Items[Index: integer]: TSourceLogEntry
        read GetItems write SetItems; default;
     function Count: integer; // # Items
@@ -286,7 +286,7 @@ begin
     Result:='';
 end;
 
-procedure TSourceLog.GetLineRange(Index: integer; var LineRange: TLineRange);
+procedure TSourceLog.GetLineRange(Index: integer; out LineRange: TLineRange);
 begin
   BuildLineRanges;
   LineRange:=FLineRanges[Index];

components/codetools/stdcodetools.pas

@@ -3396,7 +3396,7 @@ begin
   EndPos:=1;
   repeat
     StartPos:=FindNextIDEDirective(Src,EndPos,Scanner.NestedComments);
-    if StartPos>SrcLen then break;
+    if StartPos<1 then break;
     EndPos:=FindCommentEnd(Src,StartPos,Scanner.NestedComments);
     DirectiveList.Add(copy(Src,StartPos,EndPos-StartPos));
     if EndPos>SrcLen then break;
@@ -3421,7 +3421,7 @@ begin
 
   // find first old IDE directive
   InsertPos:=FindNextIDEDirective(Src,1,Scanner.NestedComments);
-  if InsertPos>SrcLen then InsertPos:=0;
+  if InsertPos<1 then InsertPos:=0;
 
   // remove all old IDE directives
   if InsertPos>=1 then
@@ -3431,7 +3431,7 @@ begin
   repeat
     // find next IDE directive
     StartPos:=FindNextIDEDirective(Src,EndPos,Scanner.NestedComments);
-    if StartPos>SrcLen then break;
+    if StartPos<1 then break;
     EndPos:=FindCommentEnd(Src,StartPos,Scanner.NestedComments);
     // remove also space in front of directive
     while (StartPos>1) and (Src[StartPos-1] in [' ',#9]) do dec(StartPos);

components/opengl/glgtk2glxcontext.pas

@@ -66,7 +66,6 @@ var
 begin
   if (not AWinControl.HandleAllocated) then exit;
   Widget:=PGtkWidget(AWinControl.Handle);
-  if not GTK_WIDGET_MAPPED(Widget) then exit;
   Info:=PLOpenGLInfo(gtk_object_get_data(PGtkObject(Widget),'LOpenGLInfo'));
 
   DebugLn(['InternalResizeWnd ',dbgs(AWinControl.BoundsRect)]);

components/opengl/glgtkglxcontext.pas

@@ -25,7 +25,7 @@ uses
   Classes, SysUtils, LCLProc, LCLType, X, XUtil, XLib, gl, InterfaceBase,
   WSLCLClasses, GtkWSControls,
   {$IFDEF LCLGTK2}
-  gdk2x, glib2, gdk2, gtk2, Gtk2Int,
+  GtkDef, gdk2x, glib2, gdk2, gtk2, Gtk2Int,
   {$ENDIF}
   {$IFDEF LCLGTK}
   glib, gdk, gtk, GtkInt,
@@ -74,9 +74,9 @@ type
 function gdk_gl_query: boolean;
 function gdk_gl_choose_visual(attrlist: Plongint): PGdkVisual;
 function gdk_gl_get_config(visual: PGdkVisual; attrib: longint):longint;
-function gdk_gl_context_new(visual: PGdkVisual): PGdkGLContext;
+function gdk_gl_context_new(visual: PGdkVisual; attrlist: PlongInt): PGdkGLContext;
 function gdk_gl_context_share_new(visual: PGdkVisual; sharelist: PGdkGLContext;
-                                  direct: Integer): PGdkGLContext;
+                                  direct: Integer; attrlist: plongint): PGdkGLContext;
 function gdk_gl_context_attrlist_share_new(attrlist: Plongint;
                sharelist: PGdkGLContext; direct: Integer): PGdkGLContext;
 function gdk_gl_context_ref(context: PGdkGLContext): PGdkGLContext;
@@ -274,6 +274,7 @@ begin
   DebugLn('get_xvisualinfo dpy=',XDisplayAsString(dpy));
   
   DebugLn('get_xvisualinfo visual=',GdkVisualAsString(Visual));
+  RaiseGDBException('not implemented for gtk2');
   {$ENDIF}
 
   // 'GLX uses VisualInfo records because they uniquely identify
@@ -341,6 +342,11 @@ var
   vi: PXVisualInfo;
   visual: PGdkVisual;
 begin
+  {$IFDEF lclgtk2}
+  DebugLn(['gdk_gl_choose_visual not implemented yet for gtk2']);
+  RaiseGDBException('');
+  {$ENDIF}
+
   //writeln('gdk_gl_choose_visual A ');
   if attrList=nil then begin
     Result:=nil;
@@ -381,13 +387,13 @@ begin
     XFree(vi);
 end;
 
-function gdk_gl_context_new(visual: PGdkVisual): PGdkGLContext;
+function gdk_gl_context_new(visual: PGdkVisual; attrlist: PlongInt): PGdkGLContext;
 begin
-  Result:=gdk_gl_context_share_new(visual,nil,0);
+  Result:=gdk_gl_context_share_new(visual,nil,0,attrlist);
 end;
 
 function gdk_gl_context_share_new(visual: PGdkVisual; sharelist: PGdkGLContext;
-  direct: integer): PGdkGLContext;
+  direct: integer; attrlist: plongint): PGdkGLContext;
 var
   dpy: PDisplay;
   vi: PXVisualInfo;
@@ -396,18 +402,25 @@ var
   glxcontext: TGLXContext;
 begin
   Result:=nil;
-  if visual=nil then exit;
-
-  vi := get_xvisualinfo(visual);
 
   dpy := GetDefaultXDisplay;
 
+  {$IFDEF lclgtk2}
+  DebugLn(['gdk_gl_context_share_new AAA1']);
+  vi:=glXChooseVisual(dpy, DefaultScreen(dpy), @attrList[0]);
+  DebugLn(['gdk_gl_context_share_new AAA2']);
+  {$ELSE}
+  if visual=nil then exit;
+  vi := get_xvisualinfo(visual);
+  {$ENDIF}
+
   PrivateShareList:=PGdkGLContextPrivate(sharelist);
   if (sharelist<>nil) then
     glxcontext := glXCreateContext(dpy, vi, PrivateShareList^.glxcontext,
                                    direct=1)
   else
     glxcontext := glXCreateContext(dpy, vi, nil, direct=1);
+  DebugLn(['gdk_gl_context_share_new AAA3']);
 
   XFree(vi);
   if (glxcontext = nil) then exit;
@@ -425,11 +438,16 @@ function gdk_gl_context_attrlist_share_new(attrlist: Plongint;
 var
   visual: PGdkVisual;
 begin
+  {$IFDEF lclgtk2}
+  visual :=nil;
+  Result:=gdk_gl_context_share_new(visual, sharelist, direct,attrlist);
+  {$ELSE}
   visual := gdk_gl_choose_visual(attrlist);
   if (visual<>nil) then
-    Result:=gdk_gl_context_share_new(visual, sharelist, direct)
+    Result:=gdk_gl_context_share_new(visual, sharelist, direct,attrlist)
   else
     Result:=nil;
+  {$ENDIF}
 end;
 
 function gdk_gl_context_ref(context: PGdkGLContext): PGdkGLContext;
@@ -513,10 +531,13 @@ procedure gtk_gl_area_init(
   ); cdecl;
 begin
   if theClass=nil then ;
+  DebugLn(['gtk_gl_area_init START']);
   PGtkGLArea(gl_area)^.glcontext:=nil;
-  {$IFDEF Gtk2}
+  {$IFDEF LclGtk2}
   gtk_widget_set_double_buffered(PGtkWidget(gl_area),gdkFALSE);
+  GTK_WIDGET_UNSET_FLAGS(PGtkWidget(gl_area),GTK_NO_WINDOW);
   {$ENDIF}
+  DebugLn(['gtk_gl_area_init END']);
 end;
 
 function GTK_TYPE_GL_AREA: TGtkType;
@@ -600,36 +621,48 @@ var
   gl_area: PGtkGLArea;
 begin
   Result:=nil;
+  DebugLn(['gtk_gl_area_share_new START']);
   //writeln('gtk_gl_area_share_new A ');
   if (share<>nil) and (not GTK_IS_GL_AREA(share)) then
     exit;
   {$IFNDEF MSWindows}
   //writeln('gtk_gl_area_share_new B ');
+  {$IFDEF lclgtk2}
+  visual := nil;
+  {$ELSE}
   visual := gdk_gl_choose_visual(attrlist);
   if (visual = nil) then exit;
+  {$ENDIF}
   {$ENDIF non MSWindows}
 
   //writeln('gtk_gl_area_share_new C ');
+  DebugLn(['gtk_gl_area_share_new BBB1']);
   sharelist := nil;
   if share<>nil then sharelist:=share^.glcontext;
-  glcontext := gdk_gl_context_share_new(visual, sharelist, 1);
+  glcontext := gdk_gl_context_share_new(visual, sharelist, 1, attrlist);
   if (glcontext = nil) then exit;
+  DebugLn(['gtk_gl_area_share_new BBB2']);
   //writeln('gtk_gl_area_share_new D ');
 
   {$IFNDEF MSWindows}
-  // use colormap and visual suitable for OpenGL rendering
-  gtk_widget_push_colormap(gdk_colormap_new(visual,gtk_TRUE));
-  gtk_widget_push_visual(visual);
+  if visual<>nil then begin
+    // use colormap and visual suitable for OpenGL rendering
+    gtk_widget_push_colormap(gdk_colormap_new(visual,gtk_TRUE));
+    gtk_widget_push_visual(visual);
+  end;
   {$ENDIF non MSWindows}
 
   gl_area := gtk_type_new (gtk_gl_area_get_type);
   gl_area^.glcontext := glcontext;
   //writeln('gtk_gl_area_share_new E ',gl_area<>nil);
+  DebugLn(['gtk_gl_area_share_new BBB3']);
 
   {$IFNDEF MSWindows}
-  // pop back defaults
-  gtk_widget_pop_visual;
-  gtk_widget_pop_colormap;
+  if visual<>nil then begin
+    // pop back defaults
+    gtk_widget_pop_visual;
+    gtk_widget_pop_colormap;
+  end;
   {$ENDIF non MSWindows}
   Result:=PGtkWidget(gl_area);
 end;
@@ -641,7 +674,9 @@ begin
   if not GTK_IS_GL_AREA(glarea) then exit;
   if not GTK_WIDGET_REALIZED(PGtkWidget(glarea)) then exit;
 
+  DebugLn(['gtk_gl_area_make_current START']);
   Result:=gdk_gl_make_current(PGtkWidget(glarea)^.window, glarea^.glcontext);
+  DebugLn(['gtk_gl_area_make_current END']);
 end;
 
 function gtk_gl_area_begingl(glarea: PGtkGLArea): boolean;

components/opengl/openglcontext.pas

@@ -53,7 +53,7 @@ uses
   GLGtkGlxContext;
 {$ENDIF}
 {$IFDEF UseGtk2GLX}
-  GLGtk2GlxContext;
+  GLGtkGlxContext;
 {$ENDIF}
 {$IFDEF UseCarbonAGL}
   GLCarbonAGLContext;

components/prettymessages/README.txt

@@ -0,0 +1,7 @@
+prettymessages
+==============
+
+This package is an Lazarus IDE add on, which helps to reduce FPC hints, notes
+and warnings. If you want to hide a specific hint, click right on a message
+and in the popup menu click on Hide FPC hint.
+

components/prettymessages/hidefpchints.pas

@@ -0,0 +1,203 @@
+{ Extends Lazarus to hide FPC messages.
+  For example:
+    testunit1.pas(20,27) Hint: Parameter "X" not used
+
+
+  Copyright (C) 2007 Mattias Gaertner mattias@freepascal.org
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit HideFPCHints;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LCLProc, Controls,
+  // IDEIntf
+  IDEMsgIntf, LazIDEIntf, SrcEditorIntf,
+  // CodeTools
+  BasicCodeTools, SourceLog, CodeCache, CodeToolManager,
+  // our stuff
+  PrettyMsgOptions;
+  
+type
+
+  { THideFPCHintWorker }
+
+  THideFPCHintWorker = class(TIDEMsgQuickFixItem)
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Execute(const Msg: TIDEMessageLine; Step: TIMQuickFixStep); override;
+    function IsApplicable(Line: TIDEMessageLine): boolean; override;
+  end;
+  
+procedure QuickFixHideFPCHint(Sender: TObject; Step: TIMQuickFixStep;
+                              Msg: TIDEMessageLine);
+
+procedure Register;
+
+implementation
+
+procedure QuickFixHideFPCHint(Sender: TObject; Step: TIMQuickFixStep;
+  Msg: TIDEMessageLine);
+begin
+
+end;
+
+procedure Register;
+var
+  Item: TIDEMsgQuickFixItem;
+begin
+  Item:=THideFPCHintWorker.Create;
+  RegisterIDEMsgQuickFix(Item);
+end;
+
+{ THideFPCHintWorker }
+
+constructor THideFPCHintWorker.Create;
+begin
+  inherited Create;
+  Name:='Hide FPC hints';
+  Caption:='Hide this FPC hint';
+  Steps:=[imqfoImproveMessage,imqfoMenuItem];
+end;
+
+destructor THideFPCHintWorker.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure THideFPCHintWorker.Execute(const Msg: TIDEMessageLine;
+  Step: TIMQuickFixStep);
+var
+  Filename: string;
+  Line: integer;
+  Column: integer;
+  CodeBuf: TCodeBuffer;
+  LineRange: TLineRange;
+  DirectivePos: LongInt;
+  Src: String;
+  EndPos: LongInt;
+  p: LongInt;
+  MsgType: string;
+  Directive: String;
+  SrcEdit: TSourceEditorInterface;
+  InsertPos: Integer;
+  HasDirective: Boolean;
+begin
+  inherited Execute(Msg, Step);
+  
+  // get filename and line number and load file
+  if Msg.Parts=nil then exit;
+  if Msg.Parts.Values['Stage']<>'FPC' then exit;
+  MsgType:=Msg.Parts.Values['Type'];
+  if MsgType='Hint' then
+    Directive:='h-'
+  else if MsgType='Note' then
+    Directive:='n-'
+  else if MsgType='Warning' then
+    Directive:='w-'
+  else
+    exit;
+
+  Msg.GetSourcePosition(Filename,Line,Column);
+  //DebugLn(['THideFPCHintWorker.Execute ',Filename,' Line=',Line]);
+  CodeBuf:=CodeToolBoss.LoadFile(Filename,false,false);
+  if CodeBuf=nil then exit;
+  if (Line<1) or (Line>CodeBuf.LineCount) then exit;
+  Src:=CodeBuf.Source;
+  CodeBuf.GetLineRange(Line-1,LineRange);
+
+  // check if the code contains an IDE directive to hide the hint
+  HasDirective:=false;
+  p:=LineRange.StartPos;
+  EndPos:=LineRange.EndPos;
+  repeat
+    DirectivePos:=FindNextIDEDirective(Src,p,true,EndPos);
+    if (DirectivePos<1) then break;
+    if CompareSubStrings(Directive,Src,1,DirectivePos+2,2,false)=0 then begin
+      //DebugLn(['THideFPCHintWorker.Execute Ignoring message: ',Msg.Msg]);
+      HasDirective:=true;
+    end;
+    p:=DirectivePos;
+    while (p<EndPos) and (Src[p]<>'}') do inc(p);
+  until p>=EndPos;
+
+  if Step=imqfoMenuItem then begin
+    // user clicked on the menu item to add an IDE directive
+    if HasDirective then exit;
+    
+    // open the file in the source editor
+    if LazarusIDE.DoOpenFileAndJumpToPos(Filename,Point(1,Line),-1,-1,
+      [ofOnlyIfExists,ofRegularFile,ofUseCache,ofDoNotLoadResource])<>mrOk then
+    begin
+      DebugLn(['THideFPCHintWorker.Execute open failed: ',Filename]);
+      exit;
+    end;
+    // find the source editor page
+    SrcEdit:=SourceEditorWindow.SourceEditorIntfWithFilename(Filename);
+    if SrcEdit=nil then begin
+      DebugLn(['THideFPCHintWorker.Execute unable to find the file in the source editor of ',Filename]);
+      exit;
+    end;
+    // find the source editor line
+    if SrcEdit.LineCount<Line then begin
+      DebugLn(['THideFPCHintWorker.Execute unable to find the line ',Line,' of ',Filename]);
+      exit;
+    end;
+    
+    // add at end of line
+    InsertPos:=length(SrcEdit.Lines[Line-1])+1;
+    SrcEdit.ReplaceText(Point(InsertPos,Line),Point(InsertPos,Line),'{%'+Directive+'}');
+    
+  end else if Step=imqfoImproveMessage then begin
+    // the parser found the message -> hide the message
+    if HasDirective then
+      Msg.Visible:=false;
+  end;
+end;
+
+function THideFPCHintWorker.IsApplicable(Line: TIDEMessageLine): boolean;
+var
+  MsgType: string;
+begin
+  Result:=false;
+  if Line.Parts=nil then exit;
+  if Line.Parts.Values['Stage']<>'FPC' then exit;
+  MsgType:=Line.Parts.Values['Type'];
+  if MsgType='Hint' then
+    Result:=true
+  else if MsgType='Note' then
+    Result:=true
+  else if MsgType='Warning' then
+    Result:=true;
+end;
+
+end.
+

components/prettymessages/prettymessages.lpk

@@ -0,0 +1,56 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="2">
+    <Name Value="PrettyMessages"/>
+    <CompilerOptions>
+      <Version Value="5"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <CodeGeneration>
+        <Generate Value="Faster"/>
+      </CodeGeneration>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Files Count="3">
+      <Item1>
+        <Filename Value="hidefpchints.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="HideFPCHints"/>
+      </Item1>
+      <Item2>
+        <Filename Value="prettymsgoptionsdlg.pas"/>
+        <UnitName Value="PrettyMsgOptionsDlg"/>
+      </Item2>
+      <Item3>
+        <Filename Value="prettymsgoptions.pas"/>
+        <UnitName Value="prettymsgoptions"/>
+      </Item3>
+    </Files>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="4">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="IDEIntf"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item3>
+      <Item4>
+        <PackageName Value="CodeTools"/>
+      </Item4>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

components/prettymessages/prettymessages.pas

@@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. Do not edit!
+This source is only used to compile and install the package.
+ }
+
+unit PrettyMessages; 
+
+interface
+
+uses
+  HideFPCHints, PrettyMsgOptionsDlg, PrettyMsgOptions, LazarusPackageIntf; 
+
+implementation
+
+procedure Register; 
+begin
+  RegisterUnit('HideFPCHints', @HideFPCHints.Register); 
+end; 
+
+initialization
+  RegisterPackage('PrettyMessages', @Register); 
+end.

components/prettymessages/prettymsgoptions.pas

@@ -0,0 +1,49 @@
+{ Options for the pretty message package.
+
+
+  Copyright (C) 2007 Mattias Gaertner mattias@freepascal.org
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit PrettyMsgOptions;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils; 
+  
+type
+  TPrettyMsgOptions = class
+  public
+  
+  end;
+
+implementation
+
+end.
+

components/prettymessages/prettymsgoptionsdlg.lfm

@@ -0,0 +1,30 @@
+object PrettyMsgOptionsDialog: TPrettyMsgOptionsDialog
+  Left = 294
+  Height = 300
+  Top = 164
+  Width = 400
+  HorzScrollBar.Page = 399
+  VertScrollBar.Page = 299
+  Caption = 'PrettyMsgOptionsDialog'
+  OnCreate = FormCreate
+  Position = poScreenCenter
+  object OkButton: TButton
+    Left = 192
+    Height = 25
+    Top = 264
+    Width = 75
+    BorderSpacing.InnerBorder = 4
+    Caption = 'OkButton'
+    TabOrder = 0
+  end
+  object CancelButton: TButton
+    Left = 288
+    Height = 25
+    Top = 264
+    Width = 75
+    BorderSpacing.InnerBorder = 4
+    Caption = 'CancelButton'
+    ModalResult = 2
+    TabOrder = 1
+  end
+end

components/prettymessages/prettymsgoptionsdlg.lrs

@@ -0,0 +1,13 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TPrettyMsgOptionsDialog','FORMDATA',[
+  'TPF0'#23'TPrettyMsgOptionsDialog'#22'PrettyMsgOptionsDialog'#4'Left'#3'&'#1#6
+  +'Height'#3','#1#3'Top'#3#164#0#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143
+  +#1#18'VertScrollBar.Page'#3'+'#1#7'Caption'#6#22'PrettyMsgOptionsDialog'#8'O'
+  +'nCreate'#7#10'FormCreate'#8'Position'#7#14'poScreenCenter'#0#7'TButton'#8'O'
+  +'kButton'#4'Left'#3#192#0#6'Height'#2#25#3'Top'#3#8#1#5'Width'#2'K'#25'Borde'
+  +'rSpacing.InnerBorder'#2#4#7'Caption'#6#8'OkButton'#8'TabOrder'#2#0#0#0#7'TB'
+  +'utton'#12'CancelButton'#4'Left'#3' '#1#6'Height'#2#25#3'Top'#3#8#1#5'Width'
+  +#2'K'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#12'CancelButton'#11'Mod'
+  +'alResult'#2#2#8'TabOrder'#2#1#0#0#0
+]);

components/prettymessages/prettymsgoptionsdlg.pas

@@ -0,0 +1,74 @@
+{ Extends Lazarus with a dialog to edit the options of the pretty message
+  package.
+
+
+  Copyright (C) 2007 Mattias Gaertner mattias@freepascal.org
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  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. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit PrettyMsgOptionsDlg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons;
+
+type
+
+  { TPrettyMsgOptionsDialog }
+
+  TPrettyMsgOptionsDialog = class(TForm)
+    OkButton: TButton;
+    CancelButton: TButton;
+    procedure FormCreate(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end; 
+
+var
+  PrettyMsgOptionsDialog: TPrettyMsgOptionsDialog;
+
+implementation
+
+{ TPrettyMsgOptionsDialog }
+
+procedure TPrettyMsgOptionsDialog.FormCreate(Sender: TObject);
+begin
+  Caption:='Options of Pretty Messages';
+  
+  OkButton.Caption:='Ok';
+  CancelButton.Caption:='Cancel';
+end;
+
+initialization
+  {$I prettymsgoptionsdlg.lrs}
+
+end.
+

ide/msgview.pp

@@ -133,6 +133,7 @@ type
                                           FirstLine, LineCount: Integer);
     procedure UpdateMsgLineInListBox(Line: TLazMessageLine);
     function ExecuteMsgLinePlugin(Step: TIMQuickFixStep): boolean;
+    procedure HideLine(Line: TLazMessageLine);
     procedure ConsistencyCheck;
   public
     property LastLineIsProgress: boolean read FLastLineIsProgress
@@ -436,6 +437,7 @@ procedure TMessagesView.CollectLineParts(Sender: TObject;
     QuickFixItem: TIDEMsgQuickFixItem;
     j: Integer;
     OldMsg: String;
+    OldVisible: Boolean;
   begin
     for i:=StartIndex to FItems.Count-1 do begin
       ALine:=Items[i];
@@ -444,10 +446,17 @@ procedure TMessagesView.CollectLineParts(Sender: TObject;
         if (imqfoImproveMessage in QuickFixItem.Steps)
         and QuickFixItem.IsApplicable(ALine) then begin
           OldMsg:=ALine.Msg;
+          OldVisible:=ALine.VisiblePosition>=0;
+          ALine.Visible:=OldVisible;
           QuickFixItem.Execute(ALine,imqfoImproveMessage);
           UpdateMsgSrcPos(ALine);
-          if OldMsg<>ALine.Msg then
+          if (OldVisible<>ALine.Visible) then begin
+            if not ALine.Visible then
+              HideLine(ALine);
+          end;
+          if (OldMsg<>ALine.Msg) then begin
             UpdateMsgLineInListBox(ALine);
+          end;
         end;
       end;
     end;
@@ -562,8 +571,9 @@ begin
       Line.VisiblePosition := FVisibleItems.Count;
       FVisibleItems.Add(Line);
     end
-    else
+    else begin
       Line.VisiblePosition := -1;
+    end;
   end;
   // rebuild MessageTreeView.Items
   MessageTreeView.BeginUpdate;
@@ -671,6 +681,34 @@ begin
   end;
 end;
 
+procedure TMessagesView.HideLine(Line: TLazMessageLine);
+var
+  i: Integer;
+  OldIndex: LongInt;
+begin
+  OldIndex:=Line.VisiblePosition;
+  if OldIndex<0 then exit;
+  //DebugLn(['TMessagesView.HideLine ',OldIndex]);
+  if (OldIndex>=0) and (OldIndex<FVisibleItems.Count)
+  then begin
+    // adjust all VisiblePosition
+    for i:=OldIndex+1 to FVisibleItems.Count-1 do begin
+      TLazMessageLine(FVisibleItems[i]).VisiblePosition:=
+        TLazMessageLine(FVisibleItems[i]).VisiblePosition-1;
+    end;
+    FVisibleItems.Delete(OldIndex);
+    Line.VisiblePosition:=-1;
+  end;
+  // remove from FVisibleItems and from LCL control
+  if (OldIndex>=0)
+  and (OldIndex<MessageTreeView.Items.TopLvlCount) then begin
+    MessageTreeView.Items.TopLvlItems[OldIndex].Delete;
+  end;
+  //for i:=0 to MessageTreeView.Items.TopLvlCount-1 do begin
+  //  DebugLn(['TMessagesView.HideLine ',i,' ',MessageTreeView.Items.TopLvlItems[i].Text]);
+  //end;
+end;
+
 {------------------------------------------------------------------------------
   TMessagesView.Clear
 ------------------------------------------------------------------------------}

ideintf/idemsgintf.pas

@@ -68,6 +68,7 @@ type
     FOriginalIndex: integer;
     FParts: TStrings;
     FPosition: integer;
+    FVisible: boolean;
     FVisiblePosition: integer;
     procedure SetDirectory(const AValue: string);
     procedure SetMsg(const AValue: string);
@@ -84,6 +85,7 @@ type
     property VisiblePosition: integer read FVisiblePosition write FVisiblePosition;// filtered position
     property OriginalIndex: integer read FOriginalIndex write FOriginalIndex;// unsorted, unfiltered position
     property Parts: TStrings read FParts write FParts;
+    property Visible: boolean read FVisible write FVisible;
   end;
 
   TOnFilterLine = procedure(MsgLine: TIDEMessageLine; var Show: boolean) of object;
@@ -113,9 +115,9 @@ type
   { TIDEMsgQuickFixItem }
   
   TIMQuickFixStep = (
-    imqfoMenuItem,       // add menu item in popup menu for this item
-    imqfoImproveMessage, // rewrites message
-    imqfoJump            // user clicks on message
+    imqfoMenuItem,      // Popup menu opens. Add now the menu item.
+    imqfoImproveMessage,// Message can now be rewritten/beautified.
+    imqfoJump           // Override what happens, when user clicks on message.
     );
   TIMQuickFixSteps = set of TIMQuickFixStep;
 

ideintf/srceditorintf.pas

@@ -296,6 +296,7 @@ begin
   BeginUpdate;
   BeginUndoBlock;
   SelectText(StartPos,EndPos);
+  CursorTextXY:=StartPos;
   Selection:=NewText;
   EndUndoBlock;
   EndUpdate;

lcl/controls.pp

@@ -302,7 +302,7 @@ type
   TKeyPressEvent = procedure(Sender: TObject; var Key: char) of Object;
   TUTF8KeyPressEvent = procedure(Sender: TObject; var UTF8Key: TUTF8Char) of Object;
 
-  TMouseEvent = Procedure(Sender: TOBject; Button: TMouseButton;
+  TMouseEvent = Procedure(Sender: TObject; Button: TMouseButton;
                           Shift: TShiftState; X, Y: Integer) of object;
   TMouseMoveEvent = Procedure(Sender: TObject; Shift: TShiftState;
                               X, Y: Integer) of object;

packager/globallinks/prettymessages-0.lpl

@@ -0,0 +1,2 @@
+$(LazarusDir)/components/prettymessages/prettymessages.lpk
+

packager/packageeditor.pas

@@ -129,10 +129,10 @@ type
     ImageList: TImageList;
     FilesPopupMenu: TPopupMenu;
     procedure AddBitBtnClick(Sender: TObject);
-    procedure AddToUsesPkgSectionCheckBoxClick(Sender: TObject);
+    procedure AddToUsesPkgSectionCheckBoxChange(Sender: TObject);
     procedure AddToProjectClick(Sender: TObject);
     procedure ApplyDependencyButtonClick(Sender: TObject);
-    procedure CallRegisterProcCheckBoxClick(Sender: TObject);
+    procedure CallRegisterProcCheckBoxChange(Sender: TObject);
     procedure ChangeFileTypeMenuItemClick(Sender: TObject);
     procedure CompileAllCleanClick(Sender: TObject);
     procedure CompileBitBtnClick(Sender: TObject);
@@ -171,8 +171,8 @@ type
     procedure SaveBitBtnClick(Sender: TObject);
     procedure SortFilesMenuItemClick(Sender: TObject);
     procedure UninstallClick(Sender: TObject);
-    procedure UseMaxVersionCheckBoxClick(Sender: TObject);
-    procedure UseMinVersionCheckBoxClick(Sender: TObject);
+    procedure UseMaxVersionCheckBoxChange(Sender: TObject);
+    procedure UseMinVersionCheckBoxChange(Sender: TObject);
     procedure ViewPkgSourceClick(Sender: TObject);
   private
     FLazPackage: TLazPackage;
@@ -899,13 +899,13 @@ begin
   PackageEditors.ViewPkgSourcePackage(LazPackage);
 end;
 
-procedure TPackageEditorForm.UseMaxVersionCheckBoxClick(Sender: TObject);
+procedure TPackageEditorForm.UseMaxVersionCheckBoxChange(Sender: TObject);
 begin
   MaxVersionEdit.Enabled:=UseMaxVersionCheckBox.Checked;
   UpdateApplyDependencyButton;
 end;
 
-procedure TPackageEditorForm.UseMinVersionCheckBoxClick(Sender: TObject);
+procedure TPackageEditorForm.UseMinVersionCheckBoxChange(Sender: TObject);
 begin
   MinVersionEdit.Enabled:=UseMinVersionCheckBox.Checked;
   UpdateApplyDependencyButton;
@@ -1116,7 +1116,7 @@ begin
   PackageGraph.EndUpdate;
 end;
 
-procedure TPackageEditorForm.AddToUsesPkgSectionCheckBoxClick(Sender: TObject);
+procedure TPackageEditorForm.AddToUsesPkgSectionCheckBoxChange(Sender: TObject);
 var
   CurFile: TPkgFile;
   Removed: boolean;
@@ -1183,7 +1183,7 @@ begin
   end;
 end;
 
-procedure TPackageEditorForm.CallRegisterProcCheckBoxClick(Sender: TObject);
+procedure TPackageEditorForm.CallRegisterProcCheckBoxChange(Sender: TObject);
 var
   CurFile: TPkgFile;
   Removed: boolean;
@@ -1462,7 +1462,7 @@ begin
     Parent:=FilePropsGroupBox;
     Caption:=lisPckEditRegisterUnit;
     UseOnChange:=true;
-    OnClick:=@CallRegisterProcCheckBoxClick;
+    OnChange:=@CallRegisterProcCheckBoxChange;
     Hint:=Format(lisPckEditCallRegisterProcedureOfSelectedUnit, ['"', '"']);
     ShowHint:=true;
   end;
@@ -1472,7 +1472,7 @@ begin
     Name:='AddToUsesPkgSectionCheckBox';
     Caption:=lisPkgMangUseUnit;
     UseOnChange:=true;
-    OnClick:=@AddToUsesPkgSectionCheckBoxClick;
+    OnChange:=@AddToUsesPkgSectionCheckBoxChange;
     Hint:=lisPkgMangAddUnitToUsesClauseOfPackageDisableThisOnlyForUnit;
     ShowHint:=true;
     Parent:=FilePropsGroupBox;
@@ -1501,7 +1501,7 @@ begin
     Name:='UseMinVersionCheckBox';
     Caption:=lisPckEditMinimumVersion;
     UseOnChange:=true;
-    OnClick:=@UseMinVersionCheckBoxClick;
+    OnChange:=@UseMinVersionCheckBoxChange;
     Parent:=FilePropsGroupBox;
   end;
   
@@ -1518,7 +1518,7 @@ begin
     Name:='UseMaxVersionCheckBox';
     Caption:=lisPckEditMaximumVersion;
     UseOnChange:=true;
-    OnClick:=@UseMaxVersionCheckBoxClick;
+    OnChange:=@UseMaxVersionCheckBoxChange;
     Parent:=FilePropsGroupBox;
   end;