1;;;
2;;; windows.stub - windows api bridge
3;;;
4;;;   Copyright (c) 2010-2020  Shiro Kawai  <shiro@acm.org>
5;;;
6;;;   Redistribution and use in source and binary forms, with or without
7;;;   modification, are permitted provided that the following conditions
8;;;   are met:
9;;;
10;;;   1. Redistributions of source code must retain the above copyright
11;;;      notice, this list of conditions and the following disclaimer.
12;;;
13;;;   2. Redistributions in binary form must reproduce the above copyright
14;;;      notice, this list of conditions and the following disclaimer in the
15;;;      documentation and/or other materials provided with the distribution.
16;;;
17;;;   3. Neither the name of the authors nor the names of its contributors
18;;;      may be used to endorse or promote products derived from this
19;;;      software without specific prior written permission.
20;;;
21;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32;;;
33
34(when "defined(GAUCHE_WINDOWS)"
35
36;; The following bindings are provided in the core:
37;;  <win:handle>
38;;  sys-win-process?
39;;  sys-win-process-pid
40;;  sys-get-osfhandle
41
42;;====================================================================
43;; Fileapi
44;;
45
46(define-cproc sys-get-disk-free-space-ex (path::<const-cstring>)
47  (let* ([wpath::LPTSTR (SCM_MBS2WCS path)]
48         [avail::ULARGE_INTEGER]
49         [total::ULARGE_INTEGER]
50         [tfree::ULARGE_INTEGER]
51         [r::BOOL (GetDiskFreeSpaceEx wpath (& avail) (& total) (& tfree))])
52    (when (== r 0) (Scm_SysError "GetDiskFreeSpaceEx failed on path %s" path))
53    (return (SCM_LIST3 (Scm_OffsetToInteger (ref avail QuadPart))
54                       (Scm_OffsetToInteger (ref total QuadPart))
55                       (Scm_OffsetToInteger (ref tfree QuadPart))))))
56
57;;====================================================================
58;; MessageBox
59;;
60
61;; flags for buttons
62(define-enum MB_ABORTRETRYIGNORE)
63(define-enum MB_CANCELTRYCONTINUE)
64(define-enum MB_HELP)
65(define-enum MB_OK)
66(define-enum MB_OKCANCEL)
67(define-enum MB_RETRYCANCEL)
68(define-enum MB_YESNO)
69(define-enum MB_YESNOCANCEL)
70
71;; flags for icons
72(define-enum MB_ICONEXCLAMATION)
73(define-enum MB_ICONWARNING)
74(define-enum MB_ICONINFORMATION)
75(define-enum MB_ICONASTERISK)
76(define-enum MB_ICONQUESTION)
77(define-enum MB_ICONSTOP)
78(define-enum MB_ICONERROR)
79(define-enum MB_ICONHAND)
80
81;; flags for default button
82(define-enum MB_DEFBUTTON1)
83(define-enum MB_DEFBUTTON2)
84(define-enum MB_DEFBUTTON3)
85(define-enum MB_DEFBUTTON4)
86
87;; flags for modality
88(define-enum MB_APPLMODAL)
89(define-enum MB_SYSTEMMODAL)
90(define-enum MB_TASKMODAL)
91
92;; flags for other options
93(define-enum MB_DEFAULT_DESKTOP_ONLY)
94(define-enum MB_RIGHT)
95(define-enum MB_RTLREADING)
96(define-enum MB_SETFOREGROUND)
97(define-enum MB_TOPMOST)
98(define-enum MB_SERVICE_NOTIFICATION)
99
100;; return values
101(define-enum IDABORT)
102(define-enum IDCANCEL)
103(define-enum IDCONTINUE)
104(define-enum IDIGNORE)
105(define-enum IDNO)
106(define-enum IDOK)
107(define-enum IDRETRY)
108(define-enum IDTRYAGAIN)
109(define-enum IDYES)
110
111(define-cproc sys-message-box (window
112                               text::<const-cstring>?
113                               :optional (caption::<const-cstring>? #f)
114                                         (type::<uint> 0))
115  ::<int>
116  (let* ([h::HANDLE NULL]
117         [wtext::(const TCHAR*) NULL]
118         [wcaption::(const TCHAR*) NULL]
119         [r::int 0])
120    (cond [(SCM_FALSEP window) (= h NULL)]
121          [(Scm_WinHandleP window '#f) (= h (Scm_WinHandle window '#f))]
122          [else (SCM_TYPE_ERROR window "<win:handle> or #f")])
123    (when text    (= wtext (SCM_MBS2WCS text)))
124    (when caption (= wcaption (SCM_MBS2WCS caption)))
125    (= r (MessageBox h wtext wcaption type))
126    (when (== r 0) (Scm_SysError "MessageBox failed"))
127    (result r)))
128
129
130); defined(GAUCHE_WINDOWS)
131
132;; Local variables:
133;; mode: scheme
134;; end:
135