mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-04 07:59:43 +01:00
added history to identifier completion
git-svn-id: trunk@3766 -
This commit is contained in:
mattias
parent
d25a61111f
commit
a0bcf62aa6
@ -128,6 +128,7 @@ type
|
||||
SourceChangeCache: TSourceChangeCache; // cache for write accesses
|
||||
GlobalValues: TExpressionEvaluator;
|
||||
IdentifierList: TIdentifierList;
|
||||
IdentifierHistory: TIdentifierHistoryList;
|
||||
|
||||
procedure ActivateWriteLock;
|
||||
procedure DeactivateWriteLock;
|
||||
@ -384,10 +385,13 @@ begin
|
||||
FCursorBeyondEOL:=true;
|
||||
FIndentSize:=2;
|
||||
FJumpCentered:=true;
|
||||
FSourceExtensions:='.pp;.pas;.lpr;.dpr;.dpk';
|
||||
FSourceExtensions:='.pp;.pas;.lpr;.lpk;.dpr;.dpk';
|
||||
FVisibleEditorLines:=20;
|
||||
FWriteExceptions:=true;
|
||||
FSourceTools:=TAVLTree.Create(@CompareCodeToolMainSources);
|
||||
IdentifierList:=TIdentifierList.Create;
|
||||
IdentifierHistory:=TIdentifierHistoryList.Create;
|
||||
IdentifierList.History:=IdentifierHistory;
|
||||
end;
|
||||
|
||||
destructor TCodeToolManager.Destroy;
|
||||
@ -399,6 +403,7 @@ begin
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('[TCodeToolManager.Destroy] B');
|
||||
{$ENDIF}
|
||||
IdentifierHistory.Free;
|
||||
IdentifierList.Free;
|
||||
FSourceTools.FreeAndClear;
|
||||
FSourceTools.Free;
|
||||
@ -559,6 +564,7 @@ begin
|
||||
fErrorMsg:='';
|
||||
fErrorCode:=nil;
|
||||
fErrorLine:=-1;
|
||||
if IdentifierList<>nil then IdentifierList.Clear;
|
||||
MainCode:=GetMainCode(Code);
|
||||
if MainCode=nil then begin
|
||||
fErrorMsg:='TCodeToolManager.InitCurCodeTool MainCode=nil';
|
||||
|
||||
@ -44,6 +44,7 @@ interface
|
||||
{$DEFINE CTDEBUG}
|
||||
{ $DEFINE ShowFoundIdents}
|
||||
{ $DEFINE ShowFilteredIdents}
|
||||
{$DEFINE ShowHistory}
|
||||
|
||||
// new features
|
||||
{ $DEFINE IgnoreErrorAfterCursor}
|
||||
@ -60,6 +61,10 @@ uses
|
||||
|
||||
type
|
||||
TIdentCompletionTool = class;
|
||||
TIdentifierHistoryList = class;
|
||||
|
||||
//----------------------------------------------------------------------------
|
||||
// gathered identifier list
|
||||
|
||||
TIdentifierCompatibility = (
|
||||
icompExact,
|
||||
@ -88,8 +93,10 @@ type
|
||||
private
|
||||
FFilteredList: TList;
|
||||
FFlags: TIdentifierListFlags;
|
||||
FItems: TAVLTree;
|
||||
FHistory: TIdentifierHistoryList;
|
||||
FItems: TAVLTree; // tree of TIdentifierListItem
|
||||
FPrefix: string;
|
||||
procedure SetHistory(const AValue: TIdentifierHistoryList);
|
||||
procedure UpdateFilteredList;
|
||||
function GetFilteredItems(Index: integer): TIdentifierListItem;
|
||||
procedure SetPrefix(const AValue: string);
|
||||
@ -104,7 +111,39 @@ type
|
||||
property Prefix: string read FPrefix write SetPrefix;
|
||||
property FilteredItems[Index: integer]: TIdentifierListItem
|
||||
read GetFilteredItems;
|
||||
property History: TIdentifierHistoryList read FHistory write SetHistory;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------
|
||||
// history list
|
||||
|
||||
TIdentHistListItem = class
|
||||
public
|
||||
Identifier: string;
|
||||
NodeDesc: TCodeTreeNodeDesc;
|
||||
ParamList: string;
|
||||
HistoryIndex: integer;
|
||||
end;
|
||||
|
||||
TIdentifierHistoryList = class
|
||||
private
|
||||
FCapacity: integer;
|
||||
FItems: TAVLTree; // tree of TIdentHistListItem
|
||||
procedure SetCapacity(const AValue: integer);
|
||||
function FindItem(NewItem: TIdentifierListItem): TAVLTreeNode;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
procedure Add(NewItem: TIdentifierListItem);
|
||||
function GetHistoryIndex(AnItem: TIdentifierListItem): integer;
|
||||
function Count: integer;
|
||||
public
|
||||
property Capacity: integer read FCapacity write SetCapacity;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------
|
||||
// TIdentCompletionTool
|
||||
|
||||
TIdentCompletionTool = class(TFindDeclarationTool)
|
||||
private
|
||||
@ -167,10 +206,47 @@ begin
|
||||
|
||||
// then sort alpabetically (lower is better)
|
||||
Result:=CompareIdentifiers(Item1.Identifier,Item2.Identifier);
|
||||
end;
|
||||
|
||||
function CompareIdentHistListItem(Data1, Data2: Pointer): integer;
|
||||
var
|
||||
Item1: TIdentHistListItem;
|
||||
Item2: TIdentHistListItem;
|
||||
begin
|
||||
Item1:=TIdentHistListItem(Data1);
|
||||
Item2:=TIdentHistListItem(Data2);
|
||||
|
||||
Result:=CompareIdentifiers(PChar(Item1.Identifier),PChar(Item2.Identifier));
|
||||
if Result<>0 then exit;
|
||||
|
||||
// no difference found
|
||||
Result:=0;
|
||||
Result:=CompareIdentifiers(PChar(Item1.ParamList),PChar(Item2.ParamList));
|
||||
end;
|
||||
|
||||
function GetParamList(IdentItem: TIdentifierListItem): string;
|
||||
begin
|
||||
Result:='';
|
||||
case IdentItem.Node.Desc of
|
||||
ctnProcedure:
|
||||
Result:=IdentItem.Tool.ExtractProcHead(IdentItem.Node,
|
||||
[phpWithoutClassKeyword,phpWithoutClassName,phpWithoutName,phpInUpperCase]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function CompareIdentItemWithHistListItem(Data1, Data2: Pointer): integer;
|
||||
var
|
||||
IdentItem: TIdentifierListItem;
|
||||
HistItem: TIdentHistListItem;
|
||||
ParamList: String;
|
||||
begin
|
||||
IdentItem:=TIdentifierListItem(Data1);
|
||||
HistItem:=TIdentHistListItem(Data2);
|
||||
|
||||
Result:=CompareIdentifiers(IdentItem.Identifier,PChar(HistItem.Identifier));
|
||||
if Result<>0 then exit;
|
||||
|
||||
ParamList:=GetParamList(IdentItem);
|
||||
if (ParamList<>'') then
|
||||
Result:=AnsiCompareText(ParamList,HistItem.ParamList);
|
||||
end;
|
||||
|
||||
{ TIdentifierList }
|
||||
@ -208,6 +284,12 @@ begin
|
||||
Exclude(FFlags,ilfFilteredListNeedsUpdate);
|
||||
end;
|
||||
|
||||
procedure TIdentifierList.SetHistory(const AValue: TIdentifierHistoryList);
|
||||
begin
|
||||
if FHistory=AValue then exit;
|
||||
FHistory:=AValue;
|
||||
end;
|
||||
|
||||
function TIdentifierList.GetFilteredItems(Index: integer): TIdentifierListItem;
|
||||
begin
|
||||
UpdateFilteredList;
|
||||
@ -239,6 +321,8 @@ end;
|
||||
|
||||
procedure TIdentifierList.Add(NewItem: TIdentifierListItem);
|
||||
begin
|
||||
if History<>nil then
|
||||
NewItem.HistoryIndex:=History.GetHistoryIndex(NewItem);
|
||||
FItems.Add(NewItem);
|
||||
Include(FFlags,ilfFilteredListNeedsUpdate);
|
||||
end;
|
||||
@ -299,7 +383,10 @@ begin
|
||||
Ident:=FoundContext.Tool.GetProcNameIdentifier(FoundContext.Node);
|
||||
|
||||
ctnProperty:
|
||||
Ident:=FoundContext.Tool.GetPropertyNameIdentifier(FoundContext.Node);
|
||||
begin
|
||||
if FoundContext.Tool.PropNodeIsTypeLess(FoundContext.Node) then exit;
|
||||
Ident:=FoundContext.Tool.GetPropertyNameIdentifier(FoundContext.Node);
|
||||
end;
|
||||
|
||||
end;
|
||||
if Ident=nil then exit;
|
||||
@ -434,5 +521,106 @@ begin
|
||||
+' "'+StringToPascalConst(copy(Tool.Src,Node.StartPos,50))+'"';
|
||||
end;
|
||||
|
||||
{ TIdentifierHistoryList }
|
||||
|
||||
procedure TIdentifierHistoryList.SetCapacity(const AValue: integer);
|
||||
begin
|
||||
if FCapacity=AValue then exit;
|
||||
FCapacity:=AValue;
|
||||
if FCapacity<1 then FCapacity:=1;
|
||||
while (FItems.Count>0) and (FItems.Count>=FCapacity) do
|
||||
FItems.FreeAndDelete(FItems.FindHighest);
|
||||
end;
|
||||
|
||||
function TIdentifierHistoryList.FindItem(NewItem: TIdentifierListItem
|
||||
): TAVLTreeNode;
|
||||
begin
|
||||
if NewItem<>nil then
|
||||
Result:=FItems.FindKey(NewItem,@CompareIdentItemWithHistListItem)
|
||||
else
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
constructor TIdentifierHistoryList.Create;
|
||||
begin
|
||||
FItems:=TAVLTree.Create(@CompareIdentHistListItem);
|
||||
FCapacity:=30;
|
||||
end;
|
||||
|
||||
destructor TIdentifierHistoryList.Destroy;
|
||||
begin
|
||||
Clear;
|
||||
FItems.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TIdentifierHistoryList.Clear;
|
||||
begin
|
||||
FItems.FreeAndClear;
|
||||
end;
|
||||
|
||||
procedure TIdentifierHistoryList.Add(NewItem: TIdentifierListItem);
|
||||
var
|
||||
OldAVLNode: TAVLTreeNode;
|
||||
NewHistItem: TIdentHistListItem;
|
||||
AnAVLNode: TAVLTreeNode;
|
||||
AdjustIndex: Integer;
|
||||
AnHistItem: TIdentHistListItem;
|
||||
begin
|
||||
if NewItem=nil then exit;
|
||||
OldAVLNode:=FindItem(NewItem);
|
||||
{$IFDEF ShowHistory}
|
||||
writeln('TIdentifierHistoryList.Add Count=',Count,' Found=',OldAVLNode<>nil,
|
||||
' ITEM: ',NewItem.AsString);
|
||||
{$ENDIF}
|
||||
if OldAVLNode<>nil then begin
|
||||
// already in tree
|
||||
NewHistItem:=TIdentHistListItem(OldAVLNode.Data);
|
||||
if NewHistItem.HistoryIndex=0 then exit;
|
||||
// must be moved -> remove it from the tree
|
||||
AdjustIndex:=NewHistItem.HistoryIndex;
|
||||
FItems.Delete(OldAVLNode);
|
||||
end else begin
|
||||
// create a new history item
|
||||
NewHistItem:=TIdentHistListItem.Create;
|
||||
NewHistItem.Identifier:=GetIdentifier(NewItem.Identifier);
|
||||
NewHistItem.NodeDesc:=NewItem.Node.Desc;
|
||||
NewHistItem.ParamList:=GetParamList(NewItem);
|
||||
AdjustIndex:=0;
|
||||
end;
|
||||
NewHistItem.HistoryIndex:=0;
|
||||
// adjust all other HistoryIndex
|
||||
AnAVLNode:=Fitems.FindLowest;
|
||||
while AnAVLNode<>nil do begin
|
||||
AnHistItem:=TIdentHistListItem(AnAVLNode.Data);
|
||||
if AnHistItem.HistoryIndex>=AdjustIndex then
|
||||
inc(AnHistItem.HistoryIndex);
|
||||
AnAVLNode:=FItems.FindSuccessor(AnAVLNode);
|
||||
end;
|
||||
if (FItems.Count>0) and (FItems.Count>=FCapacity) then
|
||||
FItems.FreeAndDelete(FItems.FindHighest);
|
||||
FItems.Add(NewHistItem);
|
||||
{$IFDEF ShowHistory}
|
||||
writeln('TIdentifierHistoryList.Added Count=',Count);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TIdentifierHistoryList.GetHistoryIndex(AnItem: TIdentifierListItem
|
||||
): integer;
|
||||
var
|
||||
AnAVLNode: TAVLTreeNode;
|
||||
begin
|
||||
AnAVLNode:=FindItem(AnItem);
|
||||
if AnAVLNode=nil then
|
||||
Result:=3333333 // a very high value
|
||||
else
|
||||
Result:=TIdentHistListItem(AnAVLNode.Data).HistoryIndex;
|
||||
end;
|
||||
|
||||
function TIdentifierHistoryList.Count: integer;
|
||||
begin
|
||||
Result:=FItems.Count;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -255,6 +255,7 @@ type
|
||||
function NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode): boolean;
|
||||
function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
|
||||
function PropertyNodeHasParamList(PropNode: TCodeTreeNode): boolean;
|
||||
function PropNodeIsTypeLess(PropNode: TCodeTreeNode): boolean;
|
||||
function ProcNodeHasParamList(ProcNode: TCodeTreeNode): boolean;
|
||||
|
||||
procedure MoveCursorToUsesEnd(UsesNode: TCodeTreeNode);
|
||||
@ -3966,7 +3967,24 @@ begin
|
||||
ReadNextAtom; // read 'property'
|
||||
ReadNextAtom; // read name
|
||||
ReadNextAtom;
|
||||
Result:=AtomIsChar('[');
|
||||
Result:=(CurPos.Flag=cafEdgedBracketOpen);
|
||||
end;
|
||||
|
||||
function TPascalParserTool.PropNodeIsTypeLess(PropNode: TCodeTreeNode
|
||||
): boolean;
|
||||
begin
|
||||
|
||||
// ToDo: ppu, ppw, dcu
|
||||
|
||||
Result:=false;
|
||||
MoveCursorToNodeStart(PropNode);
|
||||
ReadNextAtom; // read 'property'
|
||||
ReadNextAtom; // read name
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag=cafEdgedBracketOpen then
|
||||
ReadTilBracketClose(true);
|
||||
ReadNextAtom;
|
||||
Result:=(CurPos.Flag<>cafColon);
|
||||
end;
|
||||
|
||||
function TPascalParserTool.ProcNodeHasParamList(ProcNode: TCodeTreeNode
|
||||
|
||||
@ -135,6 +135,7 @@ type
|
||||
TSynBaseCompletion = class(TComponent)
|
||||
private
|
||||
Form: TSynBaseCompletionForm;
|
||||
OldPersistentCaret: boolean;
|
||||
FOnExecute: TNotifyEvent;
|
||||
FWidth: Integer;
|
||||
RFAnsi: boolean;
|
||||
@ -307,6 +308,7 @@ begin
|
||||
Scroll.Visible := True;
|
||||
FTextColor:=clBlack;
|
||||
FTextSelectedColor:=clWhite;
|
||||
Caption:='Completion';
|
||||
{$ENDIF}
|
||||
Visible := false;
|
||||
FFontHeight := Canvas.TextHeight('Cyrille de Brebisson')+2;
|
||||
@ -655,8 +657,13 @@ end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure TSynBaseCompletion.Execute(s: string; x, y: integer);
|
||||
{$IFDEF SYN_LAZARUS}
|
||||
var
|
||||
CurSynEdit: TSynEdit;
|
||||
{$ENDIF}
|
||||
begin
|
||||
SetCaretRespondToFocus(TCustomSynEdit(Form.CurrentEditor).Handle,false);
|
||||
//writeln('');
|
||||
//writeln('TSynBaseCompletion.Execute ',Form.CurrentEditor.Name);
|
||||
CurrentString := s;
|
||||
if Assigned(OnExecute) then
|
||||
OnExecute(Self);
|
||||
@ -669,7 +676,12 @@ begin
|
||||
OnCancel(Form);
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
if (Form.CurrentEditor is TSynEdit) then begin
|
||||
CurSynEdit:=TSynEdit(Form.CurrentEditor);
|
||||
OldPersistentCaret:=eoPersistentCaret in CurSynEdit.Options;
|
||||
CurSynEdit.Options:=CurSynEdit.Options+[eoPersistentCaret];
|
||||
end;
|
||||
Form.SetBounds(x,y,Form.Width,Form.Height);
|
||||
Form.Color:=clNone;
|
||||
{$ELSE}
|
||||
@ -790,7 +802,18 @@ begin
|
||||
end;
|
||||
|
||||
procedure TSynBaseCompletion.Deactivate;
|
||||
{$IFDEF SYN_LAZARUS}
|
||||
var
|
||||
CurSynEdit: TSynEdit;
|
||||
{$ENDIF}
|
||||
begin
|
||||
{$IFDEF SYN_LAZARUS}
|
||||
if (not OldPersistentCaret)
|
||||
and (Form<>nil) and (Form.CurrentEditor is TSynEdit) then begin
|
||||
CurSynEdit:=TSynEdit(Form.CurrentEditor);
|
||||
CurSynEdit.Options:=CurSynEdit.Options-[eoPersistentCaret];
|
||||
end;
|
||||
{$ENDIF}
|
||||
if Assigned(Form) then Form.Deactivate;
|
||||
end;
|
||||
|
||||
|
||||
@ -34,8 +34,6 @@ unit GTKWinapiWindow;
|
||||
|
||||
interface
|
||||
|
||||
{$DEFINE WinAPIChilds : use GtkFixed as client area, to allow childs }
|
||||
|
||||
uses
|
||||
{$IFDEF gtk2}
|
||||
glib2, gdk2pixbuf, gdk2, gtk2,
|
||||
@ -44,6 +42,8 @@ uses
|
||||
{$ENDIF}
|
||||
SysUtils;
|
||||
|
||||
{ $Define VerboseCaret}
|
||||
|
||||
type
|
||||
PGTKAPIWidget = ^TGTKAPIWidget;
|
||||
TGTKAPIWidget = record
|
||||
@ -68,6 +68,8 @@ procedure GTKAPIWidget_SetCaretPos(APIWidget: PGTKAPIWidget; X, Y: Integer);
|
||||
procedure GTKAPIWidget_GetCaretPos(APIWidget: PGTKAPIWidget; var X, Y: Integer);
|
||||
procedure GTKAPIWidget_SetCaretRespondToFocus(APIWidget: PGTKAPIWidget;
|
||||
ShowHideOnFocus: boolean);
|
||||
procedure GTKAPIWidget_GetCaretRespondToFocus(APIWidget: PGTKAPIWidget;
|
||||
var ShowHideOnFocus: boolean);
|
||||
|
||||
implementation
|
||||
|
||||
@ -92,10 +94,7 @@ type
|
||||
PGTKAPIWidgetClient = ^TGTKAPIWidgetClient;
|
||||
TGTKAPIWidgetClient = record
|
||||
// ! the Widget must be the first attribute of the record !
|
||||
Widget: {$IFDEF WinApiChilds}TGtkFixed{$ELSE}TGtkWidget{$ENDIF};
|
||||
{$IFNDEF WinApiChilds}
|
||||
OtherWindow: PGDKWindow;
|
||||
{$ENDIF}
|
||||
Widget: TGtkFixed;
|
||||
Caret: TCaretInfo;
|
||||
end;
|
||||
|
||||
@ -135,7 +134,8 @@ procedure GTKAPIWidgetClient_GetCaretPos(Client: PGTKAPIWidgetClient;
|
||||
var X, Y: Integer); forward;
|
||||
procedure GTKAPIWidgetClient_SetCaretRespondToFocus(Client: PGTKAPIWidgetClient;
|
||||
ShowHideOnFocus: boolean); forward;
|
||||
|
||||
procedure GTKAPIWidgetClient_GetCaretRespondToFocus(Client: PGTKAPIWidgetClient;
|
||||
var ShowHideOnFocus: boolean); forward;
|
||||
|
||||
|
||||
function GTKAPIWidgetClient_Timer(Client: Pointer): gint; cdecl;
|
||||
@ -156,17 +156,10 @@ procedure GTKAPIWidgetClient_Realize(Widget: PGTKWidget); cdecl;
|
||||
var
|
||||
Attributes: TGdkWindowAttr;
|
||||
AttributesMask: gint;
|
||||
{$IFNDEF WinAPIChilds}
|
||||
Client: PGTKAPIWidgetClient;
|
||||
{$ENDIF}
|
||||
begin
|
||||
// Assert(False, 'Trace:[GTKAPIWidgetClient_Realize]');
|
||||
gtk_widget_set_flags(Widget, GTK_REALIZED);
|
||||
|
||||
{$IFNDEF WinAPIChilds}
|
||||
Client := PGTKAPIWidgetClient(Widget);
|
||||
{$ENDIF}
|
||||
|
||||
with Attributes do
|
||||
begin
|
||||
Window_type := gdk_window_child;
|
||||
@ -199,11 +192,6 @@ begin
|
||||
end;
|
||||
// AttributesMask := AttributesMask or GDK_WA_CURSOR;
|
||||
|
||||
{$IFNDEF WinApiChilds}
|
||||
Client^.OtherWindow := gdk_window_new(Widget^.Window, @Attributes, AttributesMask);
|
||||
gdk_window_set_user_data (Client^.OtherWindow, Client);
|
||||
{$ENDIF}
|
||||
|
||||
Widget^.theStyle := gtk_style_attach(Widget^.theStyle, Widget^.Window);
|
||||
|
||||
gtk_style_set_background (Widget^.theStyle, Widget^.Window, GTK_STATE_NORMAL);
|
||||
@ -357,9 +345,7 @@ const
|
||||
);
|
||||
begin
|
||||
if (TheType = 0) then
|
||||
TheType := gtk_type_unique(
|
||||
{$IFDEF WinApiChilds}gtk_fixed_type{$ELSE}gtk_widget_type{$ENDIF},
|
||||
@Info);
|
||||
TheType := gtk_type_unique(gtk_fixed_type,@Info);
|
||||
Result := TheType;
|
||||
end;
|
||||
|
||||
@ -376,6 +362,9 @@ begin
|
||||
WriteLn('WARNING: [GTKAPIWidgetClient_HideCaret] Got nil client');
|
||||
Exit;
|
||||
end;
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('GTKAPIWidgetClient_HideCaret ',HexStr(Cardinal(Client),8),' ShowHideOnFocus=',Client^.Caret.ShowHideOnFocus);
|
||||
{$ENDIF}
|
||||
Client^.Caret.Visible := False;
|
||||
GTKAPIWidgetClient_DrawCaret(Client);
|
||||
end;
|
||||
@ -408,6 +397,10 @@ begin
|
||||
Timer := 0;
|
||||
end;
|
||||
if IsDrawn and ((not Visible) or Blinking) then begin
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('GTKAPIWidgetClient_DrawCaret ',HexStr(Cardinal(Client),8),
|
||||
' Hiding Caret IsDrawn=',IsDrawn,' Visible=',Visible,' Blinking=',Blinking);
|
||||
{$ENDIF}
|
||||
// hide caret
|
||||
if (BackPixmap <> nil) and (Widget<>nil) and (Widget^.theStyle<>nil)
|
||||
then gdk_draw_pixmap(
|
||||
@ -446,12 +439,14 @@ begin
|
||||
);
|
||||
|
||||
// draw caret
|
||||
{writeln('GTKAPIWidgetClient_DrawCaret B Client=',HexStr(Cardinal(Client),8)
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('GTKAPIWidgetClient_DrawCaret B Client=',HexStr(Cardinal(Client),8)
|
||||
,' ',cardinal(PGTKWidget(Client)^.theStyle)
|
||||
,' ',cardinal(PGTKWidget(Client)^.Window)
|
||||
,' ',Width
|
||||
,' ',Height
|
||||
);}
|
||||
);
|
||||
{$ENDIF}
|
||||
if (PGTKWidget(Client)^.theStyle<>nil)
|
||||
and (PGTKWidget(Client)^.Window<>nil)
|
||||
and (Width>0) and (Height>0) then begin
|
||||
@ -460,6 +455,9 @@ begin
|
||||
PGTKWidget(Client)^.theStyle)^.fg_gc[GC_STATE[Integer(Pixmap) <> 1]];
|
||||
//gdk_gc_get_values(ForeGroundGC,@ForeGroundGCValues);
|
||||
//OldGdkFunction:=ForeGroundGCValues.thefunction;
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('GTKAPIWidgetClient_DrawCaret ',HexStr(Cardinal(Client),8),' Real Drawing Caret ');
|
||||
{$ENDIF}
|
||||
gdk_gc_set_function(ForeGroundGC,GDK_invert);
|
||||
try
|
||||
// draw the caret
|
||||
@ -497,6 +495,9 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('GTKAPIWidgetClient_ShowCaret ',HexStr(Cardinal(Client),8));
|
||||
{$ENDIF}
|
||||
Client^.Caret.Visible := True;
|
||||
GTKAPIWidgetClient_DrawCaret(Client);
|
||||
end;
|
||||
@ -506,7 +507,9 @@ procedure GTKAPIWidgetClient_CreateCaret(Client: PGTKAPIWidgetClient;
|
||||
var
|
||||
IsVisible: Boolean;
|
||||
begin
|
||||
//writeln('********** [GTKAPIWidgetClient_CreateCaret] A Client=',HexStr(Cardinal(Client),8),' Width=',AWidth,' Height=',AHeight,' Bitmap=',ABitmap<>nil);
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('********** [GTKAPIWidgetClient_CreateCaret] A Client=',HexStr(Cardinal(Client),8),' Width=',AWidth,' Height=',AHeight,' Bitmap=',ABitmap<>nil);
|
||||
{$ENDIF}
|
||||
if Client = nil
|
||||
then begin
|
||||
WriteLn('WARNING: [GTKAPIWidgetClient_CreateCaret] Got nil client');
|
||||
@ -534,7 +537,9 @@ end;
|
||||
|
||||
procedure GTKAPIWidgetClient_DestroyCaret(Client: PGTKAPIWidgetClient);
|
||||
begin
|
||||
//writeln('********** [GTKAPIWidgetClient_DestroyCaret] A Client=',HexStr(Cardinal(Client),8));
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('********** [GTKAPIWidgetClient_DestroyCaret] A Client=',HexStr(Cardinal(Client),8));
|
||||
{$ENDIF}
|
||||
if Client = nil
|
||||
then begin
|
||||
WriteLn('WARNING: [GTKAPIWidgetClient_DestroyCaret] Got nil client');
|
||||
@ -550,7 +555,9 @@ begin
|
||||
end;
|
||||
Pixmap := nil;
|
||||
end;
|
||||
//writeln('********** B[GTKAPIWidgetClient_DestroyCaret] A Client=',HexStr(Cardinal(Client),8));
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('********** B[GTKAPIWidgetClient_DestroyCaret] A Client=',HexStr(Cardinal(Client),8));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure GTKAPIWidgetClient_SetCaretPos(Client: PGTKAPIWidgetClient;
|
||||
@ -558,7 +565,9 @@ procedure GTKAPIWidgetClient_SetCaretPos(Client: PGTKAPIWidgetClient;
|
||||
var
|
||||
IsVisible: Boolean;
|
||||
begin
|
||||
//Writeln('[GTKAPIWIDGETCLIENT] SetCaretPos '+inttostr(ax)+','+Inttostr(ay));
|
||||
{$IFDEF VerboseCaret}
|
||||
Writeln('[GTKAPIWIDGETCLIENT] SetCaretPos '+inttostr(ax)+','+Inttostr(ay));
|
||||
{$ENDIF}
|
||||
|
||||
if Client = nil
|
||||
then begin
|
||||
@ -592,7 +601,10 @@ end;
|
||||
procedure GTKAPIWidgetClient_SetCaretRespondToFocus(Client: PGTKAPIWidgetClient;
|
||||
ShowHideOnFocus: boolean);
|
||||
begin
|
||||
if Client = nil
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('[GTKAPIWidgetClient_SetCaretRespondToFocus] A ',ShowHideOnFocus);
|
||||
{$ENDIF}
|
||||
if Client = nil
|
||||
then begin
|
||||
WriteLn(
|
||||
'WARNING: [GTKAPIWidgetClient_SetCaretRespondToFocus] Got nil client');
|
||||
@ -602,6 +614,19 @@ begin
|
||||
Client^.Caret.ShowHideOnFocus:=ShowHideOnFocus;
|
||||
end;
|
||||
|
||||
procedure GTKAPIWidgetClient_GetCaretRespondToFocus(Client: PGTKAPIWidgetClient;
|
||||
var ShowHideOnFocus: boolean);
|
||||
begin
|
||||
if Client = nil
|
||||
then begin
|
||||
WriteLn(
|
||||
'WARNING: [GTKAPIWidgetClient_GetCaretRespondToFocus] Got nil client');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
ShowHideOnFocus:=Client^.Caret.ShowHideOnFocus;
|
||||
end;
|
||||
|
||||
//---------------------------------------------------------------------------
|
||||
// GTKAPIWidget
|
||||
//---------------------------------------------------------------------------
|
||||
@ -721,7 +746,9 @@ end;
|
||||
|
||||
procedure GTKAPIWidget_HideCaret(APIWidget: PGTKAPIWidget);
|
||||
begin
|
||||
//writeln('[GTKAPIWidget_HideCaret] A');
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('[GTKAPIWidget_HideCaret] A');
|
||||
{$ENDIF}
|
||||
if APIWidget = nil
|
||||
then begin
|
||||
WriteLn('WARNING: [GTKAPIWidget_HideCaret] Got nil client');
|
||||
@ -732,7 +759,10 @@ end;
|
||||
|
||||
procedure GTKAPIWidget_ShowCaret(APIWidget: PGTKAPIWidget);
|
||||
begin
|
||||
if APIWidget = nil
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('[GTKAPIWidget_ShowCaret] A');
|
||||
{$ENDIF}
|
||||
if APIWidget = nil
|
||||
then begin
|
||||
WriteLn('WARNING: [GTKAPIWidget_ShowCaret] Got nil client');
|
||||
Exit;
|
||||
@ -742,7 +772,10 @@ end;
|
||||
|
||||
procedure GTKAPIWidget_SetCaretPos(APIWidget: PGTKAPIWidget; X, Y: Integer);
|
||||
begin
|
||||
if APIWidget = nil
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('[GTKAPIWidget_SetCaretPos] A');
|
||||
{$ENDIF}
|
||||
if APIWidget = nil
|
||||
then begin
|
||||
WriteLn('WARNING: [GTKAPIWidget_SetCaretPos] Got nil client');
|
||||
Exit;
|
||||
@ -763,7 +796,10 @@ end;
|
||||
procedure GTKAPIWidget_SetCaretRespondToFocus(APIWidget: PGTKAPIWidget;
|
||||
ShowHideOnFocus: boolean);
|
||||
begin
|
||||
if APIWidget = nil
|
||||
{$IFDEF VerboseCaret}
|
||||
writeln('[GTKAPIWidget_SetCaretRespondToFocus] A ',ShowHideOnFocus);
|
||||
{$ENDIF}
|
||||
if APIWidget = nil
|
||||
then begin
|
||||
WriteLn('WARNING: [GTKAPIWidget_SetCaretRespondToFocus] Got nil client');
|
||||
Exit;
|
||||
@ -772,11 +808,27 @@ begin
|
||||
PGTKAPIWidgetClient(APIWidget^.Client), ShowHideOnFocus);
|
||||
end;
|
||||
|
||||
procedure GTKAPIWidget_GetCaretRespondToFocus(APIWidget: PGTKAPIWidget;
|
||||
var ShowHideOnFocus: boolean);
|
||||
begin
|
||||
if APIWidget = nil
|
||||
then begin
|
||||
WriteLn('WARNING: [GTKAPIWidget_GetCaretRespondToFocus] Got nil client');
|
||||
Exit;
|
||||
end;
|
||||
GTKAPIWidgetClient_GetCaretRespondToFocus(
|
||||
PGTKAPIWidgetClient(APIWidget^.Client), ShowHideOnFocus);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.43 2002/12/30 17:24:08 mattias
|
||||
added history to identifier completion
|
||||
|
||||
Revision 1.42 2002/12/23 10:28:02 mattias
|
||||
fixed setting background
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user