From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Mon, 16 Jan 2017 19:17:54 +0000 (-0700)
Subject: gtk-screen: Implement cut/paste.
X-Git-Tag: mit-scheme-pucked-9.2.12~243
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b0fc56d634b34e6c39aec76a4ce18327a7a54c4d;p=mit-scheme.git

gtk-screen: Implement cut/paste.
---

diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg
index b153ab13d..b15940e30 100644
--- a/src/gtk-screen/gtk-screen.pkg
+++ b/src/gtk-screen/gtk-screen.pkg
@@ -151,6 +151,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	  gtk-window-present
 	  gtk-window-set-title
 	  gtk-window-set-default-size
+	  gtk-window-get-clipboard-text
+	  gtk-window-set-clipboard-text
 
 	  set-scm-widget-minimum-size!
 	  set-scm-widget-natural-size!
diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm
index c70003ecc..f72e7c441 100644
--- a/src/gtk-screen/gtk-screen.scm
+++ b/src/gtk-screen/gtk-screen.scm
@@ -660,6 +660,19 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	 (%trace2 ";read => "event"\n")
 	 event)))))
 
+(set!
+ os/interprogram-cut
+ (named-lambda (os/interprogram-cut string point)
+   (declare (ignore point))
+   (gtk-window-set-clipboard-text (gtk-screen-toplevel (selected-screen))
+				  (string->utf8-string string))))
+
+(set!
+ os/interprogram-paste
+ (named-lambda (os/interprogram-paste point)
+   (declare (ignore point))
+   (gtk-window-get-clipboard-text (gtk-screen-toplevel (selected-screen)))))
+
 (define interrupts?)
 
 (define (interrupt!)