Skip to content

Commit 25ddfcb

Browse files
mflattmflatt
committed
ffi/com: repairs for parameterized-property setting and for date values
Merge to v5.3.4
1 parent 10e53e3 commit 25ddfcb

File tree

4 files changed

+52
-16
lines changed

4 files changed

+52
-16
lines changed

‎collects/ffi/unsafe/com.rkt

+22-9
Original file line numberDiff line numberDiff line change
@@ -1251,6 +1251,7 @@
12511251
[(IUnknown? arg) 'iunknown]
12521252
[(eq? com-omit arg) 'any]
12531253
[(box? arg) `(box ,(arg-to-type (unbox arg)))]
1254+
[(date? arg) 'date]
12541255
[else (error 'com "cannot infer marshal format for value: ~e" arg)]))
12551256

12561257
(define (elem-desc-ref func-desc i)
@@ -1419,11 +1420,12 @@
14191420
[wSecond _WORD]
14201421
[wMilliseconds _WORD]))
14211422

1422-
(define-ole VariantTimeToSystemTime (_wfun _DATE _SYSTEMTIME-pointer
1423+
(define-oleaut VariantTimeToSystemTime (_wfun _DATE _SYSTEMTIME-pointer
14231424
-> _INT))
1424-
(define-ole SystemTimeToVariantTime (_wfun _SYSTEMTIME-pointer (d : (_ptr o _DATE))
1425-
-> (r : _int)
1426-
-> (and (zero? r) d)))
1425+
(define-oleaut SystemTimeToVariantTime (_wfun #:save-errno 'windows
1426+
_SYSTEMTIME-pointer (d : (_ptr o _DATE))
1427+
-> (r : _int)
1428+
-> (and (not (zero? r)) d)))
14271429

14281430
(define _date
14291431
(make-ctype _DATE
@@ -1438,12 +1440,12 @@
14381440
(if (date*? d)
14391441
(inexact->exact (floor (* (date*-nanosecond d) 1000)))
14401442
0)))
1441-
(define d (SystemTimeToVariantTime s))
1442-
(or d
1443-
(error 'date "error converting date to COM date")))
1443+
(or (SystemTimeToVariantTime s)
1444+
(error 'date "error converting date to COM date (~a)"
1445+
(saved-errno))))
14441446
(lambda (d)
14451447
(define s (make-SYSTEMTIME 0 0 0 0 0 0 0 0))
1446-
(unless (zero? (VariantTimeToSystemTime d s))
1448+
(unless (not (zero? (VariantTimeToSystemTime d s)))
14471449
(error 'date "error converting date from COM date"))
14481450
(seconds->date
14491451
(find-seconds (SYSTEMTIME-wSecond s)
@@ -2072,7 +2074,18 @@
20722074
(define com-set-property!
20732075
(case-lambda
20742076
[(obj name val)
2075-
(do-com-invoke 'com-set-property! obj name (list val) INVOKE_PROPERTYPUT)]
2077+
(cond
2078+
[(string? name)
2079+
(do-com-invoke 'com-set-property! obj name (list val) INVOKE_PROPERTYPUT)]
2080+
[(and (list? name)
2081+
(pair? name)
2082+
(string? (car name)))
2083+
(do-com-invoke 'com-set-property! obj
2084+
(car name) (append (cdr name) (list val))
2085+
INVOKE_PROPERTYPUT)]
2086+
[else
2087+
(raise-argument-error 'com-set-property! "(or/c string? (cons/c string? list))"
2088+
name)])]
20762089
[(obj name1 name2 . names+val)
20772090
(check-com-obj 'com-set-property obj)
20782091
(define names (list* name1 name2 names+val))

‎collects/mysterx/scribblings/methprop.scrbl

+7-4
Original file line numberDiff line numberDiff line change
@@ -137,22 +137,25 @@ Like @racket[cocreate-instance-from-coclass], but using a ProgID.}
137137
Returns a list of strings indicating the names of writeable
138138
properties in @racket[obj/type].}
139139

140-
@defproc[(com-set-property-type [obj/type (or/c com-object? com-type?)]
141-
[property-name strig?])
140+
@defproc[(com-set-property-type [obj/type (or/c com-object? com-type?)]
141+
[property-name string?])
142142
(listof symbol?)]{
143143

144144
Returns a list of symbols indicating the type of the specified
145145
property in @racket[obj/type]. See @secref["com-types"] for
146146
information on the symbols.}
147147

148148
@defproc[(com-set-property! [obj com-object?]
149-
[string? property] ...+
149+
[property (or/c string?
150+
(cons/c string? list?))] ...+
150151
[v any/c])
151152
void?]{
152153

153154
Sets the value of the final property in @racket[obj] to @racket[v]
154155
by following the @racket[property]s, where the value of each
155-
intermediate property is a COM object.}
156+
intermediate property is a COM object. A @racket[property]
157+
can be a list instead of a string to represent a parameterized property
158+
and its arguments.}
156159

157160
@defproc[(com-help [obj/type (or/c com-object? com-type?)]
158161
[topic string? ""])

‎collects/scribblings/foreign/com-auto.scrbl

+6-3
Original file line numberDiff line numberDiff line change
@@ -269,14 +269,17 @@ argument.}
269269
information on the symbols.}
270270

271271

272-
@defproc[(com-set-property! [obj com-object?]
273-
[string? property] ...+
272+
@defproc[(com-set-property! [obj com-object?]
273+
[property (or/c string?
274+
(cons/c string? list?))] ...+
274275
[v any/c])
275276
void?]{
276277

277278
Sets the value of the final property in @racket[obj] to @racket[v]
278279
by following the @racket[property]s, where the value of each
279-
intermediate property must be a COM object.
280+
intermediate property must be a COM object. A @racket[property]
281+
can be a list instead of a string to represent a parameterized property
282+
and its arguments.
280283

281284
The type of the property is determined via
282285
@racket[com-property-type], if possible, and

‎collects/tests/racket/com.rkt

+17
Original file line numberDiff line numberDiff line change
@@ -167,4 +167,21 @@
167167

168168
(void))
169169

170+
;; The Excel interface provides many more opportunities for tests:
171+
(define excel (with-handlers ([exn:fail? (lambda (exn)
172+
(printf "Excel not available\n")
173+
#f)])
174+
(com-create-instance "Excel.Application")))
175+
(when excel
176+
(com-set-property! excel "Visible" #t)
177+
(define wb (com-get-property excel "Workbooks"))
178+
(define workbook (com-invoke wb "Add"))
179+
(define sheets (com-get-property workbook "Worksheets"))
180+
(define sheet (com-get-property sheets '("Item" "Sheet1")))
181+
(define range (com-get-property sheet "Cells"))
182+
(define cell (com-get-property range '("Item" 1 1)))
183+
(com-get-property cell '("Value" 10))
184+
(com-set-property! cell '("Value" 10) (seconds->date (current-seconds)))
185+
(test #t (date? (com-get-property cell '("Value" 10)))))
186+
170187
(printf "~a passed\n" count)

0 commit comments

Comments
 (0)