[cells-cvs] CVS Celtk
ktilton
ktilton at common-lisp.net
Thu Jul 6 22:10:41 UTC 2006
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)))
More information about the Cells-cvs
mailing list