Author: junrue Date: Fri Aug 10 00:48:34 2007 New Revision: 470
Modified: trunk/docs/manual/Makefile trunk/docs/manual/symbols.xsl trunk/src/uitoolkit/system/user32.lisp trunk/src/uitoolkit/widgets/display.lisp Log: revised GFW:OBTAIN-PRIMARY-DISPLAY based on Raymon Chen blog entry; minor fixes to ref manual source and makefile
Modified: trunk/docs/manual/Makefile ============================================================================== --- trunk/docs/manual/Makefile (original) +++ trunk/docs/manual/Makefile Fri Aug 10 00:48:34 2007 @@ -12,7 +12,8 @@ catalog.xml glossary.xml graphic-forms.xml image-data-plugins.xml \ introduction.xml legal.xml protocols.xml miscellaneous-topics.xml
-COMMON-DEPS = symbols.xsl packages.xsl clhs-table.xml win32-api-table.xml +COMMON-DEPS = symbols.xsl packages.xsl clhs-table.xml win32-api-table.xml \ + packages.xml
GFC-PKG-DEPS = gfc-class-symbols-tmp.xml gfc-function-symbols-tmp.xml gfc-macro-symbols-tmp.xml
Modified: trunk/docs/manual/symbols.xsl ============================================================================== --- trunk/docs/manual/symbols.xsl (original) +++ trunk/docs/manual/symbols.xsl Fri Aug 10 00:48:34 2007 @@ -111,7 +111,7 @@ </xsl:when> xsl:otherwise <xsl:message terminate="yes"> - xsl:textgf-data.xsl: could not find argument </xsl:text><xsl:value-of select="$index - 1"/> + xsl:textsymbols.xsl: could not find argument </xsl:text><xsl:value-of select="$index - 1"/> </xsl:message> </xsl:otherwise> </xsl:choose>
Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Fri Aug 10 00:48:34 2007 @@ -499,6 +499,13 @@ (langid WORD))
(defcfun + ("MonitorFromPoint" monitor-from-point) + HANDLE + (pntx LONG) + (pnty LONG) + (flags DWORD)) + +(defcfun ("MonitorFromWindow" monitor-from-window) HANDLE (hwnd HANDLE)
Modified: trunk/src/uitoolkit/widgets/display.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/display.lisp (original) +++ trunk/src/uitoolkit/widgets/display.lisp Fri Aug 10 00:48:34 2007 @@ -52,7 +52,7 @@ (error 'gfs:win32-warning :detail "get-monitor-info failed")) (push (= (logand gfs::flags gfs::+monitorinfoof-primary+) gfs::+monitorinfoof-primary+) info) (let ((str-ptr (cffi:foreign-slot-pointer mi-ptr 'gfs::monitorinfoex 'gfs::device))) - (push (cffi:foreign-string-to-lisp str-ptr :count (1- gfs::+cchdevicename+)) info)) + (push (cffi:foreign-string-to-lisp str-ptr (1- gfs::+cchdevicename+)) info)) (let ((rect-ptr (cffi:foreign-slot-pointer mi-ptr 'gfs::monitorinfoex 'gfs::monitor))) (cffi:with-foreign-slots ((gfs::left gfs::top gfs::right gfs::bottom) rect-ptr gfs::rect) @@ -88,8 +88,14 @@ (push (make-instance 'display :handle hmonitor) (display-visitor-results (thread-context))))))
+(declaim (inline obtain-primary-display)) (defun obtain-primary-display () - (find-if #'primary-p (obtain-displays))) + ;; In http://blogs.msdn.com/oldnewthing/archive/2007/08/09/4300545.aspx + ;; Raymond Chen recommends the following technique for obtaining the + ;; primary display. + ;; + (make-instance 'display + :handle (gfs::monitor-from-point 0 0 gfs::+monitor-defaulttoprimary+)))
(cffi:defcallback (top-level-window-visitor :cconv :stdcall) gfs::BOOL ((hwnd :pointer) (lparam gfs::LPARAM))