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

[junrue at common-lisp.net]

Author: junrue
Date: Fri Oct  6 00:59:24 2006
New Revision: 292

Modified:
   trunk/NEWS.txt
   trunk/build.lisp
   trunk/config.lisp
   trunk/src/uitoolkit/system/datastructs.lisp
   trunk/src/uitoolkit/widgets/event.lisp
   trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp
Log:
fixed an edge case in scrolling/repainting; added SB_ENDSCROLL/TB_ENDTRACK support to scroll notification; upgraded to CFFI 060925 due to CLISP 2.40

Modified: trunk/NEWS.txt
==============================================================================
--- trunk/NEWS.txt	(original)
+++ trunk/NEWS.txt	Fri Oct  6 00:59:24 2006
@@ -1,5 +1,9 @@
 
 
+. CFFI snapshot 060925 or later is now required if you are running
+  CLISP 2.40 or later (due to a change in the argument list of
+  CLISP's FFI:FOREIGN-LIBRARY-FUNCTION).
+
 . Initial list box control functionality is now available:
 
   * three selection modes (none / multiple / extend)

Modified: trunk/build.lisp
==============================================================================
--- trunk/build.lisp	(original)
+++ trunk/build.lisp	Fri Oct  6 00:59:24 2006
@@ -44,7 +44,7 @@
 (defvar *asdf-repo-root*    (concatenate 'string *library-root* "asdf-repo/"))
 (defvar *project-root*      "c:/projects/public/")
 
-(setf   *cffi-dir*            (concatenate 'string *asdf-repo-root* "cffi-060606/"))
+(setf   *cffi-dir*            (concatenate 'string *asdf-repo-root* "cffi-060925/"))
 (setf   *closer-mop-dir*      (concatenate 'string *asdf-repo-root* "closer-mop/"))
 (setf   *lw-compat-dir*       (concatenate 'string *asdf-repo-root* "lw-compat/"))
 (setf   *gf-dir*              (concatenate 'string *project-root*   "graphic-forms/"))

Modified: trunk/config.lisp
==============================================================================
--- trunk/config.lisp	(original)
+++ trunk/config.lisp	Fri Oct  6 00:59:24 2006
@@ -39,7 +39,7 @@
 
 (in-package #:graphic-forms-system)
 
-(defvar *cffi-dir*            "cffi-060606/")
+(defvar *cffi-dir*            "cffi-060925/")
 (defvar *closer-mop-dir*      "closer-mop/")
 (defvar *lw-compat-dir*       "lw-compat/")
 (defvar *gf-dir*              "graphic-forms/")

Modified: trunk/src/uitoolkit/system/datastructs.lisp
==============================================================================
--- trunk/src/uitoolkit/system/datastructs.lisp	(original)
+++ trunk/src/uitoolkit/system/datastructs.lisp	Fri Oct  6 00:59:24 2006
@@ -45,9 +45,15 @@
 (defun location (rect)
   (rectangle-location rect))
 
+(defun (setf location) (pnt rect)
+  (setf (rectangle-location rect) pnt))
+
 (declaim (inline size))
 (defun size (size)
-  (rectangle-size rect))
+  (rectangle-size size))
+
+(defun (setf size) (size rect)
+  (setf (rectangle-size rect) size))
 
 (declaim (inline empty-span-p))
 (defun empty-span-p (span)

Modified: trunk/src/uitoolkit/widgets/event.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event.lisp	(original)
+++ trunk/src/uitoolkit/widgets/event.lisp	Fri Oct  6 00:59:24 2006
@@ -161,7 +161,9 @@
 ;                 (#.gfs::+tb-thumbposition+ :thumb-position)
 ;                 (#.gfs::+tb-thumbtrack+    :thumb-track)
                   (#.gfs::+sb-thumbposition+ :thumb-position)
-                  (#.gfs::+sb-thumbtrack+    :thumb-track))))
+                  (#.gfs::+sb-thumbtrack+    :thumb-track)
+;                 (#.gfs::+tb-endtrack+      :finished)
+                  (#.gfs::+sb-endscroll+     :finished))))
     (event-scroll disp widget axis detail)))
 
 (defun obtain-event-time ()

Modified: trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp	(original)
+++ trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp	Fri Oct  6 00:59:24 2006
@@ -117,6 +117,8 @@
          (viewport-size (client-size window))
          (top-size (if top (size top) viewport-size))
          (origin (slot-value (dispatcher window) 'viewport-origin))
+         (saved-x (gfs:point-x origin))
+         (saved-y (gfs:point-y origin))
          (delta-x (- (+ (gfs:size-width viewport-size) (gfs:point-x origin)) (gfs:size-width top-size)))
          (delta-y (- (+ (gfs:size-height viewport-size) (gfs:point-y origin)) (gfs:size-height top-size))))
     (if (and (> delta-x 0) (> (gfs:point-x origin) 0))
@@ -125,7 +127,12 @@
     (if (and (> delta-y 0) (> (gfs:point-y origin) 0))
       (setf (gfs:point-y origin) (max 0 (- (gfs:point-y origin) delta-y)))
       (setf delta-y 0))
-    (scroll top delta-x delta-y nil 0)
+    (if (or (and (zerop (gfs:point-x origin)) (/= saved-x 0))
+            (and (zerop (gfs:point-y origin)) (/= saved-y 0)))
+      (progn
+        (redraw top)
+        (update top))
+      (scroll top delta-x delta-y nil 0))
     origin))
 
 ;;;