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

Modified Files: Celtk.asd Celtk.lisp composites.lisp font.lisp run.lisp timer.lisp tk-object.lisp togl.lisp widget.lisp Log Message:

--- /project/cells/cvsroot/Celtk/Celtk.asd 2006/06/07 22:13:41 1.10 +++ /project/cells/cvsroot/Celtk/Celtk.asd 2006/07/06 22:10:39 1.11 @@ -12,7 +12,7 @@ :licence "Lisp LGPL" :description "Tcl/Tk with Cells Inside(tm)" :long-description "A Cells-driven portable GUI, ultimately implmented by Tcl/Tk" - :depends-on (:cells :cffi :gui-geometry) + :depends-on (:cells :cffi :gui-geometry :cl-ftgl) :serial t :components ((:file "Celtk") (:file "tk-structs") --- /project/cells/cvsroot/Celtk/Celtk.lisp 2006/07/03 00:32:52 1.33 +++ /project/cells/cvsroot/Celtk/Celtk.lisp 2006/07/06 22:10:39 1.34 @@ -16,7 +16,7 @@

|#

-;;; $Header: /project/cells/cvsroot/Celtk/Celtk.lisp,v 1.33 2006/07/03 00:32:52 ktilton Exp $ +;;; $Header: /project/cells/cvsroot/Celtk/Celtk.lisp,v 1.34 2006/07/06 22:10:39 ktilton Exp $

(defpackage :celtk (:nicknames "CTK") @@ -68,7 +68,7 @@

; --- tk-format --- talking to wish/Tk -----------------------------------------------------

-(defconstant +tk-client-task-priority+ +(defparameter +tk-client-task-priority+ '(:delete :forget :destroy :pre-make-tk :make-tk :make-tk-menubutton :post-make-tk :variable :bind :selection :trace :configure :grid :pack :fini)) @@ -249,4 +249,4 @@ else do (push ch item) finally (gather-item) (return (nreverse items)))))) - \ No newline at end of file + --- /project/cells/cvsroot/Celtk/composites.lisp 2006/07/03 00:32:52 1.12 +++ /project/cells/cvsroot/Celtk/composites.lisp 2006/07/06 22:10:40 1.13 @@ -69,7 +69,7 @@ (defmodel composite-widget (widget) ((kids-packing :initarg :kids-packing :accessor kids-packing :initform nil)))

-(eval-when (compile load eval) +(eval-now! (export '(title$ active .time)))

(defvar *app*) --- /project/cells/cvsroot/Celtk/font.lisp 2006/06/07 22:13:41 1.5 +++ /project/cells/cvsroot/Celtk/font.lisp 2006/07/06 22:10:40 1.6 @@ -20,7 +20,7 @@

;;; --- fonts obtained from Tk-land ---------------

-(eval-when (compile load eval) +(eval-now! (export '(make-tkfinfo tkfinfo-family tkfinfo-size tkfinfo-slant tkfinfo-ascent tkfinfo-linespace tkfinfo-fixed tkfont-id tkfont-info tkfinfo-ascent tkfont-height tkfont-ascent tkfinfo-descent ^tkfont-descent ^tkfont-find @@ -31,7 +31,7 @@ `(progn ,@(loop for fn-name in fn-names collecting (let ((^name (format nil "^~:@(~a~)" fn-name))) `(progn - (eval-when (compile load eval) + (eval-now! (export '(,(intern ^name)))) (defmacro ,(intern ^name) () `(,',fn-name self))))))) --- /project/cells/cvsroot/Celtk/run.lisp 2006/07/03 00:32:52 1.18 +++ /project/cells/cvsroot/Celtk/run.lisp 2006/07/06 22:10:40 1.19 @@ -20,7 +20,7 @@

;;; --- running a Celtk (window class, actually) --------------------------------------

-(eval-when (compile load eval) +(eval-now! (export '(tk-scaling run-window test-window)))

(defun run-window (root-class &optional (resetp t) &rest window-initargs) @@ -149,12 +149,9 @@ "nails existing window as a convenience in iterative development" (declare (ignorable root-class))

- #+tki (when (and *tkw* (open-stream-p *tkw*)) - (format *tkw* "wm withdraw .~%") - (force-output *tkw*) - (format *tkw* "destroy .%") - (force-output *tkw*) - (setf *tkw* nil)) + #+notquite (when (and *tkw* (fm-parent *tkw*)) ;; probably a better way to test if the window is still alive + (not-to-be (fm-parent *tkw*)) + (setf *tkw* nil ctk::*app* nil))

(apply 'run-window root-class resetp window-initargs))

--- /project/cells/cvsroot/Celtk/timer.lisp 2006/05/25 07:12:59 1.8 +++ /project/cells/cvsroot/Celtk/timer.lisp 2006/07/06 22:10:40 1.9 @@ -44,7 +44,7 @@ ;;; Timer is totally a work-in-progress with much development ahead. ;;;

-(eval-when (compile load eval) +(eval-now! (export '(repeat ^repeat)))

(defmodel timer () --- /project/cells/cvsroot/Celtk/tk-object.lisp 2006/06/29 09:54:52 1.7 +++ /project/cells/cvsroot/Celtk/tk-object.lisp 2006/07/06 22:10:40 1.8 @@ -59,7 +59,7 @@ collecting `(setf (get ',slot-name 'tk-config-option) ',tk-option) into outputs finally (return (values slot-defs outputs))) - `(eval-when (compile load eval) + `(eval-now! (defmodel ,class ,(or superclasses '(tk-object)) (,@(append std-slots slots)) ,@(remove-if (lambda (k) (find k '(:default-initargs :tk-spec))) defclass-options :key 'car) @@ -84,7 +84,7 @@ collecting (list slot-name (if (atom tk-option-def) tk-option-def (cadr tk-option-def)))))

-(eval-when (compile load eval) +(eval-now! (defun de- (sym) (remove #- (symbol-name sym) :end 1)))

--- /project/cells/cvsroot/Celtk/togl.lisp 2006/07/03 01:31:38 1.13 +++ /project/cells/cvsroot/Celtk/togl.lisp 2006/07/06 22:10:40 1.14 @@ -71,7 +71,7 @@ ;; Togl_FreeColorOverlay ;; Togl_DumpToEpsFile

-(eval-when (compile load eval) +(eval-now! (export '(togl with-togl togl-interp togl-swap-buffers togl-post-redisplay togl-ptr togl-reshape-func togl togl-timer-using-class togl-post-redisplay togl-reshape-using-class togl-display-using-class togl-width togl-height togl-create-using-class))) @@ -179,9 +179,11 @@ (defmethod ,(intern uc$) ((self togl))))))

(def-togl-callback create () - (trc "!!!!!!!!!!!!!!!!!! about to install togl-ptr!!!!!!!!!!!!!!!!!!" togl-ptr self) - (setf (togl-ptr self) (setf cl-ftgl::*ftgl-ogl* ;; help debug failure to use lazy cells/classes to defer FTGL till Ogl ready - togl-ptr)) + (trc nil "!!!!!!!!!!!!!!!!!! about to install togl-ptr!!!!!!!!!!!!!!!!!!" togl-ptr self) +;;; (setf (togl-ptr self) (setf cl-ftgl::*ftgl-ogl* ;; help debug failure to use lazy cells/classes to defer FTGL till Ogl ready +;;; togl-ptr)) + + (setf (togl-ptr self) togl-ptr) (setf (gethash (pointer-address togl-ptr) (tkwins *tkw*)) self))

(def-togl-callback display ()) --- /project/cells/cvsroot/Celtk/widget.lisp 2006/06/29 09:54:52 1.15 +++ /project/cells/cvsroot/Celtk/widget.lisp 2006/07/06 22:10:40 1.16 @@ -71,7 +71,7 @@ :event-handler nil #+debug (lambda (self xe) (TRC "debug event handler" self (tk-event-type (xsv type xe))))))

-(eval-when (compile load eval) +(eval-now! (export '()))

(defun tk-create-event-handler-ex (widget callback-name &rest masks) @@ -153,7 +153,7 @@

;;; --- items -----------------------------------------------------------------------

-(eval-when (compile load eval) +(eval-now! (export '(canvas-offset ^canvas-offset coords-tweak ^coords-tweak caret-tweak ^caret-tweak decorations ^decorations)))