[graphic-forms-cvs] r102 - in trunk: . src/uitoolkit/system

[junrue at common-lisp.net]

Author: junrue
Date: Tue Apr 18 00:51:57 2006
New Revision: 102

Added:
   trunk/src/uitoolkit/system/comdlg32.lisp
Modified:
   trunk/graphic-forms-uitoolkit.asd
   trunk/src/uitoolkit/system/system-conditions.lisp
   trunk/src/uitoolkit/system/system-types.lisp
Log:
initial infrastructure for open/save dialogs

Modified: trunk/graphic-forms-uitoolkit.asd
==============================================================================
--- trunk/graphic-forms-uitoolkit.asd	(original)
+++ trunk/graphic-forms-uitoolkit.asd	Tue Apr 18 00:51:57 2006
@@ -59,6 +59,7 @@
                        (:file "system-types")
                        (:file "datastructs")
                        (:file "clib")
+                       (:file "comdlg32")
                        (:file "gdi32")
                        (:file "kernel32")
                        (:file "user32")

Added: trunk/src/uitoolkit/system/comdlg32.lisp
==============================================================================
--- (empty file)
+++ trunk/src/uitoolkit/system/comdlg32.lisp	Tue Apr 18 00:51:57 2006
@@ -0,0 +1,53 @@
+;;;;
+;;;; comdlg32.lisp
+;;;;
+;;;; Copyright (C) 2006, Jack D. Unrue
+;;;; All rights reserved.
+;;;;
+;;;; Redistribution and use in source and binary forms, with or without
+;;;; modification, are permitted provided that the following conditions
+;;;; are met:
+;;;; 
+;;;;     1. Redistributions of source code must retain the above copyright
+;;;;        notice, this list of conditions and the following disclaimer.
+;;;; 
+;;;;     2. Redistributions in binary form must reproduce the above copyright
+;;;;        notice, this list of conditions and the following disclaimer in the
+;;;;        documentation and/or other materials provided with the distribution.
+;;;; 
+;;;;     3. Neither the names of the authors nor the names of its contributors
+;;;;        may be used to endorse or promote products derived from this software
+;;;;        without specific prior written permission.
+;;;; 
+;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND ANY
+;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DIS-
+;;;; CLAIMED.  IN NO EVENT SHALL THE AUTHORS AND CONTRIBUTORS BE LIABLE FOR ANY
+;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;;
+
+(in-package :graphic-forms.uitoolkit.system)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (use-package :cffi))
+
+(load-foreign-library "comdlg32.dll")
+
+(defcfun
+  ("CommDlgExtendedError" comm-dlg-extended-error)
+  DWORD)
+
+(defcfun
+  ("GetOpenFileNameA" get-open-filename)
+  BOOL
+  (ofn LPTR))
+
+(defcfun
+  ("GetSaveFileNameA" get-save-filename)
+  BOOL
+  (ofn LPTR))

Modified: trunk/src/uitoolkit/system/system-conditions.lisp
==============================================================================
--- trunk/src/uitoolkit/system/system-conditions.lisp	(original)
+++ trunk/src/uitoolkit/system/system-conditions.lisp	Tue Apr 18 00:51:57 2006
@@ -62,3 +62,10 @@
 (defmethod print-object ((obj win32-warning) stream)
   (print-unreadable-object (obj stream :type t)
     (format stream "~s: error code: ~a" (detail obj) (code obj))))
+
+(define-condition comdlg-error (win32-error)
+  ((dlg-code :reader dlg-code :initarg :dlg-code :initform (comm-dlg-extended-error))))
+
+(defmethod print-object ((obj comdlg-error) stream)
+  (print-unreadable-object (obj stream :type t)
+    (format stream "~s: common dialog error code: ~a" (detail obj) (dlg-code obj))))

Modified: trunk/src/uitoolkit/system/system-types.lisp
==============================================================================
--- trunk/src/uitoolkit/system/system-types.lisp	(original)
+++ trunk/src/uitoolkit/system/system-types.lisp	Tue Apr 18 00:51:57 2006
@@ -208,6 +208,31 @@
   (flags DWORD)
   (device TCHAR :count 32)) ; CCHDEVICENAME
 
+(defcstruct openfilename
+  (ofnsize DWORD)
+  (ofnhwnd HANDLE)
+  (ofnhinst HANDLE)
+  (ofnfilter :string)
+  (ofncustomfilter :string)
+  (ofnmaxcustfilter DWORD)
+  (ofnfilterindex DWORD)
+  (ofnfile :string)
+  (ofnmaxfile DWORD)
+  (ofnfiletitle :string)
+  (ofnmaxfiletitle DWORD)
+  (ofninitialdir :string)
+  (ofntitle :string)
+  (ofnflags DWORD)
+  (ofnfileoffset WORD)
+  (ofnfileext WORD)
+  (ofndefext :string)
+  (ofncustdata LPARAM)
+  (ofnhookfn LPTR)
+  (ofntemplname :string)
+  (ofnpvreserved LPTR)
+  (ofndwreserved DWORD)
+  (ofnexflags DWORD))
+
 (defcstruct rgbquad
   (rgbblue BYTE)
   (rgbgreen BYTE)