paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-03 10:38:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: small bugfixes

Browse Source 
git-svn-id: trunk@328 -
This commit is contained in:
lazarus 2001-08-07 11:05:51 +00:00
parent 1f8bda0727
commit e2db92305a
9 changed files with 101 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ide/compileroptions.pp
View File

@ -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;

2
ide/keymapping.pp
View File

@ -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

48
ide/uniteditor.pp
View File

@ -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;
case Command of
ecClose :
CloseClicked(self);
else
Handled:=false;
end; //case
Handled:=(Command=ecClose);
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;

12
lcl/include/clipbrd.inc
View File

@ -97,16 +97,15 @@ begin
Result := 0;
if FUseText then
begin
if Length(AsText) > BufSize then
begin
StrPLCopy(Buffer, AsText, BufSize);
Result := BufSize;
if (Length(AsText)+1) > BufSize then begin
StrPLCopy(Buffer, AsText, BufSize-1);
Result := BufSize-1;
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

24
lcl/include/control.inc
View File

@ -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
//{$IFOPT H+}
if Self is TWinControl then
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

25
lcl/include/customnotebook.inc
View File

@ -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
// switch current page to prior (left) page
fNoteBook.PageIndex := fNoteBook.PageIndex - 1
if NewPageIndex<fPageList.Count-1 then
// switch current page to next (right) page
inc(NewPageIndex)
else if fPageList.Count>1 then
// switch to next (right) page
fNoteBook.PageIndex := 1
// switch to previous (left) page
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

20
lcl/include/wincontrol.inc
View File

@ -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
//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;
SetTextBuf(PChar(FCaption));
Assert(False, 'Trace:SETPROP**********************************************');
SetProp(Handle,'WinControl',TWinControl(Self));
SetProp(Handle,'Control',TControl(Self));
SetProp(Handle,'WinControl',TWinControl(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

28
lcl/interfaces/gtk/gtkobject.inc
View File

@ -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));
if pLabel <> nil then gtk_label_get(pLabel, @Result);
pLabel := gtk_notebook_get_tab_label(
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

13
lcl/interfaces/gtk/gtkwinapiwindow.pp
View File

@ -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