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))
;;;