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