From 9092a3168f0c58462ab4ff4ce5dae498fa6d1e77 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 7 Jun 1995 18:42:23 +0000
Subject: [PATCH] Tweak "interprogram-paste" code so that it doesn't signal an
 error when the kill ring is empty.

---
 v7/src/edwin/kilcom.scm | 44 ++++++++++++++++++++---------------------
 1 file changed, 22 insertions(+), 22 deletions(-)

diff --git a/v7/src/edwin/kilcom.scm b/v7/src/edwin/kilcom.scm
index 8224ae72e..e705db662 100644
--- a/v7/src/edwin/kilcom.scm
+++ b/v7/src/edwin/kilcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: kilcom.scm,v 1.67 1995/05/02 22:30:32 cph Exp $
+;;;	$Id: kilcom.scm,v 1.68 1995/06/07 18:42:23 cph Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989-95 Massachusetts Institute of Technology
 ;;;
@@ -288,28 +288,28 @@ comes the newest one."
 	      (delete-string point mark)
 	      before?))
 	  set-current-mark!)))
-
+
 (define (yank offset before? set-current-mark!)
-  ((ref-command rotate-yank-pointer) offset)
-  (let* ((start (mark-right-inserting-copy (current-point)))
-	 (end (mark-left-inserting-copy start)))
-    (insert-string (let ((string (car (ref-variable kill-ring-yank-pointer)))
-			 (string*
-			  (and (= offset 0)
-			       (os/interprogram-paste))))
-		     (if (and string*
-			      (not (string-null? string*))
-			      (not (string=? string* string)))
-			 (begin
-			   (kill-ring-save-1 string*)
-			   string*)
-			 string))
-		   start)
-    (mark-temporary! end)
-    (mark-temporary! start)
-    (if before?
-	(begin (set-current-mark! end) (set-current-point! start))
-	(begin (set-current-mark! start) (set-current-point! end))))
+  (let ((start (mark-right-inserting-copy (current-point)))
+	(get-yank
+	 (lambda ()
+	   ((ref-command rotate-yank-pointer) offset)
+	   (car (ref-variable kill-ring-yank-pointer)))))
+    (let ((end (mark-left-inserting-copy start)))
+      (insert-string (let ((paste (and (= offset 0) (os/interprogram-paste))))
+		       (if (and paste (not (string-null? paste)))
+			   (begin
+			     (if (or (null? (ref-variable kill-ring))
+				     (not (string=? paste (get-yank))))
+				 (kill-ring-save-1 paste))
+			     paste)
+			   (get-yank)))
+		     start)
+      (mark-temporary! end)
+      (mark-temporary! start)
+      (if before?
+	  (begin (set-current-mark! end) (set-current-point! start))
+	  (begin (set-current-mark! start) (set-current-point! end)))))
   (set-command-message! un-kill-tag))
 
 (define un-kill-tag
-- 
2.25.1