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/dos.scm b/v7/src/edwin/dos.scm
index 4c885d343196b05df6fd98ab797e31c4ce8f28ba..e9b1219e7d62d80c2690cf9d2d7a67f4c502d16d 100644 (file)
--- a/v7/src/edwin/dos.scm
+++ b/v7/src/edwin/dos.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: dos.scm,v 1.23 1995/04/09 23:27:54 cph Exp $
+;;;    $Id: dos.scm,v 1.24 1995/05/02 21:19:13 cph Exp $
 ;;;
 ;;;    Copyright (c) 1992-95 Massachusetts Institute of Technology
 ;;;
@@ -469,4 +469,11 @@ Includes the new backup.  Must be > 0."
   "sendmail.exe")
 
 (define (os/rmail-pop-procedure)
+  #f)
+
+(define (os/interprogram-cut string)
+  string push?
+  unspecific)
+
+(define (os/interprogram-paste)
   #f)
\ No newline at end of file

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index aaa15e99644493f3b67156b0347a9ebd0e439753..fe7050a714addf6585bb3bfad5684b2894acaf73 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.170 1995/04/30 06:52:22 cph Exp $
+$Id: edwin.pkg,v 1.171 1995/05/02 21:18:47 cph Exp $
 
 Copyright (c) 1989-95 Massachusetts Institute of Technology
 
@@ -1154,7 +1154,10 @@ MIT in each case. |#
 
  ((os/2)
   (extend-package (edwin)
-    (files "os2"))
+    (files "os2")
+    (import (runtime os2-window-primitives)
+           os2-clipboard-read-text
+           os2-clipboard-write-text))
 
   (extend-package (edwin dired)
     (files "diros2")

diff --git a/v7/src/edwin/kilcom.scm b/v7/src/edwin/kilcom.scm
index 7a82b355db7eaf77a36e1471389cf56be92bc697..82a724ab937cab3e760f45b3b250d728b5253d30 100644 (file)
--- a/v7/src/edwin/kilcom.scm
+++ b/v7/src/edwin/kilcom.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: kilcom.scm,v 1.64 1993/01/10 10:47:06 cph Exp $
+;;;    $Id: kilcom.scm,v 1.65 1995/05/02 21:18:58 cph Exp $
 ;;;
-;;;    Copyright (c) 1985, 1989-93 Massachusetts Institute of Technology
+;;;    Copyright (c) 1985, 1989-95 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -217,25 +217,30 @@ The command \\[yank] can retrieve it from there.
       (lambda ()
        (if (null? strings)
            (editor-error "No previous kill"))
-       (set-car! strings
-                 (if forward?
-                     (string-append (car strings) string)
-                     (string-append string (car strings))))
-       (set-variable! kill-ring-yank-pointer strings))
+       (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 ()
-       (let ((strings
-              (let ((kill-ring-max (ref-variable kill-ring-max)))
-                (if (zero? kill-ring-max)
-                    '()
-                    (let ((strings (cons string strings)))
-                      (if (> (length strings) kill-ring-max)
-                          (set-cdr! (list-tail strings (- kill-ring-max 1))
-                                    '()))
-                      strings)))))
-         (set-variable! kill-ring strings)
-         (set-variable! kill-ring-yank-pointer strings)))))
+       (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)))
+          (if (zero? kill-ring-max)
+              '()
+              (let ((strings (cons string strings)))
+                (if (> (length strings) kill-ring-max)
+                    (set-cdr! (list-tail strings (- kill-ring-max 1)) '()))
+                strings)))))
+    (set-variable! kill-ring strings)
+    (set-variable! kill-ring-yank-pointer strings)))
+
 (define append-next-kill-tag
   "Append Next Kill")
 \f
@@ -287,7 +292,18 @@ comes the newest one."
   ((ref-command rotate-yank-pointer) offset)
   (let* ((start (mark-right-inserting-copy (current-point)))
         (end (mark-left-inserting-copy start)))
-    (insert-string (car (ref-variable kill-ring-yank-pointer)) 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?

diff --git a/v7/src/edwin/os2.scm b/v7/src/edwin/os2.scm
index bab706605e26a9b93b34df1ac82437e5b17f1e78..5b72368f621d74a316f30c293b2dd29002c23d4a 100644 (file)
--- a/v7/src/edwin/os2.scm
+++ b/v7/src/edwin/os2.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: os2.scm,v 1.13 1995/05/02 00:29:23 cph Exp $
+;;;    $Id: os2.scm,v 1.14 1995/05/02 21:18:40 cph Exp $
 ;;;
 ;;;    Copyright (c) 1994-95 Massachusetts Institute of Technology
 ;;;
@@ -357,6 +357,15 @@ Includes the new backup.  Must be > 0."
 
 (define (os/set-file-modes-writable! pathname)
   (set-file-modes! pathname (fix:andc (file-modes pathname) #x0001)))
+
+(define (os/interprogram-cut string push?)
+  push?
+  (os2-clipboard-write-text
+   ;; Some programs can't handle strings over 64k.
+   (if (fix:< (string-length string) #x10000) string "")))
+
+(define os/interprogram-paste
+  os2-clipboard-read-text)
 \f
 ;;;; Dired customization
 

diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index fb720c0c24d12a08f0e1b44bcc4f9941bd46c74b..b2a52c6059a716964c4a3d79269bc62f134574dd 100644 (file)
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: unix.scm,v 1.48 1995/04/15 06:14:01 cph Exp $
+;;;    $Id: unix.scm,v 1.49 1995/05/02 21:19:22 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-95 Massachusetts Institute of Technology
 ;;;
@@ -704,4 +704,11 @@ Value is a list of strings."
                                      (ns (decoded-time/minute dt) 2 #\0))
                       (string-append " "
                                      (number->string
-                                      (decoded-time/year dt)))))))
\ No newline at end of file
+                                      (decoded-time/year dt)))))))
+
+(define (os/interprogram-cut string push?)
+  string push?
+  unspecific)
+
+(define (os/interprogram-paste)
+  #f)
\ No newline at end of file