From 8c17db32596cf1d88a213952d760561f27dfe1d6 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 16 Jul 2008 06:37:36 -0700
Subject: [PATCH] with-destructors variants of CFRelease and com-release.
 Remove platform check errors from windows.dinput and iokit

---
 .../core-foundation-docs.factor                | 18 +++++++++++++++---
 extra/core-foundation/core-foundation.factor   |  8 +++++++-
 extra/iokit/iokit.factor                       |  9 +++++----
 extra/windows/com/com-docs.factor              | 13 ++++++++++++-
 extra/windows/com/com.factor                   | 11 ++++++++++-
 extra/windows/dinput/dinput.factor             |  5 +++--
 6 files changed, 52 insertions(+), 12 deletions(-)

diff --git a/extra/core-foundation/core-foundation-docs.factor b/extra/core-foundation/core-foundation-docs.factor
index ef8f5842a2..3cd9b838d4 100644
--- a/extra/core-foundation/core-foundation-docs.factor
+++ b/extra/core-foundation/core-foundation-docs.factor
@@ -1,4 +1,4 @@
-USING: alien strings arrays help.markup help.syntax ;
+USING: alien strings arrays help.markup help.syntax destructors ;
 IN: core-foundation
 
 HELP: CF>array
@@ -37,6 +37,16 @@ HELP: load-framework
 { $values { "name" "a pathname string" } }
 { $description "Loads a Core Foundation framework." } ;
 
+HELP: &CFRelease
+{ $values { "alien" "Pointer to a Core Foundation object" } }
+{ $description "Marks the given Core Foundation object for unconditional release via " { $link CFRelease } " at the end of the enclosing " { $link with-destructors } " scope." } ;
+
+HELP: |CFRelease
+{ $values { "interface" "Pointer to a Core Foundation object" } }
+{ $description "Marks the given Core Foundation object for release via " { $link CFRelease } " in the event of an error at the end of the enclosing " { $link with-destructors } " scope." } ;
+
+{ CFRelease |CFRelease &CFRelease } related-words
+
 ARTICLE: "core-foundation" "Core foundation utilities"
 "The " { $vocab-link "core-foundation" } " vocabulary defines bindings for some frequently-used Core Foundation functions. It also provides some utility words."
 $nl
@@ -51,7 +61,9 @@ $nl
 { $subsection <CFFileSystemURL> }
 { $subsection <CFURL> }
 "Frameworks:"
-{ $subsection load-framework } ;
+{ $subsection load-framework }
+"Memory management:"
+{ $subsection &CFRelease }
+{ $subsection |CFRelease } ;
 
-IN: core-foundation
 ABOUT: "core-foundation"
diff --git a/extra/core-foundation/core-foundation.factor b/extra/core-foundation/core-foundation.factor
index d2376997e5..c511a24320 100644
--- a/extra/core-foundation/core-foundation.factor
+++ b/extra/core-foundation/core-foundation.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings alien.syntax kernel
-math sequences io.encodings.utf16 ;
+math sequences io.encodings.utf16 destructors accessors ;
 IN: core-foundation
 
 TYPEDEF: void* CFAllocatorRef
@@ -135,3 +135,9 @@ M: f <CFNumber>
         "Cannot load bundled named " prepend throw
     ] ?if ;
 
+TUPLE: CFRelease-destructor alien disposed ;
+M: CFRelease-destructor dispose* alien>> CFRelease ;
+: &CFRelease ( alien -- alien )
+    dup f CFRelease-destructor boa &dispose drop ; inline
+: |CFRelease ( alien -- alien )
+    dup f CFRelease-destructor boa |dispose drop ; inline
diff --git a/extra/iokit/iokit.factor b/extra/iokit/iokit.factor
index 1babd697c1..680723def9 100644
--- a/extra/iokit/iokit.factor
+++ b/extra/iokit/iokit.factor
@@ -2,10 +2,11 @@ USING: alien.syntax alien.c-types core-foundation system
 combinators kernel sequences debugger io accessors ;
 IN: iokit
 
-<< {
-    { [ os macosx? ] [ "/System/Library/Frameworks/IOKit.framework" load-framework ] }
-    [ "IOKit only supported on Mac OS X" ]
-} cond >>
+<<
+    os macosx?
+    [ "/System/Library/Frameworks/IOKit.framework" load-framework ]
+    when
+>>
 
 : kIOKitBuildVersionKey   "IOKitBuildVersion" ; inline
 : kIOKitDiagnosticsKey   "IOKitDiagnostics" ; inline
diff --git a/extra/windows/com/com-docs.factor b/extra/windows/com/com-docs.factor
index 68663b4cdb..8c7584828f 100644
--- a/extra/windows/com/com-docs.factor
+++ b/extra/windows/com/com-docs.factor
@@ -1,5 +1,5 @@
 USING: help.markup help.syntax io kernel math quotations
-multiline ;
+multiline destructors ;
 IN: windows.com
 
 HELP: com-query-interface
@@ -13,3 +13,14 @@ HELP: com-add-ref
 HELP: com-release
 { $values { "interface" "Pointer to a COM interface implementing " { $snippet "IUnknown" } } }
 { $description "A small wrapper around " { $link IUnknown::Release } ". Decrements the reference count on " { $snippet "interface" } ", releasing the underlying object if the reference count has reached zero." } ;
+
+HELP: &com-release
+{ $values { "interface" "Pointer to a COM interface implementing " { $snippet "IUnknown" } } }
+{ $description "Marks the given COM interface for unconditional release via " { $link com-release } " at the end of the enclosing " { $link with-destructors } " scope." } ;
+
+HELP: |com-release
+{ $values { "interface" "Pointer to a COM interface implementing " { $snippet "IUnknown" } } }
+{ $description "Marks the given COM interface for release via " { $link com-release } " in the event of an error at the end of the enclosing " { $link with-destructors } " scope." } ;
+
+{ com-release &com-release |com-release } related-words
+
diff --git a/extra/windows/com/com.factor b/extra/windows/com/com.factor
index 4202ed4c56..9649de6402 100755
--- a/extra/windows/com/com.factor
+++ b/extra/windows/com/com.factor
@@ -1,5 +1,6 @@
 USING: alien alien.c-types windows.com.syntax windows.ole32
-windows.types continuations kernel alien.syntax libc ;
+windows.types continuations kernel alien.syntax libc
+destructors accessors ;
 IN: windows.com
 
 LIBRARY: ole32
@@ -39,3 +40,11 @@ COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}
 
 : with-com-interface ( interface quot -- )
     over [ slip ] [ com-release ] [ ] cleanup ; inline
+
+TUPLE: com-destructor interface disposed ;
+M: com-destructor dispose* interface>> com-release ;
+
+: &com-release ( interface -- interface )
+    dup f com-destructor boa &dispose drop ;
+: |com-release ( interface -- interface )
+    dup f com-destructor boa |dispose drop ;
diff --git a/extra/windows/dinput/dinput.factor b/extra/windows/dinput/dinput.factor
index 25abbb7534..a41f2ed80d 100755
--- a/extra/windows/dinput/dinput.factor
+++ b/extra/windows/dinput/dinput.factor
@@ -2,9 +2,10 @@ USING: windows.kernel32 windows.ole32 windows.com windows.com.syntax
 alien alien.c-types alien.syntax kernel system namespaces math ;
 IN: windows.dinput
 
-<< os windows?
+<<
+    os windows?
     [ "dinput" "dinput8.dll" "stdcall" add-library ]
-    [ "DirectInput only supported on Windows" throw ] if
+    when
 >>
 
 LIBRARY: dinput