From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Sun, 31 Jul 2016 18:56:31 +0000 (-0700)
Subject: x11-screen: Fix selection handling (cut/paste between X windows).
X-Git-Tag: mit-scheme-pucked-9.2.12~261^2~11
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=672c36b7115f0f79f62c87ba6e2bac86dc43d8d7;p=mit-scheme.git

x11-screen: Fix selection handling (cut/paste between X windows).

Cut/paste should now work with two minor fixes (typos, really), and
one kludge keeping non-unique alien objects in a weak-eq-hash-table.
The original xds (fixnums) are held as strongly as the new interned
symbols.

The xds were intended to be x-displays?  Interned x-display objects
would be more appropriate keys for a weak-eq-hash-table.
---

diff --git a/src/x11-screen/x11-screen.scm b/src/x11-screen/x11-screen.scm
index f1cff4602..506bc1511 100644
--- a/src/x11-screen/x11-screen.scm
+++ b/src/x11-screen/x11-screen.scm
@@ -841,14 +841,15 @@ USA.
       table)))
 
 (define display/cached-atoms-tables
+  ;; This table needs replacing.  It holds interned symbols strongly!
   (let ((table (make-weak-eq-hash-table)))
     (lambda (display)
-      (or (hash-table/get table display #f)
-	  (let ((result
-		 (cons (make-strong-eq-hash-table)
-		       (make-strong-eqv-hash-table))))
-	    (hash-table/put! table display result)
-	    result)))))
+      (let ((key (intern (alien/address-string display))))
+	(or (hash-table/get table key #f)
+	    (let ((result (cons (make-strong-eq-hash-table)
+				(make-strong-eqv-hash-table))))
+	      (hash-table/put! table key result)
+	      result))))))
 
 ;;;; Properties
 
@@ -1018,12 +1019,14 @@ In either case, it is copied to the primary selection."
 	 #t)))
 
 (define display/selection-records
+  ;; This table needs replacing.  It holds interned symbols strongly.
   (let ((table (make-weak-eq-hash-table)))
     (lambda (display)
-      (or (hash-table/get table display #f)
-	  (let ((result (make-strong-eq-hash-table)))
-	    (hash-table/put! table display result)
-	    result)))))
+      (let ((key (intern (alien/address-string display))))
+	(or (hash-table/get table key #f)
+	    (let ((result (make-strong-eq-hash-table)))
+	      (hash-table/put! table key result)
+	      result))))))
 
 ;;; In the next two procedures, we must allow TIME to be 0, even
 ;;; though the ICCCM forbids this, because existing clients use that
diff --git a/src/x11/x11base.scm b/src/x11/x11base.scm
index 52ce079e7..84c0739ca 100644
--- a/src/x11/x11base.scm
+++ b/src/x11/x11base.scm
@@ -840,7 +840,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	  (case format
 	    ((8)
 	     (guarantee-string data 'x-change-property)
-	     data)
+	     (prop-data-8->bytes.length data))
 	    ((16)
 	     (guarantee-vector data 'x-change-property)
 	     (prop-data-16->bytes.length data))
@@ -854,7 +854,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 		  (car bytes.length) (cdr bytes.length))))
     (free (car bytes.length))
     (if (not (zero? code))
-	(error "XChangeProperty failed:" property))))
+	(error "XChangeProperty failed:" property))
+    code))
 
 (define (prop-data-32->bytes.length vector)
   (let* ((nitems (vector-length vector))
@@ -934,7 +935,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 ;;; Guarantors
 
 (declare (integrate-operator guarantee-Atom))
-(define guarantee-Atom guarantee-exact-positive-integer)
+(define guarantee-Atom guarantee-exact-nonnegative-integer)
 
 (declare (integrate-operator guarantee-Window))
 (define guarantee-Window guarantee-exact-positive-integer)