Author: junrue Date: Wed May 10 15:41:30 2006 New Revision: 123

Modified: trunk/docs/manual/api.texinfo trunk/src/packages.lisp trunk/src/tests/uitoolkit/windlg.lisp trunk/src/uitoolkit/system/system-types.lisp trunk/src/uitoolkit/widgets/dialog.lisp trunk/src/uitoolkit/widgets/file-dialog.lisp trunk/src/uitoolkit/widgets/widget-classes.lisp trunk/src/uitoolkit/widgets/window.lisp Log: initial steps towards support for user-defined dialogs; refactored file-dialog and updated docs

Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Wed May 10 15:41:30 2006 @@ -191,7 +191,8 @@ This is the base class for system and user-defined dialogs. A dialog is a windowed UI component that is @emph{typically} defined to remain on top of the primary application window(s). Of course, some -applications are entirely dialog-based. +applications are entirely dialog-based. This class derives from +@ref{window}. @end deftp

@anchor{display} @@ -236,7 +237,7 @@ @end deftp

@anchor{file-dialog} -@deftp Class file-dialog +@deftp Class file-dialog open-mode This class provides a standard @ref{dialog} for navigating the file system to select or enter file names. A variety of configurations are possible; however, please note that the following behaviors are @@ -245,11 +246,15 @@ @item in @code{:save} mode, the user will be prompted to confirm overwrite when an existing file is selected @end itemize -Applications retrieve selected files by calling the @code{items} -function, which returns a @sc{vector} of @sc{file namestring}s, one -for each selection. Unless the @code{:multiple-select} style keyword -is specified, there will at most be one selected file returned, and -possibly zero if the user cancelled the dialog.@*@* +The @ref{with-file-dialog} macro wraps the creation of a +@code{file-dialog} and subsequent retrieval of the file paths selected +by the user. However, applications may choose to implements these +steps manually, in which case the @ref{file-dialog-paths} function can +be used to obtain the user's selection(s). Unless the +@code{:multiple-select} style keyword is specified, there will at most +be one selected file returned, and possibly zero if the user cancelled +the dialog. Also, manual construction of an instance must be followed +by an explicit call to @ref{dispose}.@*@* @deffn Initarg :default-extension Specifies a default extension to be appended to a file name if the user fails to provide one. Any embedded periods @samp{.} will @@ -743,6 +748,14 @@ Returns @sc{t} if @code{self} is enabled; @sc{nil} otherwise. @end deffn

+@anchor{file-dialog-paths} +@deffn Function file-dialog-paths dlg +Interrogates the data structure associated with an instance of +@ref{file-dialog} to obtain the paths for selected files. This return +value is either @sc{nil} if the user cancelled the dialog, or a list +of file @sc{namestring}s. +@end deffn + @deffn GenericFunction focus-p self Returns @sc{t} if @code{self} currently has keyboard focus; @sc{nil} otherwise. @@ -870,6 +883,7 @@ Causes the entire bounds of the object to be marked as needing to be redrawn @end deffn

+@anchor{show} @deffn GenericFunction show self flag Causes the object to be visible or hidden on the screen, but not necessarily top-most in the display z-order. @@ -901,6 +915,13 @@ @end deffn @end html

+@anchor{with-file-dialog} +@deffn Macro with-file-dialog (owner style paths &key default extension filters initial-directory initial-filename text) &body body +This macro wraps the instantiation of a standard file open/save dialog +and the subsequent retrieval of the user's file +selections. @xref{file-dialog}. +@end deffn +

@node layout functions @section layout functions

Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Wed May 10 15:41:30 2006 @@ -385,6 +385,7 @@ #:event-timer #:expand #:expanded-p + #:file-dialog-paths #:focus-index #:focus-p #:foreground-color @@ -482,6 +483,7 @@ #:visible-item-count #:visible-p #:with-children + #:with-file-dialog

;; conditions ))

Modified: trunk/src/tests/uitoolkit/windlg.lisp ============================================================================== --- trunk/src/tests/uitoolkit/windlg.lisp (original) +++ trunk/src/tests/uitoolkit/windlg.lisp Wed May 10 15:41:30 2006 @@ -98,24 +98,36 @@

(defun open-file-dlg (disp item time rect) (declare (ignore disp item time rect)) - (let ((dlg (make-instance 'gfw:file-dialog :owner *main-win* - :filters '(("FASL Files (*.fas;*.fsl)" . "*.fas;*.fsl") - ("Lisp Source Files (*.lisp;*.lsp)" . "*.lisp;*.lsp") - ("All Files (*.*)" . "*.*")) - :initial-directory #P"c:/" - :style '(:add-to-recent :multiple-select :open) - :text "Select Lisp-related files..."))) - (print (gfw:items dlg)))) + (gfw:with-file-dialog (*main-win* + '(:open :add-to-recent :multiple-select) + paths + :filters '(("FASL Files (*.fas;*.fsl)" . "*.fas;*.fsl") + ("Lisp Source Files (*.lisp;*.lsp)" . "*.lisp;*.lsp") + ("All Files (*.*)" . "*.*")) + :initial-directory #P"c:/" + :text "Select Lisp-related files...") + (print paths)))

(defun save-file-dlg (disp item time rect) (declare (ignore disp item time rect)) - (let ((dlg (make-instance 'gfw:file-dialog :owner *main-win* - :default-extension "dat" - :filters '(("Data files (*.dat)" . "*.dat") - ("All Files (*.*)" . "*.*")) - :initial-directory #P"c:/" - :style '(:save)))) - (print (gfw:items dlg)))) + (gfw:with-file-dialog (*main-win* + '(:save) + paths + :filters '(("Data files (*.dat)" . "*.dat") + ("All Files (*.*)" . "*.*")) + :initial-directory #P"c:/") + (print paths))) + +(defun open-modal-dlg (disp item time rect) + (declare (ignore disp item time rect))) +#| + (let ((dlg (make-instance 'gfw:dialog :owner *main-win* + :style '(:modal)))) + (gfw:show dlg t))) +|# + +(defun open-modeless-dlg (disp item time rect) + (declare (ignore disp item time rect)))

(defun run-windlg-internal () (let ((menubar nil)) @@ -123,13 +135,16 @@ :style '(:workspace))) (setf menubar (gfw:defmenu ((:item "&File" :submenu ((:item "E&xit" :callback #'windlg-exit-fn))) - (:item "&Dialogs" + (:item "&System Dialogs" :submenu ((:item "&Open File" :callback #'open-file-dlg) (:item "&Save File" :callback #'save-file-dlg))) + (:item "&User Dialogs" + :submenu ((:item "&Modal" :callback #'open-modal-dlg) + (:item "&Modeless" :callback #'open-modeless-dlg))) (:item "&Windows" :submenu ((:item "&Borderless" :callback #'create-borderless-win) (:item "&Mini Frame" :callback #'create-miniframe-win) - (:item "&Palette" :callback #'create-palette-win)))))) + (:item "&Palette" :callback #'create-palette-win)))))) (setf (gfw:menu-bar *main-win*) menubar) (gfw:show *main-win* t)))

Modified: trunk/src/uitoolkit/system/system-types.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-types.lisp (original) +++ trunk/src/uitoolkit/system/system-types.lisp Wed May 10 15:41:30 2006 @@ -218,17 +218,17 @@ (ofnfilterindex DWORD) (ofnfile LPTR) (ofnmaxfile DWORD) - (ofnfiletitle :string) + (ofnfiletitle :pointer) (ofnmaxfiletitle DWORD) - (ofninitialdir :string) - (ofntitle :string) + (ofninitialdir :pointer) + (ofntitle :pointer) (ofnflags DWORD) (ofnfileoffset WORD) (ofnfileext WORD) - (ofndefext :string) + (ofndefext :pointer) (ofncustdata LPARAM) (ofnhookfn LPTR) - (ofntemplname :string) + (ofntemplname :pointer) (ofnpvreserved LPTR) (ofndwreserved DWORD) (ofnexflags DWORD))

Modified: trunk/src/uitoolkit/widgets/dialog.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/dialog.lisp (original) +++ trunk/src/uitoolkit/widgets/dialog.lisp Wed May 10 15:41:30 2006 @@ -34,27 +34,20 @@ (in-package :graphic-forms.uitoolkit.widgets)

;;; -;;; methods +;;; helper functions ;;;

-(defmethod focus-p :before ((dlg dialog)) - (if (gfs:disposed-p dlg) - (error 'gfs:disposed-error))) - -(defmethod focus-p ((dlg dialog)) - (let ((focus-hwnd (gfs::get-focus))) - (and (not (gfs:null-handle-p focus-hwnd)) (cffi:pointer-eq focus-hwnd (gfs:handle dlg))))) - -(defmethod give-focus :before ((dlg dialog)) - (if (gfs:disposed-p dlg) - (error 'gfs:disposed-error))) +#| +(defun register-user-dialog-class () + (register-window-class +user-dialog-classname+ + (cffi:get-callback 'uit_dialog_wndproc) + (logior gfs::+cs-dblclks+ + gfs::+cs-savebits+ + gfs::+cs-bytealignwindow+) + gfs::+color-btnface+)) +|#

-(defmethod give-focus ((dlg dialog)) - (if (gfs:null-handle-p (gfs::set-focus (gfs:handle dlg))) - (error 'gfs:toolkit-error "set-focus failed"))) +;;; +;;; methods +;;;

-(defmethod print-object ((self dialog) stream) - (print-unreadable-object (self stream :type t) - (format stream "handle: ~x " (gfs:handle self)) - (format stream "dispatcher: ~a " (dispatcher self)) - (format stream "size: ~a" (size self))))

Modified: trunk/src/uitoolkit/widgets/file-dialog.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/file-dialog.lisp (original) +++ trunk/src/uitoolkit/widgets/file-dialog.lisp Wed May 10 15:41:30 2006 @@ -37,6 +37,39 @@ ;;; helper functions ;;;

+(defun file-dialog-paths (dlg) + (let ((paths nil) + (ofn-ptr (gfs:handle dlg))) + (if (cffi:null-pointer-p ofn-ptr) + (error 'gfs:disposed-error)) + (cffi:with-foreign-slots ((gfs::ofnfile) ofn-ptr gfs::openfilename) + (unless (or (cffi:null-pointer-p gfs::ofnfile) (= (cffi:mem-ref gfs::ofnfile :char) 0)) + (let* ((raw-list (extract-foreign-strings gfs::ofnfile)) + (dir-str (first raw-list))) + (if (cdr raw-list) + (setf paths (loop for filename in (cdr raw-list) + collect (parse-namestring (concatenate 'string dir-str "\" filename)))) + (setf paths (list (parse-namestring dir-str))))))) + paths)) + +(defmacro with-file-dialog ((owner style paths &key default-extension filters initial-directory initial-filename text) &body body) + (let ((dlg (gensym))) + `(let ((,paths nil) + (,dlg (make-instance 'file-dialog + :default-extension ,default-extension + :filters ,filters + :initial-directory ,initial-directory + :initial-filename ,initial-filename + :owner ,owner + :style ,style + :text ,text))) + (unwind-protect + (progn + (show ,dlg t) + (setf ,paths (file-dialog-paths ,dlg)) + ,@body) + (gfs:dispose ,dlg))))) + ;;; ;;; methods ;;; @@ -58,6 +91,23 @@ (setf std-flags (logior std-flags gfs::+ofn-forceshowhidden+))))) (values std-flags 0)))

+(defmethod gfs:dispose ((dlg file-dialog)) + (let ((ofn-ptr (gfs:handle dlg))) + (unless (cffi:null-pointer-p ofn-ptr) + (cffi:with-foreign-slots ((gfs::ofnfile gfs::ofnfilter gfs::ofntitle + gfs::ofninitialdir gfs::ofndefext) + ofn-ptr gfs::openfilename) + (cffi:foreign-free gfs::ofnfile) + (cffi:foreign-free gfs::ofnfilter) + (unless (cffi:null-pointer-p gfs::ofntitle) + (cffi:foreign-free gfs::ofntitle)) + (unless (cffi:null-pointer-p gfs::ofninitialdir) + (cffi:foreign-free gfs::ofninitialdir)) + (unless (cffi:null-pointer-p gfs::ofndefext) + (cffi:foreign-free gfs::ofndefext))) + (cffi:foreign-free ofn-ptr) + (setf (slot-value dlg 'gfs:handle) (cffi:null-pointer))))) + (defmethod initialize-instance :after ((dlg file-dialog) &key default-extension filters initial-directory initial-filename owner style text) ;; FIXME: implement an OFNHookProc to process CDN_SELCHANGE ;; so that the file buffer can be resized as needed for @@ -67,7 +117,7 @@ (error 'gfs:toolkit-error :detail ":owner initarg is required")) (if (gfs:disposed-p owner) (error 'gfs:disposed-error)) - (let ((struct-ptr (cffi:foreign-alloc 'gfs::openfilename)) + (let ((ofn-ptr (cffi:foreign-alloc 'gfs::openfilename)) (filters-buffer (if filters (collect-foreign-strings (loop for entry in filters append (list (car entry) (cdr entry)))) @@ -81,8 +131,7 @@ (if initial-directory (setf dir-buffer (collect-foreign-strings (list initial-directory)))) (if default-extension - (progn - (setf ext-buffer (collect-foreign-strings (list (remove #. default-extension)))))) + (setf ext-buffer (collect-foreign-strings (list (remove #. default-extension))))) (if initial-filename (cffi:with-foreign-string (tmp-str (namestring initial-filename)) (gfs::strncpy file-buffer tmp-str 1023)) @@ -95,7 +144,7 @@ gfs::ofninitialdir gfs::ofntitle gfs::ofnflags gfs::ofnfileoffset gfs::ofnfileext gfs::ofndefext gfs::ofncustdata gfs::ofnhookfn gfs::ofntemplname gfs::ofnpvreserved gfs::ofndwreserved gfs::ofnexflags) - struct-ptr gfs::openfilename) + ofn-ptr gfs::openfilename) (setf gfs::ofnsize (cffi:foreign-type-size 'gfs::openfilename) gfs::ofnhwnd (gfs:handle owner) gfs::ofnhinst (cffi:null-pointer) @@ -119,23 +168,12 @@ gfs::ofnpvreserved (cffi:null-pointer) gfs::ofndwreserved 0 gfs::ofnexflags ex-style))) - (unwind-protect - (let ((fn (if (find :save style) #'gfs::get-save-filename #'gfs::get-open-filename))) - (if (and (zerop (funcall fn struct-ptr)) (/= (gfs::comm-dlg-extended-error) 0)) - (error 'gfs:comdlg-error :detail "file dialog function failed")) - (unless (or (cffi:null-pointer-p file-buffer) (= (cffi:mem-ref file-buffer :char) 0)) - (let* ((raw-list (extract-foreign-strings file-buffer)) - (dir-str (first raw-list))) - (if (cdr raw-list) - (setf (items dlg) (loop for filename in (cdr raw-list) - collect (parse-namestring (concatenate 'string dir-str "\" filename)))) - (setf (items dlg) (list (parse-namestring dir-str))))))) - (cffi:foreign-free file-buffer) - (cffi:foreign-free filters-buffer) - (unless (cffi:null-pointer-p title-buffer) - (cffi:foreign-free title-buffer)) - (unless (cffi:null-pointer-p dir-buffer) - (cffi:foreign-free dir-buffer)) - (unless (cffi:null-pointer-p ext-buffer) - (cffi:foreign-free ext-buffer)) - (cffi:foreign-free struct-ptr)))) + (setf (slot-value dlg 'gfs:handle) ofn-ptr) + (setf (slot-value dlg 'open-mode) (find :open style)))) + +(defmethod show ((dlg file-dialog) flag) + (declare (ignore flag)) + (let ((ofn-ptr (gfs:handle dlg)) + (fn (if (open-mode dlg) #'gfs::get-open-filename #'gfs::get-save-filename))) + (if (and (zerop (funcall fn ofn-ptr)) (/= (gfs::comm-dlg-extended-error) 0)) + (error 'gfs:comdlg-error :detail "file dialog function failed"))))

Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Wed May 10 15:41:30 2006 @@ -96,12 +96,6 @@ :initform (make-array 7 :fill-pointer 0 :adjustable t))) (:documentation "The widget-with-items class is the base class for objects composed of sub-items."))

-(defclass dialog (widget-with-items) () - (:documentation "The dialog class is the base class for both system-defined and application-defined dialogs.")) - -(defclass file-dialog (dialog) () - (:documentation "This class represents the standard file open/save dialog.")) - (defclass menu (widget-with-items) () (:documentation "The menu class represents a container for menu items (and submenus)."))

@@ -115,6 +109,15 @@ :initform nil)) (:documentation "Base class for user-defined widgets that serve as containers."))

+(defclass dialog (window) () + (:documentation "The dialog class is the base class for both system-defined and application-defined dialogs.")) + +(defclass file-dialog (dialog) + ((open-mode + :reader open-mode + :initform t)) + (:documentation "This class represents the standard file open/save dialog.")) + (defclass panel (window) () (:documentation "Base class for windows that are children of top-level windows (or other panels)."))

Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Wed May 10 15:41:30 2006 @@ -35,7 +35,8 @@

(eval-when (:compile-toplevel :load-toplevel :execute) (defconstant +toplevel-erasebkgnd-window-classname+ "GraphicFormsTopLevelEraseBkgnd") - (defconstant +toplevel-noerasebkgnd-window-classname+ "GraphicFormsTopLevelNoEraseBkgnd")) + (defconstant +toplevel-noerasebkgnd-window-classname+ "GraphicFormsTopLevelNoEraseBkgnd") + (defconstant +user-dialog-classname+ "GraphicFormsUserDialog"))

;;; ;;; helper functions @@ -102,7 +103,7 @@ (pop-child-visitor-func tc))) nil)

-(defun register-window-class (class-name proc-ptr style bkgcolor) +(defun register-window-class (class-name proc-ptr style bkgcolor &optional wndextra) (let ((retval 0)) (cffi:with-foreign-string (str-ptr class-name) (cffi:with-foreign-object (wc-ptr 'gfs::wndclassex) @@ -120,7 +121,7 @@ (setf gfs::style style) (setf gfs::wndproc proc-ptr) (setf gfs::clsextra 0) - (setf gfs::wndextra 0) + (setf gfs::wndextra (or wndextra 0)) (setf gfs::hinst (gfs::get-module-handle (cffi:null-pointer))) (setf gfs::hicon (cffi:null-pointer)) (setf gfs::hcursor (gfs::load-image (cffi:null-pointer)