[graphic-forms-cvs] r299 - in trunk: . docs/manual docs/manual/gfw src/uitoolkit/widgets - graphic-forms-cvs@common-lisp.net - mailman3.common-lisp.net

11 Oct 2006

Author: junrue
Date: Wed Oct 11 16:50:24 2006
New Revision: 299
Added:
   trunk/docs/manual/gfw/event-move.html
   trunk/docs/manual/gfw/event-pre-move.html
Modified:
   trunk/NEWS.txt
   trunk/docs/manual/Graphic-FormsProgrammingReference.wcp
   trunk/docs/manual/gfw/event-pre-resize.html
   trunk/src/uitoolkit/widgets/event-generics.lisp
   trunk/src/uitoolkit/widgets/event.lisp
Log:
implemented event-pre-move
Modified: trunk/NEWS.txt
==============================================================================

--- trunk/NEWS.txt	(original)
+++ trunk/NEWS.txt	Wed Oct 11 16:50:24 2006
@@ -27,6 +27,12 @@
   * scrolling-event-dispatcher for automatic management of a scrollable
     child panel and window scrollbars
+. Implemented GFW:EVENT-PRE-RESIZE function so that applications can customize
+  the behavior of a window's size drag rectangle.
+
+. Implemented GFW:EVENT-PRE-MOVE function so that applications can customize
+  the behavior of a window's move drag rectangle.
+
 . Improved GFW:HEAP-LAYOUT such that it obeys the top child's minimum and
   maximum sizes, if any such sizes are set.
@@ -38,12 +44,12 @@
 . Implemented GFW:ENABLE-REDRAW to enable applications to temporarily
   disable (and later re-enable) drawing of widget content.
-. Fixed a silly bug in GFW:CHECKED-P (and GFW:SELECTED-P) for checkbox and
+. Fixed a bug in GFW:CHECKED-P (and GFW:SELECTED-P) for checkbox and
   radio button -style buttons.
-. Fixed another silly bug, this one in the initialization of the paint
-  rectangle in the WM_PAINT message handling method; the correct rectangle
-  is now passed to GFW:EVENT-PAINT
+. Fixed a bug in the initialization of the paint rectangle in the WM_PAINT
+  message handling method; the correct rectangle is now passed to
+  GFW:EVENT-PAINT
. Fixed a bug in the SETF methods for GFW:MAXIMUM-SIZE and GFW:MINIMUM-SIZE
   for windows whereby the size value was not being set in the appropriate
Modified: trunk/docs/manual/Graphic-FormsProgrammingReference.wcp
==============================================================================
--- trunk/docs/manual/Graphic-FormsProgrammingReference.wcp	(original)
+++ trunk/docs/manual/Graphic-FormsProgrammingReference.wcp	Wed Oct 11 16:50:24 2006
@@ -92,7 +92,7 @@
 DefaultTopic=Introduction.html
[TOPICS]
-TitleList=72
+TitleList=74
 TitleList.Title.0=Legal Information
 TitleList.Level.0=0
 TitleList.Url.0=LegalInfo.html
@@ -693,99 +693,99 @@
 TitleList.ApplyTemp.59=0
 TitleList.Expanded.59=0
 TitleList.Kind.59=0
-TitleList.Title.60=event-pre-resize
+TitleList.Title.60=event-move
 TitleList.Level.60=2
-TitleList.Url.60=gfw\event-pre-resize.html
+TitleList.Url.60=gfw\event-move.html
 TitleList.Icon.60=0
 TitleList.Status.60=0
-TitleList.Keywords.60=event-pre-resize
+TitleList.Keywords.60=event-move
 TitleList.ContextNumber.60=
 TitleList.ApplyTemp.60=0
 TitleList.Expanded.60=0
 TitleList.Kind.60=0
-TitleList.Title.61=event-resize
+TitleList.Title.61=event-pre-move
 TitleList.Level.61=2
-TitleList.Url.61=gfw\event-resize.html
+TitleList.Url.61=gfw\event-pre-move.html
 TitleList.Icon.61=0
 TitleList.Status.61=0
-TitleList.Keywords.61=event-resize
+TitleList.Keywords.61=event-pre-move
 TitleList.ContextNumber.61=
 TitleList.ApplyTemp.61=0
 TitleList.Expanded.61=0
 TitleList.Kind.61=0
-TitleList.Title.62=event-select
+TitleList.Title.62=event-pre-resize
 TitleList.Level.62=2
-TitleList.Url.62=gfw\event-select.html
+TitleList.Url.62=gfw\event-pre-resize.html
 TitleList.Icon.62=0
 TitleList.Status.62=0
-TitleList.Keywords.62=event-select
+TitleList.Keywords.62=event-pre-resize
 TitleList.ContextNumber.62=
 TitleList.ApplyTemp.62=0
 TitleList.Expanded.62=0
 TitleList.Kind.62=0
-TitleList.Title.63=event-source
+TitleList.Title.63=event-resize
 TitleList.Level.63=2
-TitleList.Url.63=gfw\event-source.html
+TitleList.Url.63=gfw\event-resize.html
 TitleList.Icon.63=0
 TitleList.Status.63=0
-TitleList.Keywords.63=event-source
+TitleList.Keywords.63=event-resize
 TitleList.ContextNumber.63=
 TitleList.ApplyTemp.63=0
 TitleList.Expanded.63=0
 TitleList.Kind.63=0
-TitleList.Title.64=message-loop
+TitleList.Title.64=event-select
 TitleList.Level.64=2
-TitleList.Url.64=gfw\message-loop.html
+TitleList.Url.64=gfw\event-select.html
 TitleList.Icon.64=0
 TitleList.Status.64=0
-TitleList.Keywords.64=message-loop
+TitleList.Keywords.64=event-select
 TitleList.ContextNumber.64=
 TitleList.ApplyTemp.64=0
 TitleList.Expanded.64=0
 TitleList.Kind.64=0
-TitleList.Title.65=obtain-event-time
+TitleList.Title.65=event-source
 TitleList.Level.65=2
-TitleList.Url.65=gfw\obtain-event-time.html
+TitleList.Url.65=gfw\event-source.html
 TitleList.Icon.65=0
 TitleList.Status.65=0
-TitleList.Keywords.65=obtain-event-time
+TitleList.Keywords.65=event-source
 TitleList.ContextNumber.65=
 TitleList.ApplyTemp.65=0
 TitleList.Expanded.65=0
 TitleList.Kind.65=0
-TitleList.Title.66=with-graphics-context
+TitleList.Title.66=message-loop
 TitleList.Level.66=2
-TitleList.Url.66=gfw\with-graphics-context.html
+TitleList.Url.66=gfw\message-loop.html
 TitleList.Icon.66=0
 TitleList.Status.66=0
-TitleList.Keywords.66=with-graphics-context
+TitleList.Keywords.66=message-loop
 TitleList.ContextNumber.66=
 TitleList.ApplyTemp.66=0
 TitleList.Expanded.66=0
 TitleList.Kind.66=0
-TitleList.Title.67=Miscellaneous Topics
-TitleList.Level.67=0
-TitleList.Url.67=MiscellaneousTopics.html
+TitleList.Title.67=obtain-event-time
+TitleList.Level.67=2
+TitleList.Url.67=gfw\obtain-event-time.html
 TitleList.Icon.67=0
 TitleList.Status.67=0
-TitleList.Keywords.67=
+TitleList.Keywords.67=obtain-event-time
 TitleList.ContextNumber.67=
 TitleList.ApplyTemp.67=0
 TitleList.Expanded.67=0
 TitleList.Kind.67=0
-TitleList.Title.68=Image Data Plugins
-TitleList.Level.68=1
-TitleList.Url.68=ImageDataPlugins.html
+TitleList.Title.68=with-graphics-context
+TitleList.Level.68=2
+TitleList.Url.68=gfw\with-graphics-context.html
 TitleList.Icon.68=0
 TitleList.Status.68=0
-TitleList.Keywords.68=
+TitleList.Keywords.68=with-graphics-context
 TitleList.ContextNumber.68=
 TitleList.ApplyTemp.68=0
 TitleList.Expanded.68=0
 TitleList.Kind.68=0
-TitleList.Title.69=Terminology Conventions
+TitleList.Title.69=Miscellaneous Topics
 TitleList.Level.69=0
-TitleList.Url.69=TerminologyConventions.html
+TitleList.Url.69=MiscellaneousTopics.html
 TitleList.Icon.69=0
 TitleList.Status.69=0
 TitleList.Keywords.69=
@@ -793,9 +793,9 @@
 TitleList.ApplyTemp.69=0
 TitleList.Expanded.69=0
 TitleList.Kind.69=0
-TitleList.Title.70=Glossary
-TitleList.Level.70=0
-TitleList.Url.70=Glossary.html
+TitleList.Title.70=Image Data Plugins
+TitleList.Level.70=1
+TitleList.Url.70=ImageDataPlugins.html
 TitleList.Icon.70=0
 TitleList.Status.70=0
 TitleList.Keywords.70=
@@ -803,14 +803,34 @@
 TitleList.ApplyTemp.70=0
 TitleList.Expanded.70=0
 TitleList.Kind.70=0
-TitleList.Title.71=Footnotes
+TitleList.Title.71=Terminology Conventions
 TitleList.Level.71=0
-TitleList.Url.71=Footnotes.html
+TitleList.Url.71=TerminologyConventions.html
 TitleList.Icon.71=0
 TitleList.Status.71=0
 TitleList.Keywords.71=
 TitleList.ContextNumber.71=
 TitleList.ApplyTemp.71=0
 TitleList.Expanded.71=0
-TitleList.Kind.71=1
+TitleList.Kind.71=0
+TitleList.Title.72=Glossary
+TitleList.Level.72=0
+TitleList.Url.72=Glossary.html
+TitleList.Icon.72=0
+TitleList.Status.72=0
+TitleList.Keywords.72=
+TitleList.ContextNumber.72=
+TitleList.ApplyTemp.72=0
+TitleList.Expanded.72=0
+TitleList.Kind.72=0
+TitleList.Title.73=Footnotes
+TitleList.Level.73=0
+TitleList.Url.73=Footnotes.html
+TitleList.Icon.73=0
+TitleList.Status.73=0
+TitleList.Keywords.73=
+TitleList.ContextNumber.73=
+TitleList.ApplyTemp.73=0
+TitleList.Expanded.73=0
+TitleList.Kind.73=1
Added: trunk/docs/manual/gfw/event-move.html
==============================================================================
--- (empty file)
+++ trunk/docs/manual/gfw/event-move.html	Wed Oct 11 16:50:24 2006
@@ -0,0 +1,70 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+<head>
+<title>event-move</title>
+<meta name="GENERATOR" content="WinCHM">
+<meta http-equiv="Content-Type" content="text/html; charset=Windows-1252">
+
+</head>
+
+<body><FONT face=Arial>
+<H4>
+<TABLE style="WIDTH: 100%; BORDER-COLLAPSE: collapse" 
+borderColor=#ffffff cellSpacing=0 cellPadding=2 width="100%" border=1>
+  
+  <TR>
+    <TD width="60%"><STRONG>event-move</STRONG></TD>
+    <TD>
+      <P><FONT size=2>[Generic Function]</FONT>&nbsp;</P></TD></TR></TABLE>
+<HR></H4>
+<P></FONT><FONT face=Arial><STRONG>syntax</STRONG></FONT></P>
+  <P dir=ltr style="MARGIN-RIGHT: 0px"><FONT 
+face=Arial size=2><FONT face=Arial size=2>(gfw:event-move&nbsp;<A 
+href="event-dispatcher.html"><EM>event-dispatcher</EM></A><EM> widget 
+</EM>  <A 
+href="../gfs/point.html"><EM>point</EM></A>)<EM> </EM></P>
+<H4><FONT face=Arial>arguments 
+<P>
+<TABLE style="WIDTH: 100%; BORDER-COLLAPSE: collapse" borderColor=#ffffff 
+cellSpacing=0 cellPadding=2 width="100%" border=1>
+  
+  <TR>
+    <TD width="20%"><EM><FONT size=2>event-dispatcher</FONT></EM></TD>
+    <TD><FONT size=2>The&nbsp;<A href="event-dispatcher.html" >event-dispatcher</A> that will 
+      process the&nbsp;move event.</FONT></TD></TR>
+  <TR>
+    <TD width="20%"><FONT size=2><EM>widget</EM></FONT></TD>
+    <TD><FONT size=2>The widget being 
+moved.</FONT></TD></TR>
+  <TR>
+    <TD width="20%"><FONT size=2><EM>point</EM></FONT></TD>
+    <TD><FONT size=2>A <A 
+      href="../gfs/point.html">point</A> object describing widget's new 
+      location.</FONT></TD></TR></TABLE></P>description</FONT></H4><FONT face=Arial size=2>
+<P dir=ltr style="MARGIN-RIGHT: 0px"><FONT face=Arial size=2>       Implement a method for this generic function to respond to 
+<EM>widget</EM>               
+            
+              
+              
+                
+            
+              
+  
+      being   
+       moved.</FONT></P>
+<H4><FONT face=Arial>see also</FONT></H4><FONT face=Arial size=2><FONT 
+face=Arial size=2><FONT face=Arial size=2>
+<P><A href="event-pre-move.html">event-pre-move</A></P></FONT></FONT></FONT>
+<HR>
+
+<P dir=ltr style="MARGIN-RIGHT: 0px"> </P>
+<P dir=ltr style="MARGIN-RIGHT: 0px">
+<TABLE style="WIDTH: 100%; BORDER-COLLAPSE: collapse" borderColor=#ffffff 
+cellSpacing=0 cellPadding=2 width="100%" border=1>
+  
+  <TR>
+    <TD width="60%">&nbsp; </TD>
+    <TD>
+      <P><FONT size=1>Copyright � 2006, Jack D. Unrue</FONT> 
+</P></TD></TR></TABLE></P></FONT></FONT></FONT></body>
+</html>
Added: trunk/docs/manual/gfw/event-pre-move.html
==============================================================================
--- (empty file)
+++ trunk/docs/manual/gfw/event-pre-move.html	Wed Oct 11 16:50:24 2006
@@ -0,0 +1,77 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+<head>
+<title>event-pre-move</title>
+<meta name="GENERATOR" content="WinCHM">
+<meta http-equiv="Content-Type" content="text/html; charset=Windows-1252">
+
+</head>
+
+<body><FONT face=Arial>
+<H4>
+<TABLE style="WIDTH: 100%; BORDER-COLLAPSE: collapse" 
+borderColor=#ffffff cellSpacing=0 cellPadding=2 width="100%" border=1>
+  
+  <TR>
+    <TD width="60%"><STRONG>event-pre-move</STRONG></TD>
+    <TD>
+      <P><FONT size=2>[Generic Function]</FONT>&nbsp;</P></TD></TR></TABLE>
+<HR></H4>
+<P></FONT><FONT face=Arial><STRONG>syntax</STRONG></FONT></P>
+  <P dir=ltr style="MARGIN-RIGHT: 0px"><FONT 
+face=Arial size=2><FONT face=Arial size=2>(gfw:event-pre-move <EM><A 
+href="event-dispatcher.html">event-dispatcher</A> widget <A 
+href="../gfs/rectangle.html" >rectangle</A>)   
+ </EM></P>
+<H4><FONT face=Arial>arguments 
+<P>
+<TABLE style="WIDTH: 100%; BORDER-COLLAPSE: collapse" borderColor=#ffffff 
+cellSpacing=0 cellPadding=2 width="100%" border=1>
+  
+  <TR>
+    <TD width="20%"><EM><FONT size=2>event-dispatcher</FONT></EM></TD>
+    <TD><FONT size=2>The&nbsp;<A href="event-dispatcher.html" >event-dispatcher</A> that will 
+      process the&nbsp;move event.</FONT></TD></TR>
+  <TR>
+    <TD width="20%"><FONT size=2><EM>widget</EM></FONT></TD>
+    <TD><FONT size=2>The widget being 
+moved.</FONT></TD></TR>
+  <TR>
+    <TD width="20%"><FONT size=2><EM>rectangle</EM></FONT></TD>
+    <TD><FONT size=2>A <A 
+      href="../gfs/rectangle.html">rectangle</A> object describing 
+      the&nbsp;move drag rectangle, which may be modified by the 
+      application.</FONT></TD></TR></TABLE></P>description</FONT></H4><FONT face=Arial size=2>
+<P dir=ltr style="MARGIN-RIGHT: 0px"><FONT face=Arial size=2>       Implement a method for this generic function to respond to 
+<EM>widget</EM> being moved. This event function gives the 
+application an opportunity to modify the move drag outline prior to the move 
+event being delivered, thus controlling the resulting 
+location.               
+            
+              
+              
+                
+            
+              
+  
+         
+       </FONT></P></FONT></FONT></FONT>
+<H4><FONT face=Arial>see also</FONT></H4><FONT face=Arial size=2><FONT 
+face=Arial size=2><FONT face=Arial size=2>
+<P><A href="event-move.html">event-move</A></P>
+<P>
+<HR>
+
+<P></P>
+
+<P dir=ltr style="MARGIN-RIGHT: 0px"> </P>
+<P dir=ltr style="MARGIN-RIGHT: 0px">
+<TABLE style="WIDTH: 100%; BORDER-COLLAPSE: collapse" borderColor=#ffffff 
+cellSpacing=0 cellPadding=2 width="100%" border=1>
+  
+  <TR>
+    <TD width="60%">&nbsp; </TD>
+    <TD>
+      <P><FONT size=1>Copyright � 2006, Jack D. Unrue</FONT> 
+</P></TD></TR></TABLE></P></FONT></FONT></FONT></body>
+</html>
Modified: trunk/docs/manual/gfw/event-pre-resize.html
==============================================================================
--- trunk/docs/manual/gfw/event-pre-resize.html	(original)
+++ trunk/docs/manual/gfw/event-pre-resize.html	Wed Oct 11 16:50:24 2006
@@ -39,8 +39,9 @@
   <TR>
     <TD width="20%"><FONT size=2><EM>rectangle</EM></FONT></TD>
     <TD><FONT size=2>A <A 
-      href="../gfs/rectangle.html">rectangle</A> object describing the resize drag 
-      rectangle.</FONT></TD></TR>
+      href="../gfs/rectangle.html">rectangle</A> object describing the 
+      resize drag rectangle, which may be modified by the 
+      application.</FONT></TD></TR>
   <TR>
     <TD width="20%"><FONT size=2><EM>type</EM></FONT></TD>
     <TD>
@@ -66,9 +67,9 @@
 </FONT></P></TD></TR></TABLE></P>description</FONT></H4><FONT face=Arial size=2>
 <P dir=ltr style="MARGIN-RIGHT: 0px"><FONT face=Arial size=2>       Implement a method for this generic function to respond to 
 <EM>widget</EM> being resized. This event function gives the 
-application an opportunity to modify the resize drag outline. This is 
-accomplished by changing one or more of the coordinates of 
-<EM>rectangle.</EM>               
+application an opportunity to modify the resize drag outline prior to the resize 
+event being delivered, thus controlling the resulting 
+dimensions.
Modified: trunk/src/uitoolkit/widgets/event-generics.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event-generics.lisp	(original)
+++ trunk/src/uitoolkit/widgets/event-generics.lisp	Wed Oct 11 16:50:24 2006
@@ -163,10 +163,10 @@
   (:method (dispatcher widget keycode char span new-content)
     (declare (ignorable dispatcher widget keycode char span new-content))))
-(defgeneric event-pre-move (dispatcher widget)
-  (:documentation "Implement this to preempt moving; return T if processed or nil if not.")
-  (:method (dispatcher widget)
-    (declare (ignorable dispatcher widget))))
+(defgeneric event-pre-move (dispatcher widget rect)
+  (:documentation "Implement this to modify widget's move drag rectangle.")
+  (:method (dispatcher widget rect)
+    (declare (ignorable dispatcher widget rect))))
(defgeneric event-pre-resize (dispatcher widget rect type)
   (:documentation "Implement this to modify widget's resize drag rectangle.")
Modified: trunk/src/uitoolkit/widgets/event.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event.lisp	(original)
+++ trunk/src/uitoolkit/widgets/event.lisp	Wed Oct 11 16:50:24 2006
@@ -345,12 +345,19 @@
   0)
(defmethod process-message (hwnd (msg (eql gfs::+wm-moving+)) wparam lparam)
-  (declare (ignore wparam lparam))
-  (let* ((tc (thread-context))
-         (w (get-widget tc hwnd)))
-    (if (and w (event-pre-move (dispatcher w) w))
-      1
-      0)))
+  (declare (ignore wparam))
+  (let* ((w (get-widget (thread-context) hwnd))
+         (ptr (cffi:make-pointer (logand #xFFFFFFFF lparam)))
+         (rect (cffi:convert-from-foreign ptr 'gfs::rect-pointer)))
+    (event-pre-move (dispatcher w) w rect)
+    (cffi:with-foreign-slots ((gfs::left gfs::top gfs::right gfs::bottom) ptr gfs::rect)
+      (let ((pnt (gfs:location rect))
+            (size (gfs:size rect)))
+        (setf gfs::left   (gfs:point-x pnt)
+              gfs::top    (gfs:point-y pnt)
+              gfs::right  (+ (gfs:point-x pnt) (gfs:size-width size))
+              gfs::bottom (+ (gfs:point-y pnt) (gfs:size-height size))))))
+  1)
(defmethod process-message (hwnd (msg (eql gfs::+wm-hscroll+)) wparam lparam)
   (let ((widget (get-widget (thread-context)

    