[cells-gtk-cvs] CVS update: root/cells-gtk/test-gtk/test-gtk.lisp

Peter Denno pdenno at common-lisp.net
Sun Feb 27 03:22:28 UTC 2005


Update of /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk
In directory common-lisp.net:/tmp/cvs-serv24439/cells-gtk/test-gtk

Modified Files:
	test-gtk.lisp 
Log Message:
Juergen Gmeiner's patch: moves specials referencing pathnames used in test-gtk out of config.lisp and into test-gtk.lisp
Date: Sun Feb 27 04:22:28 2005
Author: pdenno

Index: root/cells-gtk/test-gtk/test-gtk.lisp
diff -u root/cells-gtk/test-gtk/test-gtk.lisp:1.10 root/cells-gtk/test-gtk/test-gtk.lisp:1.11
--- root/cells-gtk/test-gtk/test-gtk.lisp:1.10	Wed Feb 16 23:36:45 2005
+++ root/cells-gtk/test-gtk/test-gtk.lisp	Sun Feb 27 04:22:27 2005
@@ -3,16 +3,37 @@
 
 (in-package :test-gtk)
 
+(defvar *test-img-dir*
+  (make-pathname :name nil :type nil :version nil
+                 :defaults (merge-pathnames
+                            (make-pathname :directory '(:relative :back :back "test-images"))
+                            (parse-namestring *load-truename*))))
+(defvar *splash-image*
+  (make-pathname :name "splash" :type "png"
+                 :defaults *test-img-dir*))
+
+(defvar *small-image*
+  (make-pathname :name "small" :type "png"
+                 :defaults *test-img-dir*))
+
+(defvar *stock-icon-image*
+  (make-pathname :name "my-g" :type "png"
+                 :defaults *test-img-dir*))
+
+(defvar *tst-image*
+  (make-pathname :name "tst" :type "gif"
+                 :defaults *test-img-dir*))
+
 (defmodel test-gtk (gtk-app)
   ()
   (:default-initargs
       :title "GTK Testing"
     ;;:tooltips nil ;;dkwt
     ;;:tooltips-enable nil ;;dkwt
-    :icon (namestring cl-user::*small-image*)
-    :stock-icons (list (list :my-g (namestring cl-user::*stock-icon-image*)))
+    :icon (namestring *small-image*)
+    :stock-icons (list (list :my-g (namestring *stock-icon-image*)))
     :position :center
-    :splash-screen-image (namestring cl-user::*splash-image*)
+    :splash-screen-image (namestring *splash-image*)
     :width 550 :height 550
     :kids (let ((tabs '("Buttons"
                         "Display" "Layout"




More information about the Cells-gtk-cvs mailing list