From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 2 May 1995 21:47:43 +0000 (+0000)
Subject: Integrate support for OS-dependent cut&paste buffer into the kill and
X-Git-Tag: 20090517-FFI~6355
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7a0baf1abe5208dd8cb7dddb64c5ed68869b2b6c;p=mit-scheme.git

Integrate support for OS-dependent cut&paste buffer into the kill and
yank commands, as is done in Emacs 19.  This support is available in
the OS/2 implementation.
---

diff --git a/v7/src/edwin/kilcom.scm b/v7/src/edwin/kilcom.scm
index 82a724ab9..6bc534827 100644
--- a/v7/src/edwin/kilcom.scm
+++ b/v7/src/edwin/kilcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: kilcom.scm,v 1.65 1995/05/02 21:18:58 cph Exp $
+;;;	$Id: kilcom.scm,v 1.66 1995/05/02 21:47:43 cph Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989-95 Massachusetts Institute of Technology
 ;;;
@@ -212,29 +212,30 @@ The command \\[yank] can retrieve it from there.
     (kill-ring-save (extract-string mark point) (mark<= point mark))))
 
 (define (kill-ring-save string forward?)
-  (let ((strings (ref-variable kill-ring)))
-    (command-message-receive append-next-kill-tag
-      (lambda ()
-	(if (null? strings)
+  (command-message-receive append-next-kill-tag
+    (lambda ()
+      (let ((kill-ring (ref-variable kill-ring)))
+	(if (null? kill-ring)
 	    (editor-error "No previous kill"))
 	(let ((string
 	       (if forward?
-		   (string-append (car strings) string)
-		   (string-append string (car strings)))))
-	  (set-car! strings string)
-	  (set-variable! kill-ring-yank-pointer strings)
-	  (os/interprogram-cut string)))
-      (lambda ()
-	(kill-ring-save-1 string)
-	(os/interprogram-cut string))))
+		   (string-append (car kill-ring) string)
+		   (string-append string (car kill-ring)))))
+	  (set-car! kill-ring string)
+	  (set-variable! kill-ring-yank-pointer kill-ring)
+	  (os/interprogram-cut string))))
+    (lambda ()
+      (kill-ring-save-1 string)
+      (os/interprogram-cut string)))
   (set-command-message! append-next-kill-tag))
 
 (define (kill-ring-save-1 string)
   (let ((strings
-	 (let ((kill-ring-max (ref-variable kill-ring-max)))
+	 (let ((kill-ring (ref-variable kill-ring))
+	       (kill-ring-max (ref-variable kill-ring-max)))
 	   (if (zero? kill-ring-max)
 	       '()
-	       (let ((strings (cons string strings)))
+	       (let ((strings (cons string kill-ring)))
 		 (if (> (length strings) kill-ring-max)
 		     (set-cdr! (list-tail strings (- kill-ring-max 1)) '()))
 		 strings)))))