windows.streams: attempt to determine stream size because GdipCreateBitmapFromStream...

diff --git a/basis/windows/streams/streams.factor b/basis/windows/streams/streams.factor
index f16fe5a9272195fdcfb54a5e0c6b5ebfbd10d508..956b4aad103f756c3ced4bd7ed24c0b4b6ce1b0e 100644 (file)
--- a/basis/windows/streams/streams.factor
+++ b/basis/windows/streams/streams.factor
@@ -69,12 +69,20 @@ SPECIALIZED-ARRAY: uchar
 :: IStream-unlock-region ( stream offset cb lock-type -- hresult )\r
     STG_E_INVALIDFUNCTION ;\r
 \r
+FROM: io.ports => tell-handle ;\r
+:: stream-size ( stream -- size )\r
+    stream stream-tell :> old-pos\r
+    0 seek-end stream stream-seek\r
+    stream handle>> tell-handle :> size\r
+    old-pos seek-absolute stream stream-seek\r
+    size ;\r
+\r
 :: IStream-stat ( stream out-stat stat-flag -- hresult )\r
     [\r
         out-stat\r
             f >>pwcsName\r
             STGTY_STREAM >>type\r
-            0 >>cbSize\r
+            stream stream-size >>cbSize\r
             FILETIME <struct> >>mtime\r
             FILETIME <struct> >>ctime\r
             FILETIME <struct> >>atime\r
@@ -83,28 +91,46 @@ SPECIALIZED-ARRAY: uchar
             GUID_NULL >>clsid\r
             0 >>grfStateBits\r
             0 >>reserved\r
+            drop\r
+        S_OK\r
     ] with-hresult ;\r
 \r
 :: IStream-clone ( out-clone-stream -- hresult )\r
     f out-clone-stream 0 void* set-alien-value\r
     STG_E_INVALIDFUNCTION ;\r
 \r
-MEMO: stream-wrapper ( -- wrapper )\r
-    {\r
-        { IStream {\r
-            [ IStream-read ]\r
-            [ IStream-write ]\r
-            [ IStream-seek ]\r
-            [ IStream-set-size ]\r
-            [ IStream-copy-to ]\r
-            [ IStream-commit ]\r
-            [ IStream-revert ]\r
-            [ IStream-lock-region ]\r
-            [ IStream-unlock-region ]\r
-            [ IStream-stat ]\r
-            [ IStream-clone ]\r
-        } }\r
-    } <com-wrapper> ;\r
+USE: tools.annotations\r
+: watch-istream-callbacks ( -- )\r
+    \ IStream-read watch\r
+    \ IStream-write watch\r
+    \ IStream-seek watch\r
+    \ IStream-set-size watch\r
+    \ IStream-copy-to watch\r
+    \ IStream-commit watch\r
+    \ IStream-revert watch\r
+    \ IStream-lock-region watch\r
+    \ IStream-unlock-region watch\r
+    \ IStream-stat watch\r
+    \ IStream-clone watch ;\r
+\r
+CONSTANT: stream-wrapper\r
+    $[\r
+        {\r
+            { IStream {\r
+                [ IStream-read ]\r
+                [ IStream-write ]\r
+                [ IStream-seek ]\r
+                [ IStream-set-size ]\r
+                [ IStream-copy-to ]\r
+                [ IStream-commit ]\r
+                [ IStream-revert ]\r
+                [ IStream-lock-region ]\r
+                [ IStream-unlock-region ]\r
+                [ IStream-stat ]\r
+                [ IStream-clone ]\r
+            } }\r
+        } <com-wrapper>\r
+    ]\r
 \r
 PRIVATE>\r
 \r