[graphic-forms-cvs] r407 - trunk/src/tests/uitoolkit

[junrue at common-lisp.net]

Author: junrue
Date: Wed Nov 29 22:16:44 2006
New Revision: 407

Added:
   trunk/src/tests/uitoolkit/custom.cur   (contents, props changed)
Modified:
   trunk/src/tests/uitoolkit/scroll-grid-panel.lisp
Log:
added test for loading and using cursor from file

Added: trunk/src/tests/uitoolkit/custom.cur
==============================================================================
Binary file. No diff available.

Modified: trunk/src/tests/uitoolkit/scroll-grid-panel.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/scroll-grid-panel.lisp	(original)
+++ trunk/src/tests/uitoolkit/scroll-grid-panel.lisp	Wed Nov 29 22:16:44 2006
@@ -46,6 +46,7 @@
   (declare (ignore disp item)))
 
 (defun make-scroll-grid-panel (parent)
+  (setf *default-pathname-defaults* (parse-namestring gfsys::*gf-tests-dir*))
   (let ((panel-size (gfs:make-size :width (1+ (* (gfs:size-width *grid-model-size*) +grid-cell-extent+))
                                    :height (1+ (* (gfs:size-height *grid-model-size*) +grid-cell-extent+))))
         (panel (make-instance 'gfw:panel :dispatcher (make-instance 'scroll-grid-panel-events)
@@ -55,7 +56,9 @@
     (assert (gfs:equal-size-p panel-size (slot-value panel 'gfw::max-size)))
     (setf (gfs:size-width *grid-char-size*) (floor +grid-half-extent+ 2)
           (gfs:size-height *grid-char-size*) (floor +grid-half-extent+ 2))
-    (setf (gfw:cursor-of panel) (make-instance 'gfg:cursor :system gfg:+hand-cursor+))
+    (setf (gfw:cursor-of panel)
+          (make-instance 'gfg:cursor
+                         :file (merge-pathnames "custom.cur")))
     panel))
 
 (defun set-grid-scroll-params (window)