[cells-cvs] CVS Celtk

ktilton ktilton at common-lisp.net
Mon Jul 3 01:31:38 UTC 2006


Update of /project/cells/cvsroot/Celtk
In directory clnet:/tmp/cvs-serv17691

Modified Files:
	lotsa-widgets.lisp togl.lisp 
Log Message:


--- /project/cells/cvsroot/Celtk/lotsa-widgets.lisp	2006/06/07 22:13:41	1.4
+++ /project/cells/cvsroot/Celtk/lotsa-widgets.lisp	2006/07/03 01:31:38	1.5
@@ -19,6 +19,15 @@
 
 (in-package :celtk-user)
 
+;;; Creates a pathname with NAME and TYPE in the same
+;;; directory/host/device/whatever as this lisp file. Tries to get
+;;; that at compile time to cope with some useful ASDF extensions that
+;;; place fasls in arbitrary places.
+(defun data-pathname (name type)
+  (merge-pathnames (make-pathname :name name :type type)
+                   #.(or *compile-file-truename* *load-truename*)))
+
+
 (defmodel lotsa-widgets (window)
   ()
   (:default-initargs
@@ -27,9 +36,7 @@
                  
                  (mk-row (:packing (c?pack-self))
                    (mk-label :text "aaa"
-                     :image-files (list (list 'kt (make-pathname #+lispworks :host #-lispworks :device "c"
-                                                    :directory '(:absolute "0dev" "Celtk")
-                                                    :name "kt69" :type "gif")))
+                     :image-files (list (list 'kt (data-pathname "kt69" "gif")))
                      :height 200
                      :width 300
                      :image (c? (format nil "~(~a.~a~)" (ctk::^path) 'kt)))
@@ -145,10 +152,7 @@
    :height 350
    :kids (c? (the-kids
               (mk-bitmap :coords (list 140 140)
-                :bitmap (conc$ "@" (namestring (make-pathname
-                                                :directory '(:absolute "0dev" "Celtk")
-                                                :name "x1"
-                                                :type "xbm"))))
+                :bitmap (conc$ "@" (namestring (data-pathname "x1" "xbm"))))
               (mk-rectangle :coords (list 10 10 100 60)
                 :tk-fill "red")
               (mk-text-item :coords (list 100 80)
--- /project/cells/cvsroot/Celtk/togl.lisp	2006/07/03 00:32:52	1.12
+++ /project/cells/cvsroot/Celtk/togl.lisp	2006/07/03 01:31:38	1.13
@@ -20,7 +20,8 @@
 
 
 (define-foreign-library Togl
-    (:darwin (:or "/opt/tcltk/togl/lib/Togl1.7/libtogl1.7.dylib"))
+  (:darwin (:or "libTogl1.7.dylib"
+                "/opt/tcltk/togl/lib/Togl1.7/libtogl1.7.dylib"))
   (:windows (:or "/tcl/lib/togl/togl17.dll"))
   (:unix "/usr/lib/Togl1.7/libTogl1.7.so"))
 




More information about the Cells-cvs mailing list