[cello-cvs] CVS cello

ktilton ktilton at common-lisp.net
Mon Oct 2 02:59:18 UTC 2006


Update of /project/cello/cvsroot/cello
In directory clnet:/tmp/cvs-serv27598

Modified Files:
	application.lisp cello-ftgl.lisp control.lisp ctl-markbox.lisp 
	ctl-toggle.lisp frame.lisp image.lisp ix-opengl.lisp 
	ix-paint.lisp ix-styled.lisp ix-text.lisp ix-togl.lisp 
	lighting.lisp mouse-click.lisp 
Log Message:


--- /project/cello/cvsroot/cello/application.lisp	2006/08/28 21:45:22	1.6
+++ /project/cello/cvsroot/cello/application.lisp	2006/10/02 02:59:18	1.7
@@ -22,10 +22,10 @@
 
 (defun cello-reset (&optional (system-type 'mg-system))
   (ffx-reset)
-  (cells-reset 'tk-user-queue-handler)
+  (cells-reset 'tk-user-queue-handler :debug t)
   (makunbound 'ogl::*gl-stop*)
   ;(xftgl)
-  ;(cl-ftgl-reset) ;; new 2006-08-28 in face of weird OGL 1282 when new chars hit in ratios
+  (cl-ftgl-reset) ;; 2006-09-27 back in temporarily ... new 2006-08-28 in face of weird OGL 1282 when new chars hit in ratios
   (when system-type
     (setf *sys* (make-instance system-type :md-name 'mgsys)))
   (values))
--- /project/cello/cvsroot/cello/cello-ftgl.lisp	2006/09/05 18:43:56	1.7
+++ /project/cello/cvsroot/cello/cello-ftgl.lisp	2006/10/02 02:59:18	1.8
@@ -33,13 +33,13 @@
   (when start
     (unless end
       (setf end (length string))))
-  
-  (ftgl-string-length font (if (or start end)
-               (subseq string start end)
-             string)))
+  (ftgl::dbgftgl :font-string-length
+    (ftgl-string-length font (if (or start end)
+                                 (subseq string start end)
+                               string))))
 
 (defun font-ftgl-ensure (mode face size) ;; ///sorry about the silly naming
-  (trc "font-ftgl-ensure requesting" mode face size)
+  (trc nil "font-ftgl-ensure requesting" mode face size)
   (ftgl-font-ensure mode face size (cs-target-res)))
 
 (defmodel font-id (ct-toggle ix-text)
@@ -58,11 +58,13 @@
   (when new-value
     (setf (md-value (fm-other :ftgl-test)) (^font-pathname))))
 
+(export! gui-style-ftgl)
+
 (defclass gui-style-ftgl (gui-style gui-style-sizable)
   ((mode :initarg :mode :accessor mode :initform :texture)))
 
 (defmethod make-style-font (style)
-  (trc "no font for style" style))
+  (break "no font for style ~a" style))
 
 (defmethod make-style-font ((style gui-style-ftgl))
   (font-ftgl-ensure (mode style) (face style) (gui-style-size style)))
@@ -239,6 +241,17 @@
   (let* ((t$ (display-text$ self)))
     (trc nil "ix-render-in-font ftgl-texture" :pxy (pxy self) (l-rect self) t$)
     
+    #+youarehere
+    (let ((ll (^ll))(lr (^lr))(lt (^lt))(lb (^lb))) ;; keep outside gl-begun since can kick off FTGL glyph build
+      ;(gl-color3f 0 0 0)
+      (gl-line-width 1)
+      (with-gl-begun (gl_lines)
+        (gl-vertex3f 0 0 0)(gl-vertex3f ll 0 0)
+        (gl-vertex3f 0 0 0)(gl-vertex3f lr 0 0)
+        (gl-vertex3f 0 0 0)(gl-vertex3f 0 lt 0)
+        (gl-vertex3f 0 0 0)(gl-vertex3f 0 lb 0)
+        ))
+
     (gl-enable gl_texture_2d)
     (trc nil "(gl-is-enabled gl_texture_2d)!!!!!!!" (gl-is-enabled gl_texture_2d)
       (ogl-get-boolean gl_texture_2d))
@@ -247,6 +260,8 @@
     (gl-enable gl_blend)
     (gl-blend-func gl_src_alpha gl_one_minus_src_alpha)
     (gl-polygon-mode gl_front_and_back gl_fill)
+
+
     
     (when (zoom self)
       (apply 'gl-scalef (zoom self)))
--- /project/cello/cvsroot/cello/control.lisp	2006/06/05 01:47:49	1.4
+++ /project/cello/cvsroot/cello/control.lisp	2006/10/02 02:59:18	1.5
@@ -46,9 +46,10 @@
       :gl-name (c? (incf (gl-name-highest .w.)))))
 
 (defobserver click-repeat-event ()
-  (when new-value
-    (bwhen (f (ct-action self))
-      (funcall f self (os-event (^click-evt)))))) ;; /// make fresh event with new time
+  (with-integrity (:change :obs-click-repeat-event)
+    (when new-value
+      (bwhen (f (ct-action self))
+        (funcall f self (os-event (^click-evt))))))) ;; /// make fresh event with new time
 
 (defmethod enabled (other)(assert other) nil)
 
--- /project/cello/cvsroot/cello/ctl-markbox.lisp	2006/07/06 22:09:10	1.6
+++ /project/cello/cvsroot/cello/ctl-markbox.lisp	2006/10/02 02:59:18	1.7
@@ -111,6 +111,7 @@
         radio-values))
 
 ;--------------- CTCheckBox --------------------------------------------
+(export! ct-check-box ct-check-text ct-radio-labeled ct-radio-push-button)
 
 (defmodel ct-check-box (ct-mark-box) 
   ()
@@ -127,18 +128,20 @@
     :spacing (u96ths 8)
     :outset (u96ths 2)
     :kids (c? (the-kids
-               (mk-part :check-box (ct-check-box)
+               (make-kid 'ct-check-box
+                 :md-name  :check-box
                  :md-value (c? (md-value .parent))
                  :enabled nil) ;; let parent handle clicks since text is clickable by the rules
-               (mk-part :label (ix-text)
+               (make-kid 'ix-text
+                 :md-name  :label
                  :text$ (c? (title$ .parent))
-                 :style-id :button
-                 )))
+                 :style-id :button)))
 
     :ct-action (lambda (self event)
                      (declare (ignorable event))
                      (trc nil "checktext bingo" (not (md-value self)))
-                     (setf (md-value self) (not (md-value self))))))
+                     (with-c-change :check-text-action
+                       (setf (md-value self) (not (md-value self)))))))
 
 (defmodel ct-radio-labeled (ix-row ct-radio-item)
   ()
--- /project/cello/cvsroot/cello/ctl-toggle.lisp	2006/07/03 00:35:12	1.3
+++ /project/cello/cvsroot/cello/ctl-toggle.lisp	2006/10/02 02:59:18	1.4
@@ -16,6 +16,8 @@
 
 (in-package :cello)
 
+(export! ct-text ct-button ct-button-ex ct-selectable-button mk-twisted mk-twisted-part)
+
 (defmodel ct-text (control ix-text)
   ()
   (:default-initargs
@@ -30,6 +32,7 @@
     :pre-layer (with-layers :off +white+
                  :fill (:rgba (^text-color)))))
 
+
 (defmodel ct-button (control ix-text) ;; same inheritance, but otherwise unrelated to CTText
   ((inset :unchanged-if 'v2= :initform (mkv2 (upts 4) (upts 4)))
    (depressed :initarg :depressed :reader depressed :initform (c? (^hilited))))
@@ -43,7 +46,23 @@
     :skin (c? (skin .w.))
     :text-color (c? (if (^depressed)
                         +dk-gray+ +white+))
-    :pre-layer (c? (let* ((thick (min (u96ths 4) (* 0.08 (l-width self))))
+    :pre-layer  (c? (let* ((thick (min (u96ths 4) (* 0.08 (l-width self))))
+                                            (defl (if (clo::^depressed) (downs (/ thick 3)) 0))
+                                            (push-in (if (clo::^depressed) (xlout (* .5 thick)) 0)))
+                                       (declare (ignorable thick defl))
+                                       (trc nil "ctbutton" thick defl)
+                      
+                                       (with-layers
+                                           (:v3f (/ defl 2) defl push-in)
+                                         
+                                         +white+
+                                         :on
+                                         (:frame-3d :edge-raised
+                                           :thickness thick
+                                           :texturing (list (clo::^skin)))
+                                         (:rgba (^text-color))
+                                         )))
+    #+old (c? (let* ((thick (min (u96ths 4) (* 0.08 (l-width self))))
                            (defl (if (^depressed) (downs (/ thick 3)) 0))
                            (push-in (if (^depressed) (xlout (* .5 thick)) 0)))
                       (declare (ignorable thick defl))
@@ -57,6 +76,16 @@
                           :thickness thick)
                         (:rgba (^text-color)))))))
 
+(defmacro ct-button-ex ((text command) &rest initargs)
+  `(make-instance 'ct-button
+     :fm-parent *parent*
+     :title$ ,text
+     :ct-action (lambda (self event)
+                       (declare (ignorable self event))
+                       (with-c-change :ct-button-ex-ct-action
+                         ,command))
+     , at initargs))
+
 (defmodel ct-selectable-button (ct-selectable ct-button)())
 
 ; ---------------- CT FSM ---------------------
--- /project/cello/cvsroot/cello/frame.lisp	2006/06/05 01:47:49	1.3
+++ /project/cello/cvsroot/cello/frame.lisp	2006/10/02 02:59:18	1.4
@@ -72,50 +72,52 @@
                   (:edge-raised (nearer thick)))))
       (destructuring-bind (&optional uface uback)
           texturing
+        (declare (ignorable uback))
         (with-attrib (gl_texture_bit gl_enable_bit gl_hint_bit gl_line_bit gl_color_buffer_bit)
           (if uface
               (progn ;;quick hack
-                
+                (trc nil "bingo frame3d texturing!!!!" uface (texture-name uface) (r-width lbox) (image-size uface))
                 (ogl-tex-activate (texture-name uface))
                 (ogl-tex-gen-setup gl_object_linear gl_modulate gl_repeat
-                  1 ;;.02 ;(eko ("f3dscale") (/ 1 (/ (r-width lbox) (car (image-size uface)))))
+                  .003
+                  ;; (eko ("f3dscale") (/ 1 (/ (r-width lbox) (car ))))
                   :s :tee)
-                (setf uface nil uback nil))
+                )
             (progn
               (gl-disable gl_texture_2d)
               (gl-enable gl_lighting)))
           (flet
               ((vrto ()
                  (when uface ;; just treating it as a flag for "texture on"
-                   (gl-tex-coord2f (r-right uback)(r-top uback)))
+                   (gl-tex-coord2f 1 1))
                  (gl-vertex3f outr outt 0))
                (vlto ()
                  (when uface
-                   (gl-tex-coord2f (r-left uback)(r-top uback)))
+                   (gl-tex-coord2f 0 1))
                  (gl-vertex3f outl outt 0))
                (vlbo ()
                  (when uface
-                   (gl-tex-coord2f (r-left uback)(r-bottom uback)))
+                   (gl-tex-coord2f 0 0))
                  (gl-vertex3f outl outb 0))
                (vrbo ()
                  (when uface
-                   (gl-tex-coord2f (r-right uback)(r-bottom uback)))
+                   (gl-tex-coord2f 1 0))
                  (gl-vertex3f outr outb 0))
                (vlti ()
                  (when uface
-                   (gl-tex-coord2f inl int))
+                   (gl-tex-coord2f 0 1))
                  (gl-vertex3f inl int inz))
                (vlbi ()
                  (when uface
-                   (gl-tex-coord2f (r-left uface)(r-bottom uface)))
+                   (gl-tex-coord2f 0 0))
                  (gl-vertex3f inl inb inz))
                (vrti ()
                  (when uface
-                   (gl-tex-coord2f (r-right uface)(r-top uface)))
+                   (gl-tex-coord2f 1 1))
                  (gl-vertex3f inr int inz))
                (vrbi ()
                  (when uface
-                   (gl-tex-coord2f (r-right uface)(r-bottom uface)))                   
+                   (gl-tex-coord2f 1 0))                   
                  (gl-vertex3f inr inb inz)))
             (flet ((render ()
                      (gl-translatef 0 0 (xlout thick))
--- /project/cello/cvsroot/cello/image.lisp	2006/09/05 18:43:56	1.12
+++ /project/cello/cvsroot/cello/image.lisp	2006/10/02 02:59:18	1.13
@@ -168,7 +168,7 @@
 (defobserver mouse-over-p ()
   (bwhen (p .parent)
     (when (typep p 'ix-view)
-      (with-integrity(:change)
+      (with-integrity(:change 'mose-over)
         (setf (mouse-over-p p) new-value)))))
 
 (defmethod ix-selectable ((self ix-view)) nil)
@@ -276,6 +276,7 @@
              (nreverse output))))
     `(lambda (self l-box mode)
        (declare (ignorable self l-box))
+       (trc nil "with-layers called!!!!!!!!!!!!!!!!" self mode)
        (ecase mode
          (:before ,@(collect-output
                      (subseq layers 0
--- /project/cello/cvsroot/cello/ix-opengl.lisp	2006/10/01 20:47:54	1.6
+++ /project/cello/cvsroot/cello/ix-opengl.lisp	2006/10/02 02:59:18	1.7
@@ -51,11 +51,15 @@
 (defmethod ogl-node-window (other)
   (c-break "ogl-node-window undefined for ~a" other))
 
+
+(export! .og. .ogc. .retog.)
+
 (define-symbol-macro .og.
     (or (ogl-context self)
       (setf (ogl-context self) (upper self ctk::togl))))
 
 (define-symbol-macro .ogc. (togl-ptr .og.))
+(define-symbol-macro .retog. (when .ogc. (togl-post-redisplay .ogc.)))
 
 (defmodel ogl-node ()
   ((ogl-context :cell nil :initform nil :accessor ogl-context)
--- /project/cello/cvsroot/cello/ix-paint.lisp	2006/10/01 20:46:51	1.5
+++ /project/cello/cvsroot/cello/ix-paint.lisp	2006/10/02 02:59:18	1.6
@@ -68,7 +68,7 @@
       
       (assert (zerop (glgeterror)))
       (when n
-        (trc "pushing gl-name" self n)
+        (trc nil "pushing gl-name" self n)
         (gl-push-name n))
       
       (rpchk 'ix-paint t nil self)
@@ -97,7 +97,7 @@
                     (assert (functionp pre-layer))
                     (count-it :pre-layer)
                     (nr-make ixr-box (ll self) (lt self) (lr self) (lb self))
-                    
+                    (trc nil "calling pre-layer" self)
                     (funcall pre-layer self ixr-box :before)
                     (call-next-method self)
                     (funcall pre-layer self ixr-box :after))
--- /project/cello/cvsroot/cello/ix-styled.lisp	2006/06/26 17:05:20	1.5
+++ /project/cello/cvsroot/cello/ix-styled.lisp	2006/10/02 02:59:18	1.6
@@ -59,6 +59,7 @@
   (when style
     ;;(print `(gui-style ,style ,(styles-default)))
     (or (ix-find-style self style)
+      (find style (styles-default) :key 'id)
       (find :default (styles-default) :key 'id)
       (break "gui-style cannot find requested style ~a" style))))
 
--- /project/cello/cvsroot/cello/ix-text.lisp	2006/07/06 22:09:10	1.8
+++ /project/cello/cvsroot/cello/ix-text.lisp	2006/10/02 02:59:18	1.9
@@ -54,14 +54,17 @@
      :initform (mkv2 0 0)
      :accessor inset)
    (ll :initform (c? (- (inset-h self))))
-   (lt :initform (c? (ups 0 (font-ascent (text-font self)) (inset-v self))))
-   (lr :initform (c? (^lr-width (+ (cond
-                                    ((char-mask self) (ix-string-width self (char-mask self)))
-                                    ((^text-width))
-                                    ((^maxcharwidth))
-                                    (t (error "Please specify a font or :lr <n>.")))
-                                  (* 2 (inset-h self))))))
-   (lb :initform (c? (downs 0 (font-descent (text-font self)) (inset-v self))))
+   (lt :initform (c? (eko (nil "ixtext lt")
+                       (ups 0 (font-ascent (text-font self)) (inset-v self)))))
+   (lr :initform (c? (eko (nil "ix-text lr")
+                       (^lr-width (+ (cond
+                                      ((char-mask self) (ix-string-width self (char-mask self)))
+                                      ((^text-width))
+                                      ((^maxcharwidth))
+                                      (t (error "Please specify a font or :lr <n>.")))
+                                    (* 2 (inset-h self)))))))
+   (lb :initform (c? (eko (nil "ixtext LB")
+                       (downs (font-descent (text-font self)) (inset-v self)))))
    )
   (:default-initargs
       :lighting :off))
--- /project/cello/cvsroot/cello/ix-togl.lisp	2006/10/01 20:46:00	1.10
+++ /project/cello/cvsroot/cello/ix-togl.lisp	2006/10/02 02:59:18	1.11
@@ -22,7 +22,7 @@
 ;------------- Window ---------------
 ;
 
-(export! mouse-view ^mouse-view mouse-pos ^mouse-pos mouse-control ^mouse-control)
+(export! mouse-view ^mouse-view mouse-pos ^mouse-pos mouse-control ^mouse-control mouse-down-evt ^mouse-down-evt)
 
 (defmodel ix-togl ( #+not focuser ogl-lit-scene control ogl-shared-resource-tender togl ix-view)
   (
@@ -36,7 +36,7 @@
                :initform (c? (let ((mp (^mouse-pos)))
                                (trc nil "mouseview sees pos" .w. mp)
                                (when mp
-                                 (eko (nil "mouseview >" self)
+                                 (eko (nil "ix-togl mouseview >" self)
                                    (without-c-dependency
                                     (find-ix-under self mp)))))))
    
@@ -103,11 +103,20 @@
     (:ButtonPress
      (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe)
                               (- (ctk::xbe-y xe)))) ; trigger mouseview recalc
-     (setf (mouse-down-evt self) (make-os-event
-                                  :modifiers (keyboard-modifiers .tkw)
-                                  :where (mkv2 (ctk::xbe-x xe)(ctk::xbe-y xe))
-                                  :realtime (now))))
-    (:ButtonRelease	)
+     (setf (mouse-down-evt self) (eko ("mousedown!!!!!!!!!")
+                                   (make-os-event
+                                    :modifiers (keyboard-modifiers .tkw)
+                                    :where (mouse-pos self)
+                                    :realtime (now)))))
+    (:ButtonRelease
+     (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe)
+                              (- (ctk::xbe-y xe)))) ; trigger mouseview recalc
+     (setf (mouse-up-evt self) (eko ("mouse up!!!!!!!!!")
+                                   (make-os-event
+                                    :modifiers (keyboard-modifiers .tkw)
+                                    :where (mouse-pos self)
+                                    :realtime (now)))))
+    
     (:MotionNotify
      (trc nil "setting mouse pos!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" (ctk::xbe-x xe) (- (ctk::xbe-y xe)))
      (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe)
@@ -200,11 +209,11 @@
 
 (defobserver mouse-view ()
   (when old-value
-    (with-integrity (:change)
+    (with-integrity (:change 'mview-lost)
       (trc nil "mouseover lost by" old-value (window-cache old-value))
       (setf (mouse-over-p old-value) nil)))
   (when new-value
-    (with-integrity (:change)
+    (with-integrity (:change 'mview-gained)
       (trc nil "mouseover gained by" new-value (window-cache new-value))
       (setf (mouse-over-p new-value) t))))
 
@@ -213,7 +222,7 @@
     (trc nil "mousedown" m-down (mouse-control self))
     (bwhen (clickee (mouse-control self))
       (trc nil "mousedown clickee, clickw" clickee self)
-      (mk-part :click (mouse-click)
+      (mk-part :click (mouse-click) ;; wow, a free-floating part
         :click-window self
         :clickee clickee
         :os-event m-down
@@ -221,10 +230,10 @@
 
 (defobserver mouse-up-evt (self up)
   (when up ;; should be since this is ephemeral, but still..
-    (trc nil "mouseup" self up (mouse-control self))
+    (trc  "mouseup" self up (mouse-control self))
     (bwhen (clickee (mouse-control self))
       (bwhen (upper (mouse-up-handler clickee))
-        (trc nil "mouseup clickee, clickw" clickee self)
+        (trc  "mouseup clickee, clickw" clickee self)
         (funcall upper clickee up)))))
 
 (defparameter *gw* nil)
@@ -242,15 +251,15 @@
   (gl-hint gl_perspective_correction_hint gl_nicest))
 
 (defun cello-gl-init ()
-  (trc "clearing gl errors....")
+  (trc nil "clearing gl errors....")
   (loop for ct upfrom 0
-      until (zerop (eko ("cleared gl errorr")
+      until (zerop (eko (nil "cleared gl errorr")
                      (glGetError)))
       when (> ct 10) 
       do #-lispworks (c-break "gl-init")
         #+lispworks (return-from cello-gl-init))
   
-  (macrolet ((glm (param num)
+  #+shhh (macrolet ((glm (param num)
                (declare (ignore num))
                `(trc ,(symbol-name param) (ogl-get-int ,param))))
     (glm gl_max_list_nesting 0)
--- /project/cello/cvsroot/cello/lighting.lisp	2006/06/26 17:05:20	1.5
+++ /project/cello/cvsroot/cello/lighting.lisp	2006/10/02 02:59:18	1.6
@@ -62,7 +62,7 @@
                        :ambient *dim*
                        :diffuse *bright*
                        :specular *bright*)
-                 #+(or) (make-instance 'light
+                 (make-instance 'light
                          :id gl_light1
                          :enabled t
                          :pos (make-ff-array :float 700 (downs 600) (nearer 200) 1)
@@ -93,7 +93,7 @@
     (loop for light in (fixed-lighting self)
           do (ix-render-light light))
     (when (and (not lights) (emergency-lighting self))
-      (trc nil "emergency lighting" self)
+      (trc "emergency lighting!!!!!!!!!!" self)
       (dolist (e-light (emergency-lighting self))
         (ix-render-light e-light)))))
 
--- /project/cello/cvsroot/cello/mouse-click.lisp	2006/06/11 13:32:24	1.5
+++ /project/cello/cvsroot/cello/mouse-click.lisp	2006/10/02 02:59:18	1.6
@@ -29,27 +29,27 @@
    (click-age :initform (c? (- (sys-time *sys*) (evt-when (os-event self))))
      :documentation "Unreliable unless click-repeat-p forcing events")
    (click-completed :reader click-completed
-     :initform (c? (when (typep (click-window self) 'window) ;; <- acl used to turn windows into
+     :initform (c? (when (typep (click-window self) 'model) ;; <- acl used to turn windows into
                      (mouse-up-evt (click-window self)))))   ;; closed-stream instances
    
    (click-over :reader click-over
-     :initform (c?  (when (typep (click-window self) 'window)
+     :initform (c?  (when (typep (click-window self) 'model)
                       (unless (^click-completed)
                         (when (mouse-over-p (clickee self))
                           (mouse-pos (click-window self)))))))
    
    (in-drag :reader in-drag
-     :initform (c? (when (typep (click-window self) 'window)
+     :initform (c? (when (typep (click-window self) 'model)
                      (unless (^click-completed)
                        (when (mouse-over-p (clickee self))
                          (mouse-pos (click-window self)))))))
    
    (clicked :reader clicked
-     :initform (c? (trc nil "clicked?> typeof clickw" (click-window self) (type-of (click-window self)))
-                 (when (typep (click-window self) 'window)
-                   (trc nil "clicked?> asking clickcompleted")
+     :initform (c? (trc  "clicked?> typeof clickw" (click-window self) (type-of (click-window self)))
+                 (when (typep (click-window self) 'model)
+                   (trc  "clicked?> asking clickcompleted")
                    (bwhen (up (^click-completed))
-                     (trc nil "clicked?> asking point-in-box"
+                     (trc  "clicked?> asking point-in-box"
                        (evt-where up)
                        (clickee self)
                        (without-c-dependency
@@ -63,15 +63,16 @@
       :expiration (c? (mouse-up-evt (click-window self)))))
 
 (defmethod initialize-instance :after ((self mouse-click) &key)
-  (when (typep (clickee self) 'focus)
-    (unless (control-key-down (evt-buttons (os-event self))) ;; lame debugging enabler; make better
-      (focus-navigate (focus (click-window self)) (clickee self))))
+  (with-integrity (:change :ii-mouseclick)
+    (when (typep (clickee self) 'focus)
+      (unless (control-key-down (evt-buttons (os-event self))) ;; lame debugging enabler; make better
+        (focus-navigate (focus (click-window self)) (clickee self))))
 
-  ;;;20060601 (to-be self) ;; unnecessary? 2301kt just moved this from after next line 
-  (trc nil "echo click set self clickee" self (clickee self))
+    ;;;20060601 (to-be self) ;; unnecessary? 2301kt just moved this from after next line 
+    (trc  "echo click set self clickee" self (clickee self))
 
-  (when (clickee self) 
-    (setf (click-evt (clickee self)) self)))
+    (when (clickee self) 
+      (setf (click-evt (clickee self)) self))))
 
 (defmethod (setf click-evt) :around (new-click self)
   (when (or (null new-click)
@@ -91,7 +92,7 @@
 
 (defmethod not-to-be :around ((self mouse-click))
   (when (typep (click-window self) 'window) ;; /// why worry about this?
-    (trc nil "echo click clearing self from clickee" (clickee self))
+    (trc  "echo click clearing self from clickee" (clickee self))
     (setf (click-evt (clickee self)) nil) ;; do this first?
     ;; (trc "echo click not-to-be-ing self from clickee" self)
     (call-next-method)
@@ -99,8 +100,9 @@
     ))
 
 (defobserver clicked ()
+  (trc "echo clicked " self new-value)
   (when (and new-value (click-window self))
-    (trc nil "echo clicked calling control-do-action" self new-value)
+    (trc "echo clicked calling control-do-action" self new-value)
     (control-do-action (car new-value) (cdr new-value))))
 
 ;----------------------------------------




More information about the Cello-cvs mailing list