anchor.diff:  (def-event-source wheel
     (val 0f0 :type single-float))
   
  +;; (apply-button x ts :down-p t)
  +
   ;;----------------------------------------------------------------------
   
  -(defmacro def-combo-event-source (name slots (&key event-var) &body body)
  +(defun propagate (source timestamp)
  +  (labels ((fire-combo (combo source timestamp)
  +	     (funcall (combo-predicate combo) combo source timestamp)))
  +    (loop :for c :in (event-source-combos source) :do
  +       (fire-combo c source timestamp))))
  +
  +(defmacro def-combo (name source-types (&key event-var (timestamp-var 'timestamp))
  +
  +					  slots &body body)
     (assert (symbolp event-var))
  +  (assert (listp source-types))
     (let* (;; funcs
   	 (make (intern (format nil "MAKE-~a" name) (symbol-package name)))
  +	 (constructor (intern (format nil "%MAKE-~a" name) (symbol-package name)))
   	 (logic (intern (format nil "%~a-BODY" name) (symbol-package name)))
  -	 (add (intern (format nil "ADD-~a" name) (symbol-package name)))
   	 (active (intern (format nil "~s-ACTIVE-P" name)
   			 (symbol-package name)))
  -	 (body-func (hide (format nil "~s-BODY" name)
  -			  (symbol-package name)))
   	 ;;state-slots
   	 (original-slot-names (mapcar #'first slots))
   	 (accessor-names (mapcar (lambda (x)
  
positive.code: 			       slots))
  	 ;;-internal vars
  	 (this (gensym "this")))
      `(progn
         (deftclass (,name (:include regular-source) (:conc-name nil))
  	 ,@hidden-slots
  	 (,body-func #',logic :type function)
  	 (,active nil :type boolean))
         (defun ,logic (,this ,event-var)
  	 (let ((result
  		(symbol-macrolet
  		    ,(mapcar (lambda (n hn) `(,n (,hn ,event-var)))
  			     original-slot-names hidden-slot-names)
  		  ,@body))
  	       (old-active (,active ,this))
  	       (new-active (not (null result))))
  	   (setf (,active ,this) new-active)
  	   (when (not (eq old-active new-active))
  	     ;; new events :)
  	     )
  	   nil))
         (defun ,add (group &rest listening-to)
  	 (let* ((g (source-group-combos group)))
  	   (vector-push-extend (,make) (source-group-combos group))
  	   (loop :for (source-kind source-index) :across listening-to :do
  	      (let ((source-kind-index (or (gethash ))))
  		(vector-push-extend #',logic
  				    (aref (aref (source-group-sources group)
  						source-kind-index)
  					  source-index))))
  	   group)))))
  
  (def-combo-event-source double-click
      ((last-down 0 :type fix))
      (:event-var evt)
    1)
  
  ;;----------------------------------------------------------------------
  
  (defvar +mice+
    (make-array 0 :element-type 'source-group
  	      :adjustable t :fill-pointer 0))
  
  (defvar +keyboards+
    (make-array 0 :element-type 'source-group
  	      :adjustable t :fill-pointer 0))
  
negative.code: 			      (second s)))
  		    (init (if array?
  			      (if (numberp len)
  				  `(make-array ,len :element-type ',elem-type
  					       :fill-pointer 0)
  				  `(make-array 0 :element-type ',elem-type
  					       :adjustable t :fill-pointer 0))
  			      `(,(intern (format nil "MAKE-~a" type)
  					 (symbol-package type))))))
  	       `(,name ,init :type ,type))))
      (let* ((slot-names (mapcar #'first slots))
  	   (types (mapcar #'second slots))
  	   (accessor-names (mapcar (lambda (x)
  				     (intern (format nil "~a-~a" name x)
  					     (symbol-package name)))
  				   slot-names))
  	   (lengths (mapcar #'third slots)))
        (when (> (length types) (length (remove-duplicates types)))
  	(error "multiple slots found with the same type, this is no allowed in defkind"))
        `(progn
  	 (deftclass ,name
  	   ,@(mapcar #'parse-slot slots))
  	 ,@(remove nil
  		   (mapcar (lambda (x a l)
  			     (when l
  			       (let ((push (if (numberp l)
  					       'vector-push
  					       'vector-push-extend)))
  				 `(defmethod add ((inst ,name) (source ,x))
  				    (,push source (,a inst))))))
  			   types
  			   accessor-names
  			   lengths))))))
  
  (defkind mouse
    (pos xy-pos)
  