[graphic-forms-cvs] r470 - in trunk: docs/manual src/uitoolkit/system src/uitoolkit/widgets

[junrue at common-lisp.net]

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:text>gf-data.xsl: could not find argument </xsl:text><xsl:value-of select="$index - 1"/>
+            <xsl:text>symbols.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))