From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 9 Jul 1998 04:31:40 +0000 (+0000)
Subject: Fix bug in clipboard implementation.
X-Git-Tag: 20090517-FFI~4771
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7da24384a0a556b77d5a06371b274a1029297222;p=mit-scheme.git

Fix bug in clipboard implementation.
---

diff --git a/v7/src/win32/clipbrd.scm b/v7/src/win32/clipbrd.scm
index ef16a6d95..d854a7843 100644
--- a/v7/src/win32/clipbrd.scm
+++ b/v7/src/win32/clipbrd.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: clipbrd.scm,v 1.3 1998/07/09 04:29:29 cph Exp $
+;;;	$Id: clipbrd.scm,v 1.4 1998/07/09 04:31:40 cph Exp $
 ;;;
 ;;;	Copyright (c) 1995-98 Massachusetts Institute of Technology
 ;;;
@@ -54,14 +54,10 @@
 	(error "Unable to allocate global memory of length" len))
     (copy-memory (global-lock mem) s len)
     (global-unlock mem)
-    (if (not (open-clipboard 0))
-	(error "Error opening clipboard."))
-    (if (not (empty-clipboard))
-	(error "Error emptying clipboard."))
-    (if (not (set-clipboard-data CF_TEXT mem))
-	(error "Error setting clipboard data."))
-    (if (not (close-clipboard))
-	(error "Error closing clipboard."))))
+    (open-clipboard 0)
+    (empty-clipboard)
+    (set-clipboard-data CF_TEXT mem)
+    (close-clipboard)))
 
 (define (win32-clipboard-read-text)
   (open-clipboard 0)
diff --git a/v7/src/win32/wf_user.scm b/v7/src/win32/wf_user.scm
index fd19aa2c3..264d21cf2 100644
--- a/v7/src/win32/wf_user.scm
+++ b/v7/src/win32/wf_user.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: wf_user.scm,v 1.7 1996/10/07 18:17:03 cph Exp $
+$Id: wf_user.scm,v 1.8 1998/07/09 04:29:36 cph Exp $
 
-Copyright (c) 1993-96 Massachusetts Institute of Technology
+Copyright (c) 1993-98 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -62,6 +62,7 @@ MIT in each case. |#
 (define  destroy-window)
 (define  draw-menu-bar)
 (define  ellipse)
+(define  empty-clipboard)
 (define  enable-menu-item)
 (define  end-paint)
 (define  get-client-rect)
@@ -69,6 +70,7 @@ MIT in each case. |#
 (define  get-dc)
 (define  get-device-caps)
 (define  get-focus)
+(define  get-last-error)
 (define  get-menu)
 (define  get-menu-check-mark-dimensions)
 (define  get-menu-item-count)
@@ -494,7 +496,8 @@ MIT in each case. |#
       bool user32.dll "OpenClipboard"))
 
   (set! close-clipboard
-    (windows-procedure (close-clipboard) bool user32.dll "CloseClipboard"))
+    (windows-procedure (close-clipboard)
+      bool user32.dll "CloseClipboard"))
 
   (set! set-clipboard-data
     (windows-procedure (set-clipboard-data (format uint) (hdata handle))
@@ -504,6 +507,10 @@ MIT in each case. |#
     (windows-procedure (get-clipboard-data (format uint))
       handle user32.dll "GetClipboardData"))
 
+  (set! empty-clipboard
+    (windows-procedure (empty-clipboard)
+      bool user32.dll "EmptyClipboard"))
+
 
   (set! global-alloc
     (windows-procedure (global-alloc (fuFlags uint) (cbBytes dword))
@@ -527,4 +534,9 @@ MIT in each case. |#
       bool kernel32.dll "RtlMoveMemory"))
 
 
+  (set! get-last-error
+    (windows-procedure (get-last-error)
+      dword kernel32.dll "GetLastError"))
+
+
   unspecific)