summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--prototypes/fpgui2/tests/edittest.lpi5
-rw-r--r--src/corelib/fpgfx.pas49
-rw-r--r--src/corelib/gfxbase.pas22
-rw-r--r--src/corelib/x11/fpgfx_package.lpk28
-rw-r--r--src/corelib/x11/fpgfx_package.pas4
-rw-r--r--src/corelib/x11/gfx_x11.pas126
-rw-r--r--src/gui/gui_edit.pas3
7 files changed, 197 insertions, 40 deletions
diff --git a/prototypes/fpgui2/tests/edittest.lpi b/prototypes/fpgui2/tests/edittest.lpi
index ae200625..2879bbde 100644
--- a/prototypes/fpgui2/tests/edittest.lpi
+++ b/prototypes/fpgui2/tests/edittest.lpi
@@ -50,6 +50,11 @@
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
+ <Linking>
+ <Debugging>
+ <UseLineInfoUnit Value="False"/>
+ </Debugging>
+ </Linking>
<Other>
<CustomOptions Value="-FUunits
"/>
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index 5138caf3..7160f1c4 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -42,7 +42,7 @@ const
// version and name constants
fpGUIVersion = '0.5.1';
- fpGUIName = 'fpGUI Library';
+ fpGUIName = 'fpGUI Toolkit';
type
@@ -242,14 +242,20 @@ type
property Width: integer read FWidth;
property Height: integer read FHeight;
end;
+
+
+ TfpgClipboard = class(TfpgClipboardImpl)
+ end;
+
var
fpgStyle: TfpgStyle; { TODO -ograemeg : move this into fpgApplication }
fpgCaret: TfpgCaret; { TODO -ograemeg : move this into fpgApplication }
fpgImages: TfpgImages; { TODO -ograemeg : move this into fpgApplication }
-// Application singleton
+// Application & Clipboard singletons
function fpgApplication: TfpgApplication;
+function fpgClipboard: TfpgClipboard;
// Fonts (easy access function)
function fpgGetFont(const afontdesc: string): TfpgFont;
@@ -304,10 +310,11 @@ uses
gfx_extinterpolation; // only so that it get auto compiled
var
- fpgTimers: TList;
+ fpgTimers: TList;
fpgNamedColors: array[0..255] of TfpgColor;
- fpgNamedFonts: TList;
- uApplication: TfpgApplication;
+ fpgNamedFonts: TList;
+ uApplication: TfpgApplication;
+ uClipboard: TfpgClipboard;
uMsgQueueList: TList;
const
@@ -592,13 +599,20 @@ begin
end;
end;
-function fpgApplication: TfpgApplication;
+function fpgApplication: TfpgApplication;
begin
if not Assigned(uApplication) then
uApplication := TfpgApplication.Create;
result := uApplication;
end;
+function fpgClipboard: TfpgClipboard;
+begin
+ if not Assigned(uClipboard) then
+ uClipboard := TfpgClipboard.Create;
+ Result := uClipboard;
+end;
+
function fpgColorToRGB(col: TfpgColor): TfpgColor;
begin
if (col and cl_BaseNamedColor) <> 0 then
@@ -671,15 +685,20 @@ begin
FScreenHeight := -1;
FModalFormStack := TList.Create;
- inherited Create(aparams);
+ try
+ inherited Create(aparams);
- if IsInitialized then
- begin
- FScreenWidth := GetScreenWidth;
- FScreenHeight := GetScreenHeight;
- end;
+ if IsInitialized then
+ begin
+ FScreenWidth := GetScreenWidth;
+ FScreenHeight := GetScreenHeight;
+ end;
- FDefaultFont := GetFont(FPG_DEFAULT_FONT_DESC);
+ FDefaultFont := GetFont(FPG_DEFAULT_FONT_DESC);
+ except
+ on E: Exception do
+ writeln(E.Message);
+ end;
end;
destructor TfpgApplication.Destroy;
@@ -759,7 +778,7 @@ end;
procedure TfpgApplication.Initialize;
begin
- {$Note Remember to process parameters!! }
+ { TODO : Remember to process parameters!! }
if IsInitialized then
InternalInit
else
@@ -1413,6 +1432,7 @@ end;
initialization
uApplication := nil;
+ uClipboard := nil;
uMsgQueueList := nil;
fpgTimers := nil;
fpgCaret := nil;
@@ -1421,6 +1441,7 @@ initialization
fpgInitMsgQueue;
finalization;
+ uClipboard.Free;
uApplication.Free;
end.
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas
index 499b98f9..ed8aeb43 100644
--- a/src/corelib/gfxbase.pas
+++ b/src/corelib/gfxbase.pas
@@ -6,7 +6,8 @@ interface
uses
Classes,
- SysUtils;
+ SysUtils,
+ gfx_impl;
type
TfpgCoord = integer; // we might use floating point coordinates in the future...
@@ -403,6 +404,18 @@ type
// property FormCount...
// property Forms[]...
end;
+
+
+ TfpgClipboardBase = class(TObject)
+ protected
+ FClipboardWndHandle: TfpgWinHandle;
+ function DoGetText: string; virtual; abstract;
+ procedure DoSetText(const AValue: string); virtual; abstract;
+ procedure InitClipboard; virtual; abstract;
+ public
+ constructor Create;
+ property Text: string read DoGetText write DoSetText;
+ end;
{ ******** Helper functions ******** }
@@ -1665,5 +1678,12 @@ begin
end;
end;
+{ TfpgClipboardBase }
+
+constructor TfpgClipboardBase.Create;
+begin
+ InitClipboard;
+end;
+
end.
diff --git a/src/corelib/x11/fpgfx_package.lpk b/src/corelib/x11/fpgfx_package.lpk
index e6790455..91b61140 100644
--- a/src/corelib/x11/fpgfx_package.lpk
+++ b/src/corelib/x11/fpgfx_package.lpk
@@ -24,7 +24,7 @@
<License Value="Modified LGPL
"/>
<Version Minor="5" Release="1"/>
- <Files Count="18">
+ <Files Count="17">
<Item1>
<Filename Value="x11_xft.pas"/>
<UnitName Value="x11_xft"/>
@@ -70,33 +70,29 @@
<UnitName Value="gfx_cmdlineparams"/>
</Item11>
<Item12>
- <Filename Value="../gfx_clipboard.pas"/>
- <UnitName Value="gfx_clipboard"/>
- </Item12>
- <Item13>
<Filename Value="gfx_utils.pas"/>
<UnitName Value="gfx_utils"/>
- </Item13>
- <Item14>
+ </Item12>
+ <Item13>
<Filename Value="../gfx_popupwindow.pas"/>
<UnitName Value="gfx_popupwindow"/>
- </Item14>
- <Item15>
+ </Item13>
+ <Item14>
<Filename Value="gfx_impl.pas"/>
<UnitName Value="gfx_impl"/>
- </Item15>
- <Item16>
+ </Item14>
+ <Item15>
<Filename Value="../gfx_command_intf.pas"/>
<UnitName Value="gfx_command_intf"/>
- </Item16>
- <Item17>
+ </Item15>
+ <Item16>
<Filename Value="../gfx_wuline.pas"/>
<UnitName Value="gfx_wuline"/>
- </Item17>
- <Item18>
+ </Item16>
+ <Item17>
<Filename Value="../gfx_imagelist.pas"/>
<UnitName Value="gfx_imagelist"/>
- </Item18>
+ </Item17>
</Files>
<LazDoc Paths="../../../docs/xml/corelib/;../../../docs/xml/corelib/x11/;../../../docs/xml/corelib/gdi/"/>
<RequiredPkgs Count="1">
diff --git a/src/corelib/x11/fpgfx_package.pas b/src/corelib/x11/fpgfx_package.pas
index b1b3678a..ee7e9a84 100644
--- a/src/corelib/x11/fpgfx_package.pas
+++ b/src/corelib/x11/fpgfx_package.pas
@@ -9,8 +9,8 @@ interface
uses
x11_xft, x11_keyconv, gfxbase, gfx_x11, fpgfx, gfx_stdimages, gfx_imgfmt_bmp,
gfx_widget, gfx_UTF8utils, gfx_extinterpolation, gfx_cmdlineparams,
- gfx_clipboard, gfx_utils, gfx_popupwindow, gfx_impl, gfx_command_intf,
- gfx_wuline, gfx_imagelist;
+ gfx_utils, gfx_popupwindow, gfx_impl, gfx_command_intf, gfx_wuline,
+ gfx_imagelist;
implementation
diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas
index c6ccf16a..de987f0b 100644
--- a/src/corelib/x11/gfx_x11.pas
+++ b/src/corelib/x11/gfx_x11.pas
@@ -165,7 +165,7 @@ type
DefaultScreen: integer;
DefaultVisual: PVisual;
DefaultColorMap: TColorMap;
- RootWindow: TfpgWinHandle;
+ FRootWindow: TfpgWinHandle;
xia_clipboard: TAtom;
xia_motif_wm_hints: TAtom;
xia_wm_protocols: TAtom;
@@ -186,9 +186,21 @@ type
function GetScreenWidth: TfpgCoord;
function GetScreenHeight: TfpgCoord;
property Display: PXDisplay read FDisplay;
+ property RootWindow: TfpgWinHandle read FRootWindow;
end;
+ TfpgClipboardImpl = class(TfpgClipboardBase)
+ private
+ FWaitingForSelection: Boolean;
+ protected
+ FClipboardText: string;
+ function DoGetText: string; override;
+ procedure DoSetText(const AValue: string); override;
+ procedure InitClipboard; override;
+ end;
+
+
implementation
uses
@@ -395,6 +407,65 @@ begin
Result := '#' + IntToStr(Event);
end;
+// clipboard event
+procedure ProcessSelection(var ev: TXEvent);
+var
+ s: string;
+ actual: TAtom;
+ format: integer;
+ count, remaining: longword;
+ data: PChar;
+begin
+ if ev.xselection._property > 0 then
+ begin
+ XGetWindowProperty(xapplication.Display, ev.xselection.requestor,
+ ev.xselection._property, 0, 16000,
+ false, // delete
+ 0, // type
+ @actual, @format, @count, @remaining,
+ @data);
+ s := data;
+
+ fpgClipboard.FClipboardText := s;
+ XFree(data);
+ end
+ else
+ begin
+ fpgClipboard.FClipboardText := '';
+ end;
+
+ fpgClipboard.FWaitingForSelection := false;
+end;
+
+// clipboard event
+procedure ProcessSelectionRequest(var ev: TXEvent);
+var
+ e: TXSelectionEvent;
+ a: TAtom;
+begin
+ e._type := SelectionNotify;
+ e.requestor := ev.xselectionrequest.requestor;
+ e.selection := ev.xselectionrequest.selection;
+ e.selection := xapplication.xia_clipboard;
+ e.target := ev.xselectionrequest.target;
+ e.time := ev.xselectionrequest.time;
+ e._property := ev.xselectionrequest._property;
+
+ if e.target = xapplication.xia_targets then
+ begin
+ a := XA_STRING;
+ XChangeProperty(xapplication.Display, e.requestor, e._property,
+ XA_ATOM, sizeof(TAtom)*8, 0, PByte(@a), sizeof(TAtom));
+ end
+ else
+ begin
+ XChangeProperty(xapplication.Display, e.requestor, e._property, e.target,
+ 8, 0, PByte(@fpgClipboard.FClipboardText[1]), Length(fpgClipboard.FClipboardText));
+ end;
+
+ XSendEvent(xapplication.Display, e.requestor, false, 0, @e );
+end;
+
{ TfpgApplicationImpl }
function TfpgApplicationImpl.ConvertShiftState(AState: Cardinal): TShiftState;
@@ -537,11 +608,14 @@ begin
FDisplay := XOpenDisplay(PChar(aparams));
if FDisplay = nil then
- Exit; //==>
+// begin
+ raise Exception.Create('fpGUI-X11: Could not open the display. Is your X11 server running?');
+// halt(1);
+// end;
Terminated := False;
DefaultScreen := XDefaultScreen(Display);
- RootWindow := XRootWindow(FDisplay, DefaultScreen);
+ FRootWindow := XRootWindow(FDisplay, DefaultScreen);
DefaultBackground := XBlackPixel(FDisplay, DefaultScreen);
DefaultForeground := XWhitePixel(FDisplay, DefaultScreen);
@@ -989,7 +1063,6 @@ begin
end;
end;
-{
X.SelectionNotify:
begin
ProcessSelection(ev);
@@ -999,7 +1072,16 @@ begin
begin
ProcessSelectionRequest(ev);
end;
-}
+
+ X.SelectionClear:
+ begin
+ { TODO : Not sure if I am handling this correctly? }
+ if ev.xselectionclear.selection = xia_clipboard then
+ begin
+ fpgClipboard.FClipboardText := '';
+ Exit;
+ end;
+ end;
X.FocusIn:
fpgPostMessage(nil, FindWindowByHandle(ev.xfocus.window), FPGM_ACTIVATE);
@@ -1908,6 +1990,40 @@ begin
Result := @FXimgMask;
end;
+{ TfpgClipboardImpl }
+
+function TfpgClipboardImpl.DoGetText: string;
+begin
+ XConvertSelection(xapplication.Display, xapplication.xia_clipboard,
+ XA_STRING, xapplication.xia_clipboard, FClipboardWndHandle, 0);
+
+ FWaitingForSelection := True;
+ fpgDeliverMessages; // delivering the remaining messages
+
+ repeat
+ fpgWaitWindowMessage;
+ fpgDeliverMessages;
+ until not FWaitingForSelection;
+
+ Result := FClipboardText;
+end;
+
+procedure TfpgClipboardImpl.DoSetText(const AValue: string);
+begin
+ FClipboardText := AValue;
+ XSetSelectionOwner(xapplication.Display, xapplication.xia_clipboard,
+ FClipboardWndHandle, 0);
+end;
+
+procedure TfpgClipboardImpl.InitClipboard;
+begin
+ FWaitingForSelection := False;
+ FClipboardWndHandle := XCreateSimpleWindow(xapplication.Display,
+ xapplication.RootWindow, 10, 10, 10, 10, 0, 0, 0);
+end;
+
+
+
initialization
xapplication := nil;
diff --git a/src/gui/gui_edit.pas b/src/gui/gui_edit.pas
index 8f6358c5..3a1b5aa2 100644
--- a/src/gui/gui_edit.pas
+++ b/src/gui/gui_edit.pas
@@ -140,8 +140,7 @@ function CreateEdit(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgEdit;
implementation
uses
- gfx_UTF8utils,
- gfx_clipboard;
+ gfx_UTF8utils;
const
// internal popupmenu item names
generated by cgit v1.2.3-54-g00ecf (git 2.44.0) at 2024-08-19 00:08:55 +0000