Persistent clipboard support under X11.

Some desktop enviroments or window managers include support for a clipboard
manager. This clipboard manager can make the content of the clipboard persistent
even after the source application closed down.

1 files changed, 158 insertions, 12 deletions

diff --git a/src/corelib/x11/fpg_x11.pas b/src/corelib/x11/fpg_x11.pas
index 37b2b469..5b62ef5c 100644
--- a/src/corelib/x11/fpg_x11.pas
+++ b/src/corelib/x11/fpg_x11.pas
@@ -315,6 +315,7 @@ type
     xia_wm_delete_window: TAtom;
     xia_wm_state: TAtom;
     xia_targets: TAtom;
+    xia_save_targets: TAtom;
     netlayer: TNETWindowLayer;
     InputMethod: PXIM;
     InputContext: PXIC;
@@ -341,11 +342,17 @@ type
   TfpgX11Clipboard = class(TfpgClipboardBase)
   private
     FWaitingForSelection: Boolean;
+    FOwnsSelection: Boolean;
+    procedure   SendClipboardToManager;
+    procedure   DoLostSelection;
+    procedure   DoSetTargets(AWin: TWindow; AProperty: TAtom);
   protected
     FClipboardText: TfpgString;
     function    DoGetText: TfpgString; override;
     procedure   DoSetText(const AValue: TfpgString); override;
     procedure   InitClipboard; override;
+  public
+    destructor  Destroy; override;
   end;
 
 
@@ -668,29 +675,93 @@ begin
 end;
 
 // clipboard event
+procedure HandleAtom(var e: TXSelectionEvent; const Atom: TAtom; Prop: TAtom); forward;
+
+
+procedure HandleMultiple(var e: TXSelectionEvent);
+type
+  TAtomPair = record
+    Target: TAtom;
+    Prop: TAtom;
+  end;
+
+var
+  Atom: TAtom;
+  Length: culong;
+  BytesLeft: culong;
+  Format: DWord;
+  Data: Pointer;
+  xia_Atom_Pair: TAtom;
+  AtomPair: TAtomPair;
+  i: Integer;
+  r: cint;
+begin
+
+  xia_Atom_Pair := XInternAtom(xapplication.Display, 'ATOM_PAIR', False);
+
+  // find out how much data there is
+  r := XGetWindowProperty(xapplication.Display, e.requestor, e._property, 0,  0, False, AnyPropertyType,
+      @Atom, @Format, @Length, @BytesLeft, @Data);
+
+  if (r <> Success) or  (Format <> 32) or (Atom <> xia_Atom_Pair) then
+    Exit; // ==>
+
+  // read one entry at a time
+  while BytesLeft > 0 do
+  begin
+    // read the data
+    r := XGetWindowProperty(xapplication.Display, e.requestor, e._property, 0, SizeOf(AtomPair), False, AnyPropertyType,
+      @Atom, @Format, @Length, @BytesLeft, @Data);
+
+    if r <> Success then
+      Exit; // ==>
+
+    // copy data to our variable
+    Move(Data^, AtomPair, SizeOf(TAtomPair));
+    XFree(Data);
+
+    // process this target in the list;
+    HandleAtom(e, AtomPair.Target, AtomPair.Prop);
+  end;
+end;
+
+procedure HandleAtom(var e: TXSelectionEvent; const Atom: TAtom; Prop: TAtom);
+begin
+  if Atom = None then
+  begin
+    Exit; // ==>
+  end;
+
+  if Atom = xapplication.xia_targets then
+  begin
+    fpgClipboard.DoSetTargets(e.requestor, Prop);
+  end
+  else if Atom = XInternAtom(xapplication.Display, 'MULTIPLE', False) then
+  begin
+    // multiple targets
+    HandleMultiple(e);
+  end
+  else// if Atom = XA_STRING then
+  begin
+    XChangeProperty(xapplication.Display, e.requestor, Prop, Atom,
+              8, PropModeReplace, PByte(@fpgClipboard.FClipboardText[1]), Length(fpgClipboard.FClipboardText));
+  end;
+  //else WriteLn('Unhandled Selection atom: ', XGetAtomName(xapplication.Display, Atom));
+end;
+
 procedure ProcessSelectionRequest(var ev: TXEvent);
 var
   e: TXSelectionEvent;
-  a: TAtom;
 begin
   e._type       := SelectionNotify;
+  e.display     := ev.xselectionrequest.display;
   e.requestor   := ev.xselectionrequest.requestor;
   e.selection   := ev.xselectionrequest.selection;
   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,
-        32, PropModeReplace, PByte(@a), Sizeof(TAtom)); // I think last parameter is right?
-  end
-  else
-  begin
-    XChangeProperty(xapplication.Display, e.requestor, e._property, e.target,
-        8, PropModeReplace, PByte(@fpgClipboard.FClipboardText[1]), Length(fpgClipboard.FClipboardText));
-  end;
+  HandleAtom(e, e.target, e._property);
 
   XSendEvent(xapplication.Display, e.requestor, false, 0, @e );
 end;
@@ -1399,6 +1470,7 @@ begin
   // Initialize atoms
   xia_clipboard         := XInternAtom(FDisplay, 'CLIPBOARD', TBool(False));
   xia_targets           := XInternAtom(FDisplay, 'TARGETS', TBool(False));
+  xia_save_targets      := XInternAtom(FDisplay, 'SAVE_TARGETS', TBool(False));
   xia_motif_wm_hints    := XInternAtom(FDisplay, '_MOTIF_WM_HINTS', TBool(False));
   xia_wm_protocols      := XInternAtom(FDisplay, 'WM_PROTOCOLS', TBool(False));
   xia_wm_delete_window  := XInternAtom(FDisplay, 'WM_DELETE_WINDOW', TBool(False));
@@ -2039,9 +2111,13 @@ begin
     X.SelectionClear:
         begin
           { TODO : Not sure if I am handling this correctly? }
+          { We Get this message when another program has declared that
+            it has ownership of the xia_clipboard selection atom
+          }
           if ev.xselectionclear.selection = xia_clipboard then
           begin
             fpgClipboard.FClipboardText := '';
+            fpgClipboard.DoLostSelection;
             Exit;
           end;
         end;
@@ -3278,8 +3354,70 @@ end;
 
 { TfpgX11Clipboard }
 
+procedure TfpgX11Clipboard.SendClipboardToManager;
+var
+  ClipboardManager: TAtom;
+  StartTime: DWord;
+begin
+  // if we don't own the clipboard then there is nothing to save
+  if not FOwnsSelection then
+    Exit; // ==>
+
+  // check if the manager atom exists
+  ClipboardManager:= XInternAtom(xapplication.Display, 'CLIPBOARD_MANAGER', False);
+  if ClipboardManager = None then
+    Exit; // ==>
+
+  // check if a program has control of the manager atom
+  if XGetSelectionOwner(xapplication.Display, ClipboardManager) = None then
+    Exit; // ==>
+
+  // this triggers the manager to request the clipboard contents from us
+  XConvertSelection(xapplication.Display,
+                    ClipboardManager,
+                    xapplication.xia_save_targets,
+                    None, //XInternAtom(xapplication.Display, 'FPG_CLIPBOARD', True), // 'None' seems to work as the property name
+                    FClipboardWndHandle,
+                    CurrentTime);
+
+  XSync(xapplication.Display, False);
+
+  StartTime := fpgGetTickCount;
+  // now wait for the manager to get the clipboard
+  repeat
+    fpgWaitWindowMessage;
+    fpgDeliverMessages;
+  until not FOwnsSelection or ((fpgGetTickCount - StartTime) > 3000); // allow 3 seconds for the clipboard to be read
+end;
+
+procedure TfpgX11Clipboard.DoLostSelection;
+begin
+  FOwnsSelection := False;
+end;
+
+procedure TfpgX11Clipboard.DoSetTargets(AWin: TWindow; AProperty: TAtom);
+const
+  target_count = 3;
+var
+  targets: array[0..target_count-1] of TAtom;
+begin
+
+  targets[0] := XA_STRING;
+  targets[1] := xapplication.xia_targets;
+  targets[2] := xapplication.xia_save_targets;
+  //targets[3] := XInternAtom(xapplication.Display, 'UTF8_STRING', True);
+  //targets[4] := XInternAtom(xapplication.Display, 'MULTIPLE', True);
+
+  // list the types of data we have in the clipboard
+  XChangeProperty(xapplication.Display, AWin, AProperty, XA_ATOM, 32,
+                  PropModeReplace, @targets[0], target_count);
+end;
+
 function TfpgX11Clipboard.DoGetText: TfpgString;
 begin
+  if FOwnsSelection then
+    Exit(FClipboardText); // ==>
+
   XConvertSelection(xapplication.Display, xapplication.xia_clipboard,
       XA_STRING, xapplication.xia_clipboard, FClipboardWndHandle, 0);
 
@@ -3299,6 +3437,8 @@ begin
   FClipboardText := AValue;
   XSetSelectionOwner(xapplication.Display, xapplication.xia_clipboard,
       FClipboardWndHandle, CurrentTime);
+  DoSetTargets(FClipboardWndHandle, xapplication.xia_targets);
+  FOwnsSelection := True;
 end;
 
 procedure TfpgX11Clipboard.InitClipboard;
@@ -3308,6 +3448,12 @@ begin
       xapplication.RootWindow, 10, 10, 10, 10, 0, 0, 0);
 end;
 
+destructor TfpgX11Clipboard.Destroy;
+begin
+  SendClipboardToManager;
+  inherited Destroy;
+end;
+
 { TfpgX11FileList }
 
 function TfpgX11FileList.EncodeModeString(FileMode: longword): TFileModeString;