[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