MG: small bugfixes

git-svn-id: trunk@328 -

ide/compileroptions.pp

@@ -2324,7 +2324,7 @@ begin
     Left := 10;
     Height := 55;
     Width := 350;
-    Caption := 'Other Unit Files:';
+    Caption := 'Other Unit Files (Delimiter is semicolon):';
     Visible := True;
   end;
 

ide/keymapping.pp

@@ -59,7 +59,7 @@ const
 
 type
   //---------------------------------------------------------------------------
-  // class for storing the keys for a single command (key-command relationship)
+  // class for storing the keys of a single command (key-command relationship)
   TKeyCommandRelation = class
   private
   public

ide/uniteditor.pp

@@ -204,9 +204,10 @@ type
   private
     FMainIDE : TComponent;
     FFormEditor : TFormEditor;
-    FCodeTemplateModul : TSynEditAutoComplete;
-
     FSourceEditorList : TList; // list of TSourceEditor
+    FCodeTemplateModul: TSynEditAutoComplete;
+    FKeyStrokes: TSynEditKeyStrokes;
+
     FSaveDialog : TSaveDialog;
     FOpenDialog : TOpenDialog;
 
@@ -258,6 +259,8 @@ type
     function FindBookmark(BookmarkID: integer): TSourceEditor;
     function FindPageWithEditor(ASourceEditor: TSourceEditor):integer;
     function GetEditors(Index:integer):TSourceEditor;
+    
+    procedure KeyDown(var Key : Word; Shift : TShiftState); override;
   public
     SearchPaths: string;
 
@@ -280,12 +283,12 @@ type
     Procedure DisplayCodeforControl(Control : TObject);
     Procedure DisplayCodefromUnitName(UnitName : String);
 
-    procedure CloseClicked(Sender : TObject);
     Procedure NewClicked(Sender: TObject);
     procedure OpenClicked(Sender : TObject);
     procedure SaveClicked(Sender : TObject);
     procedure SaveAllClicked(Sender : TObject);
     procedure SaveAsClicked(Sender : TObject);
+    procedure CloseClicked(Sender : TObject);
     procedure ToggleFormUnitClicked(Sender: TObject);
 
     procedure FindClicked(Sender : TObject);
@@ -303,7 +306,8 @@ type
        read FCodeTemplateModul write FCodeTemplateModul;
     procedure OnCodeTemplateTokenNotFound(Sender: TObject; AToken: string; 
                                 AnEditor: TCustomSynEdit; var Index:integer);
-    procedure OnWordCompletionGetSource(var Source:TStrings; SourceIndex:integer);
+    procedure OnWordCompletionGetSource(
+       var Source:TStrings; SourceIndex:integer);
 
     function Empty: boolean;
     property FormEditor : TFormEditor read FFormEditor write FFormEditor;
@@ -1350,7 +1354,9 @@ begin
   if not LoadPixmapRes('InactiveBreakPoint',Pixmap1) then
          LoadPixmapRes('default',Pixmap1);
   MarksImgList.Add(Pixmap1,nil);
-  
+
+  FKeyStrokes:=TSynEditKeyStrokes.Create(Self);
+  EditorOpts.KeyMap.AssignTo(FKeyStrokes);
 
   aHighlighter:=TSynPasSyn.Create(AOwner);
     with aHighlighter do begin
@@ -1402,9 +1408,6 @@ begin
   CodeCompletionTimer := TTimer.Create(self);
   CodeCompletionTimer.Enabled := False;
   CodeCompletionTimer.Interval := 500;
-
-
- Writeln('TSourceNotebook create exiting');
 end;
 
 destructor TSourceNotebook.Destroy;
@@ -1417,6 +1420,7 @@ writeln('[TSourceNotebook.Destroy]');
     Notebook.Free;
     NoteBook:=nil;
   end;
+  FKeyStrokes.Free;
   FCodeTemplateModul.Free;
   FSourceEditorList.Free;
   Gotodialog.free;
@@ -2477,13 +2481,8 @@ begin
     if Handled then exit;
   end;
 
-  Handled:=true;
+  Handled:=(Command=ecClose);
-  case Command of
+  
-  ecClose :
-    CloseClicked(self);
-  else
-    Handled:=false;
-  end;  //case
   if Handled then Command:=ecNone;
 end;
 
@@ -2503,6 +2502,25 @@ Begin
       if FileExists('lazarus.dci') then
         AutoCompleteList.LoadFromFile('lazarus.dci');
   end;
+  
+  EditorOpts.KeyMap.AssignTo(FKeyStrokes);
+end;
+
+procedure TSourceNotebook.KeyDown(var Key : Word; Shift : TShiftState);
+var i, Command: integer;
+Begin
+  inherited KeyDown(Key,Shift);
+  i := FKeyStrokes.FindKeycode(Key, Shift);
+  if i>=0 then begin
+    Command:=FKeyStrokes[i].Command;
+    case Command of
+      ecClose:
+        begin
+          CloseClicked(Self);
+          Key:=0;
+        end;
+    end;
+  end;
 end;
 
 

lcl/include/clipbrd.inc

@@ -97,16 +97,15 @@ begin
   Result := 0;
   if FUseText then
   begin
-     if Length(AsText) > BufSize then
+     if (Length(AsText)+1) > BufSize then begin
-     begin
+        StrPLCopy(Buffer, AsText, BufSize-1);
-        StrPLCopy(Buffer, AsText, BufSize);
+        Result := BufSize-1;
-        Result := BufSize;
      end else begin
         StrPLCopy(Buffer, AsText, Length(AsText));
         Result := Length(AsText);
      end;
   end else
-     StrPLCopy(Buffer, '', BufSize);
+     StrPLCopy(Buffer, '', BufSize-1);
 end;
 
 {------------------------------------------------------------------------------
@@ -167,6 +166,9 @@ end;
 
 {
   $Log$
+  Revision 1.2  2001/08/07 11:05:51  lazarus
+  MG: small bugfixes
+
   Revision 1.1  2000/07/13 10:28:24  michael
   + Initial import
 

lcl/include/control.inc

@@ -1193,32 +1193,15 @@ end;
 {  TControl SetText                                                            }
 {------------------------------------------------------------------------------}
 procedure TControl.SetText(const Value: TCaption);
-//var
-//  pStr : PChar;
 begin
   if GetText <> value
   then begin
-    //  added on 3/21/2000.  Need to set FCaption otherwise those components that simply
+    //  Need to set FCaption otherwise those components that simply
     //  check FCaption will always be wrong.
     FCaption := Value;
 
-    if Self is TWinControl then begin
+    if Self is TWinControl then
-      //{$IFOPT H+}
       SetTextBuf(PChar(FCaption));
-      //{$ELSE}
-      //We shouldn't NEED to create our own PCHAR.  We should be able
-      //to typecast VALUE as a PCHAR but it doesn't work.
-      //
-      // MWE: that's because strings were short strings
-      {pStr := StrAlloc(length(Value) + 1);
-      try
-        StrPCopy(pStr, value);
-        SetTextBuf(pStr);
-      finally
-        strDispose(pStr);
-      end;}
-      //{$ENDIF}
-    end;
   end;
 end;
 
@@ -1345,6 +1328,9 @@ end;
 
 { =============================================================================
   $Log$
+  Revision 1.23  2001/08/07 11:05:51  lazarus
+  MG: small bugfixes
+
   Revision 1.22  2001/06/28 18:15:03  lazarus
   MG: bugfixes for destroying controls
 

lcl/include/customnotebook.inc

@@ -74,25 +74,28 @@ end;
 procedure TNBPages.Delete(Index: Integer);
 var
   Msg: TLMNotebookEvent;
+  NewPageIndex: integer;
 begin
-  { Make sure Index is in the range of valid pages to delete }
+  // Make sure Index is in the range of valid pages to delete 
+//writeln('TNBPages.Delete A Index=',Index,' fPageList.Count=',fPageList.Count,' fNoteBook.PageIndex=',fNoteBook.PageIndex);
   if (Index >= 0) and
      (Index < fPageList.Count) then
   begin
-    { If that page is showing, then show the previous page before deleting it }
+    // If that page is showing, then show the next page before deleting it
+    NewPageIndex:=fNoteBook.PageIndex;
     if (Index = fNoteBook.PageIndex) then begin
-      if fNoteBook.PageIndex>0 then
+      if NewPageIndex<fPageList.Count-1 then
-        // switch current page to prior (left) page
+        // switch current page to next (right) page
-        fNoteBook.PageIndex := fNoteBook.PageIndex - 1
+        inc(NewPageIndex)
       else if fPageList.Count>1 then
-        // switch to next (right) page
+        // switch to previous (left) page
-        fNoteBook.PageIndex := 1
+        dec(NewPageIndex)
       else
         // deleting last page
         // TODO: delete contents but not last page
         exit;
     end;
-
+    fNoteBook.PageIndex:=NewPageIndex;
     if FNoteBook.HandleAllocated then begin
       Msg.Parent := fNotebook;
       Msg.fCompStyle := fNotebook.fCompStyle;
@@ -101,7 +104,10 @@ begin
     end;
     TPage(fPageList[Index]).Free;
     fPageList.Delete(Index);
+    if NewPageIndex>=Index then
+      fNoteBook.PageIndex:=NewPageIndex-1;
   end;
+//writeln('TNBPages.Delete END Index=',Index,' fPageList.Count=',fPageList.Count,' fNoteBook.PageIndex=',fNoteBook.PageIndex);
 end;
 
 
@@ -434,6 +440,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.8  2001/08/07 11:05:51  lazarus
+  MG: small bugfixes
+
   Revision 1.7  2001/06/14 14:57:58  lazarus
   MG: small bugfixes and less notes
 

lcl/include/wincontrol.inc

@@ -824,7 +824,6 @@ var
   ShiftState: TShiftState;
 begin
   Result := True;
-//  Writeln('Getting focus...');
   F := GetParentForm(Self);
   if  (F <> nil) 
   and (F <> Self) 
@@ -1678,7 +1677,6 @@ end;
 procedure TWinControl.InitializeWnd;
 var 
   R: TRect;
-  pStr: PChar;
 begin
   Assert(False, Format('Trace:[TWinControl.InitializeWnd]  %s', [ClassName]));
   // set all cached properties
@@ -1693,20 +1691,11 @@ begin
   
   EnableWindow(Handle, Enabled);
  
-  //We shouldn't NEED to create our own PCHAR.  We should be able
+  SetTextBuf(PChar(FCaption));
-  //to typecast Caption as a PCHAR but it doesn't work.
-  pStr := StrAlloc(Length(FCaption) + 1);
-  try
-    StrPCopy(pStr, FCaption);
-    SetTextBuf(pStr);
-  finally
-    strDispose(pStr);
-  end;
   Assert(False, 'Trace:SETPROP**********************************************');
 
- SetProp(Handle,'WinControl',TWinControl(Self));
+  SetProp(Handle,'WinControl',TWinControl(Self));
- SetProp(Handle,'Control',TControl(Self));
+  SetProp(Handle,'Control',TControl(Self));
-
 end;
 
 {------------------------------------------------------------------------------
@@ -1959,6 +1948,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.35  2001/08/07 11:05:51  lazarus
+  MG: small bugfixes
+
   Revision 1.34  2001/06/27 21:43:23  lazarus
   MG: added project bookmark support
 

lcl/interfaces/gtk/gtkobject.inc

@@ -446,6 +446,7 @@ begin
       LM_DESTROY :
       begin
         if (Sender is TWinControl) or (Sender is TCommonDialog) then begin
+//writeln('>>> LM_DESTROY ',Sender.Classname,' Sender=',HexStr(Cardinal(Sender),8),' Handle=',HexStr(Cardinal(Handle),8));
           if Handle<>0 then
             gtk_widget_destroy(PGtkWidget(Handle));
           // remove all remaining messages to this component
@@ -886,9 +887,9 @@ activate_time :	the time at which the activation event occurred.
           csNotebook:
           begin
             Assert(False, 'Trace:Setting Page to ' + IntToStr(TLMNotebookEvent(Data^).Page));
-writeln('LM_SETITEMINDEX A ',HexStr(Cardinal(Handle),8),', ',TLMNotebookEvent(Data^).Page);
+//writeln('LM_SETITEMINDEX A ',HexStr(Cardinal(Handle),8),', ',TLMNotebookEvent(Data^).Page);
             gtk_notebook_set_page(PGtkNotebook(Handle), TLMNotebookEvent(Data^).Page);
-writeln('LM_SETITEMINDEX B ',TLMNotebookEvent(Data^).Page);
+//writeln('LM_SETITEMINDEX B ',TLMNotebookEvent(Data^).Page);
           end;
         end;
       end;
@@ -2285,16 +2286,25 @@ end;
 function TgtkObject.GetLabel(CompStyle: Integer; P : Pointer) : String;
 var
   pLabel: Pointer; 
+  aPChar: PChar;
 begin
    Result := 'Label';
    case CompStyle of
-     csLabel: gtk_label_get(PGTKLabel(p),@Result);
+     csLabel: begin
+                gtk_label_get(PGTKLabel(p),@aPChar);
+                Result:=StrPas(aPChar);
+              end;
 
-     csForm : Result := String(PgtkWindow(p)^.Title);
+     csForm : Result := StrPas(PgtkWindow(p)^.Title);
 
      csPage : begin
-                 pLabel := gtk_notebook_get_tab_label(PGTKNoteBook(TWinControl(P).Parent.Handle), PGTKWidget(TWinControl(P).Handle));
+                 pLabel := gtk_notebook_get_tab_label(
-                 if pLabel <> nil then gtk_label_get(pLabel, @Result);
+                    PGTKNoteBook(TWinControl(P).Parent.Handle),
+                    PGTKWidget(TWinControl(P).Handle));
+                 if pLabel <> nil then begin
+                   gtk_label_get(pLabel, @aPChar);
+                   Result:=StrPas(aPChar);
+                 end;
               end;
    end;
 end;
@@ -2984,6 +2994,9 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.55  2001/08/07 11:05:51  lazarus
+  MG: small bugfixes
+
   Revision 1.54  2001/07/01 23:33:13  lazarus
   MG: added WaitMessage and HandleEvents is now non blocking
 
@@ -2993,12 +3006,9 @@ end;
   Revision 1.52  2001/06/26 21:44:32  lazarus
   MG: reduced paint messages
 
-<<<<<<< gtkobject.inc
-=======
   Revision 1.51  2001/06/26 00:08:36  lazarus
   MG: added code for form icons from Rene E. Beszon
 
->>>>>>> 1.51
   Revision 1.49  2001/06/14 14:57:59  lazarus
   MG: small bugfixes and less notes
 

lcl/interfaces/gtk/gtkwinapiwindow.pp

@@ -94,9 +94,17 @@ type
 procedure GTKAPIWidgetClient_DrawCaret(Client: PGTKAPIWidgetClient); forward;
 
 function GTKAPIWidgetClient_Timer(Client: Pointer): gint; cdecl;
+// returning 0 would stop the timer, 1 will restart it
 begin
+  if PGTKAPIWidgetClient(Client)^.Caret.Timer=0 then begin
+    Result := 0;
+    exit;
+  end;
   GTKAPIWidgetClient_DrawCaret(Client);
-  Result := 1;   { returning 0 would stop the timer, 1 will restart it }
+  if PGTKAPIWidgetClient(Client)^.Caret.Timer<>0 then
+    Result := 1
+  else
+    Result := 0;
 end;
 
 procedure GTKAPIWidgetClient_Realize(Widget: PGTKWidget); cdecl;
@@ -574,6 +582,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.11  2001/08/07 11:05:51  lazarus
+  MG: small bugfixes
+
   Revision 1.10  2001/07/02 15:17:24  lazarus
   MG: fixed wordcompletion and carettimer nonfocus bug