Fix touch events to work properly on mobile and desktop and redo tutorial 8

source/clog-base.lisp

@@ -118,7 +118,7 @@ flushed with FLUSH-CONNECTION-CACHE or a query is made."
   (when *connection-cache*
     (dolist (script (reverse *connection-cache*))
       (unless (eq script :cache)
-        (clog-connection:execute (connection-id clog-obj) script)))
+	(clog-connection:execute (connection-id clog-obj) script)))
     (setf *connection-cache* (list :cache))))
 
 ;;;;;;;;;;;;;;
@@ -131,7 +131,7 @@ flushed with FLUSH-CONNECTION-CACHE or a query is made."
 (defmethod js-query ((obj clog-obj) script &key (default-answer nil))
   (flush-connection-cache obj)
   (clog-connection:query (connection-id obj) script
-                         :default-answer default-answer))
+			 :default-answer default-answer))
 
 ;;;;;;;;;;;;;
 ;; execute ;;
@@ -154,7 +154,7 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
 
 (defmethod query ((obj clog-obj) method &key (default-answer nil))
   (js-query obj (format nil "~A.~A" (script-id obj) method)
-            :default-answer default-answer))
+	    :default-answer default-answer))
 
 ;;;;;;;;;;;;;;;;;;;;;;;
 ;; bind-event-script ;;
@@ -166,7 +166,7 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
 
 (defmethod bind-event-script ((obj clog-obj) event call-back)
   (jquery-execute obj (format nil "on('~A',function (e, data){~A})"
-                              event call-back)))
+			      event call-back)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; unbind-event-script ;;
@@ -218,18 +218,18 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
 
 (defparameter touch-event-script
   "+ (e.touches[0].clientX -
-        e.touches[0].currentTarget.getBoundingClientRect().left +
+	e.touches[0].target.getBoundingClientRect().left +
-        e.touches[0].currentTarget.scrollLeft) + ':' +
+	e.touches[0].target.scrollLeft) + ':' +
      (e.touches[0].clientY -
-        e.touches[0].currentTarget.getBoundingClientRect().top +
+	e.touches[0].target.getBoundingClientRect().top +
-        e.touches[0].currentTarget.scrollTop) + ':' +
+	e.touches[0].target.scrollTop) + ':' +
      e.touches[0].screenX + ':' + e.touches[0].screenY + ':' + e.touches.length + ':' +
      e.altKey + ':' +
      e.ctrlKey + ':' +
      e.shiftKey + ':' +
      e.metaKey + ':' +
      e.touches[0].clientX + ':' + e.touches[0].clientY + ':' +
-     e..touches[0].pageX + ':' + e.touches[0].pageY"
+     e.touches[0].pageX + ':' + e.touches[0].pageY"
     "JavaScript to collect touch event data from browser.")
 
 (defun parse-touch-event (data)
@@ -301,8 +301,8 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
      :shift-key  (js-true-p (nth 4 f))
      :meta-key   (js-true-p (nth 5 f))
      :key        (if (equal (nth 6 f) "colon")
-                     ":"
+		     ":"
-                     (nth 6 f)))))
+		     (nth 6 f)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;
 ;; parse-drop-event ;;
@@ -333,39 +333,39 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
 ;;;;;;;;;;;;;;;
 
 (defgeneric set-event (clog-obj event handler
-                       &key call-back-script
+		       &key call-back-script
-                         eval-script
+			 eval-script
-                         post-eval
+			 post-eval
-                         cancel-event
+			 cancel-event
-                         one-time)
+			 one-time)
   (:documentation "Create the hook for incoming events. (Private)"))
 
 (defmethod set-event ((obj clog-obj) event handler
-                      &key (call-back-script "")
+		      &key (call-back-script "")
-                        (eval-script "")
+			(eval-script "")
-                        (post-eval "")
+			(post-eval "")
-                        (cancel-event nil)
+			(cancel-event nil)
-                        (one-time nil))
+			(one-time nil))
   (let ((hook (format nil "~A:~A" (html-id obj) event))
-        (cd   (connection-data obj)))
+	(cd   (connection-data obj)))
     (if cd
-        (cond (handler
+	(cond (handler
-               (bind-event-script
+	       (bind-event-script
-                obj event (format nil "~Aws.send('E:~A '~A)~A~@[~A~]~@[~A~]"
+		obj event (format nil "~Aws.send('E:~A '~A)~A~@[~A~]~@[~A~]"
-                                  eval-script
+				  eval-script
-                                  hook
+				  hook
-                                  call-back-script
+				  call-back-script
-                                  post-eval
+				  post-eval
-                                  (when one-time
+				  (when one-time
-                                    (format nil "; ~A.off('~A')"
+				    (format nil "; ~A.off('~A')"
-                                            (jquery obj)
+					    (jquery obj)
-                                            event))
+					    event))
-                                  (when cancel-event "; return false")))
+				  (when cancel-event "; return false")))
-               (setf (gethash hook cd) handler))
+	       (setf (gethash hook cd) handler))
-              (t
+	      (t
-               (unbind-event-script obj event)
+	       (unbind-event-script obj event)
-               (remhash hook cd)))
+	       (remhash hook cd)))
-        (format t "Attempt to set event on non-existant connection.~%"))))
+	(format t "Attempt to set event on non-existant connection.~%"))))
 
 ;;;;;;;;;;;;;;
 ;; property ;;
@@ -376,15 +376,15 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
 
 (defmethod property ((obj clog-obj) property-name &key (default-answer nil))
   (jquery-query obj (format nil "prop('~A')" property-name)
-                :default-answer default-answer))
+		:default-answer default-answer))
 
 (defgeneric (setf property) (value clog-obj property-name)
   (:documentation "Set html property."))
 
 (defmethod (setf property) (value (obj clog-obj) property-name)
   (jquery-execute obj (format nil "prop('~A','~A')"
-                              property-name
+			      property-name
-                              (escape-string value)))
+			      (escape-string value)))
   value)
 
 ;;;;;;;;;;;;
@@ -529,21 +529,21 @@ an application share per connection the same queue of serialized events."
 ;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-event (clog-obj event-name handler
-                          &key cancel-event one-time)
+			  &key cancel-event one-time)
   (:documentation "Set a HANDLER for EVENT-NAME on CLOG-OBJ. If handler is
 nil unbind all event handlers. (Internal)"))
 
 (defmethod set-on-event ((obj clog-obj) event-name handler
-                         &key
+			 &key
-                           (cancel-event nil)
+			   (cancel-event nil)
-                           (one-time nil))
+			   (one-time nil))
   (set-event obj event-name
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (declare (ignore data))
+		 (declare (ignore data))
-                 (funcall handler obj)))
+		 (funcall handler obj)))
-             :cancel-event cancel-event
+	     :cancel-event cancel-event
-             :one-time     one-time))
+	     :one-time     one-time))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -551,23 +551,23 @@ nil unbind all event handlers. (Internal)"))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-event-with-data (clog-obj event-name handler
-                                    &key cancel-event one-time)
+				    &key cancel-event one-time)
   (:documentation "Set a HANDLER for EVENT-NAME on CLOG-OBJ.
  If handler is nil unbind all event handlers. Handler is called with a data
 option passed from javascript calling the jQuery custom event mechanism
 .trigger('event_name', data) (Internal)"))
 
 (defmethod set-on-event-with-data ((obj clog-obj) event-name handler
-                                   &key
+				   &key
-                                     (cancel-event nil)
+				     (cancel-event nil)
-                                     (one-time     nil))
+				     (one-time     nil))
   (set-event obj event-name
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj data)))
+		 (funcall handler obj data)))
-             :call-back-script "+data"
+	     :call-back-script "+data"
-             :cancel-event cancel-event
+	     :cancel-event cancel-event
-             :one-time     one-time))
+	     :one-time     one-time))
 
 ;;;;;;;;;;;;;;;;;;;
 ;; set-on-resize ;;
@@ -630,21 +630,21 @@ is nil unbind the event."))
 ;;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-drag-start (clog-obj on-drag-start-handler
-                               &key drag-data drag-type)
+			       &key drag-data drag-type)
   (:documentation "Set the ON-DRAG-START-HANDLER for CLOG-OBJ.
 If ON-DRAG-START-HANDLER is nil unbind the event."))
 
 (defmethod set-on-drag-start ((obj clog-obj) handler
-                              &key (drag-data "") (drag-type "text/plain"))
+			      &key (drag-data "") (drag-type "text/plain"))
   (set-event obj "dragstart"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (declare (ignore data))
+		 (declare (ignore data))
-                 (funcall handler obj)))
+		 (funcall handler obj)))
-             :eval-script (format nil
+	     :eval-script (format nil
-                 "e.originalEvent.dataTransfer.setData('~A','~A'); "
+		 "e.originalEvent.dataTransfer.setData('~A','~A'); "
-                                  drag-type
+				  drag-type
-                                  drag-data)))
+				  drag-data)))
 
 ;;;;;;;;;;;;;;;;;
 ;; set-on-drag ;;
@@ -701,12 +701,12 @@ is nil unbind the event."))
 
 (defmethod set-on-drag-over ((obj clog-obj) handler)
   (set-event obj "dragover"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (declare (ignore data))
+		 (declare (ignore data))
-                 (funcall handler obj)))
+		 (funcall handler obj)))
-             :cancel-event t
+	     :cancel-event t
-             :eval-script "e.preventDefault(); "))
+	     :eval-script "e.preventDefault(); "))
 
 ;;;;;;;;;;;;;;;;;
 ;; set-on-drop ;;
@@ -718,12 +718,12 @@ is nil unbind the event."))
 
 (defmethod set-on-drop ((obj clog-obj) handler &key (drag-type "text/plain"))
   (set-event obj "drop"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-drop-event data))))
+		 (funcall handler obj (parse-drop-event data))))
-             :call-back-script (format nil drop-event-script drag-type)
+	     :call-back-script (format nil drop-event-script drag-type)
-             :eval-script "e.preventDefault(); "
+	     :eval-script "e.preventDefault(); "
-             :cancel-event t))
+	     :cancel-event t))
 
 ;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-focus-in ;;
@@ -758,11 +758,11 @@ this event is bound, you must call the form reset manually."))
 
 (defmethod set-on-reset ((obj clog-obj) handler)
   (set-event obj "reset"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (declare (ignore data))
+		 (declare (ignore data))
-                 (funcall handler obj)))
+		 (funcall handler obj)))
-             :cancel-event t))
+	     :cancel-event t))
 
 ;;;;;;;;;;;;;;;;;;;
 ;; set-on-search ;;
@@ -798,18 +798,18 @@ form action to be run. See CLOG-Form SUBMIT for more details."))
 
 (defmethod set-on-submit ((obj clog-obj) handler)
   (set-event obj "submit"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (declare (ignore data))
+		 (declare (ignore data))
-                 (funcall handler obj)))
+		 (funcall handler obj)))
-             :cancel-event t))
+	     :cancel-event t))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-context-menu ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-context-menu (clog-obj on-context-menu-handler
-                                 &key one-time)
+				 &key one-time)
   (:documentation "Set the ON-CONTEXT-MENU-HANDLER for CLOG-OBJ. If
 ON-CONTEXT-MENU-HANDLER is nil unbind the event. Setting
 on-mouse-right-click will replace this handler. If :ONE-TIME unbind
@@ -817,29 +817,29 @@ event on right click."))
 
 (defmethod set-on-context-menu ((obj clog-obj) handler &key (one-time nil))
   (set-event obj "contextmenu"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (declare (ignore data))
+		 (declare (ignore data))
-                 (funcall handler obj)))
+		 (funcall handler obj)))
-             :one-time one-time
+	     :one-time one-time
-             :cancel-event t))
+	     :cancel-event t))
 
 ;;;;;;;;;;;;;;;;;;
 ;; set-on-click ;;
 ;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-click (clog-obj on-click-handler &key one-time)
+(defgeneric set-on-click (clog-obj on-click-handler &key one-time cancel-event)
   (:documentation "Set the ON-CLICK-HANDLER for CLOG-OBJ. If ON-CLICK-HANDLER
 is nil unbind the event. Setting this event will replace an on-mouse click if
 set. If :ONE-TIME unbind event on click."))
 
 (defmethod set-on-click ((obj clog-obj) handler &key one-time cancel-event)
   (set-event obj "click"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (declare (ignore data))
+		 (declare (ignore data))
-                 (funcall handler obj)))
+		 (funcall handler obj)))
-             :one-time one-time
+	     :one-time one-time
 	     :cancel-event cancel-event))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -847,18 +847,18 @@ set. If :ONE-TIME unbind event on click."))
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-double-click (clog-obj on-double-click-handler
-                                 &key one-time cancel-event)
+				 &key one-time cancel-event)
   (:documentation "Set the ON-DOUBLE-CLICK-HANDLER for CLOG-OBJ. If
 ON-DOUBLE-CLICK-HANDLER is nil unbind the event. Setting the
 on-mouse-double-click event will replace this handler."))
 
 (defmethod set-on-double-click ((obj clog-obj) handler &key one-time cancel-event)
   (set-event obj "dblclick"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (declare (ignore data))
+		 (declare (ignore data))
-                 (funcall handler obj)))
+		 (funcall handler obj)))
-             :one-time one-time
+	     :one-time one-time
 	     :cancel-event cancel-event))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;
@@ -872,50 +872,50 @@ on an on-click event."))
 
 (defmethod set-on-mouse-click ((obj clog-obj) handler &key one-time cancel-event)
   (set-event obj "click"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-mouse-event data))))
+		 (funcall handler obj (parse-mouse-event data))))
-             :one-time one-time
+	     :one-time one-time
 	     :cancel-event cancel-event
-             :call-back-script mouse-event-script))
+	     :call-back-script mouse-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-mouse-double-click ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-mouse-double-click (clog-obj on-mouse-double-click-handler
-                                       &key one-time)
+				       &key one-time)
   (:documentation "Set the ON-MOUSE-DOUBLE-CLICK-HANDLER for CLOG-OBJ. If
 ON-MOUSE-DOUBLE-CLICK-HANDLER is nil unbind the event. Setting this event will
 replace on an on-double-click event."))
 
 (defmethod set-on-mouse-double-click ((obj clog-obj) handler &key (one-time nil))
   (set-event obj "dblclick"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-mouse-event data))))
+		 (funcall handler obj (parse-mouse-event data))))
-             :one-time one-time
+	     :one-time one-time
-             :call-back-script mouse-event-script))
+	     :call-back-script mouse-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-mouse-right-click ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-mouse-right-click (clog-obj on-mouse-right-click-handler
-                                       &key one-time)
+				       &key one-time)
   (:documentation "Set the ON-MOUSE-RIGHT-CLICK-HANDLER for CLOG-OBJ. If
 ON-MOUSE-RIGHT-CLICK-HANDLER is nil unbind the event. Setting this event will
 replace on an on-context-menu event."))
 
 (defmethod set-on-mouse-right-click ((obj clog-obj) handler
-                                     &key (one-time nil))
+				     &key (one-time nil))
   (set-event obj "contextmenu"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-mouse-event data))))
+		 (funcall handler obj (parse-mouse-event data))))
-             :one-time one-time
+	     :one-time one-time
-             :call-back-script mouse-event-script
+	     :call-back-script mouse-event-script
-             :cancel-event t))
+	     :cancel-event t))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-mouse-enter ;;
@@ -966,50 +966,58 @@ If ON-MOUSE-OVER-HANDLER is nil unbind the event."))
 ;;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-mouse-down (clog-obj on-mouse-down-handler
-                               &key one-time cancel-event)
+			       &key one-time cancel-event)
   (:documentation "Set the ON-MOUSE-DOWN-HANDLER for CLOG-OBJ. If
 ON-MOUSE-DOWN-HANDLER is nil unbind the event. If cancel-event is true event
 does not bubble."))
 
 (defmethod set-on-mouse-down ((obj clog-obj) handler
-                              &key (one-time nil) (cancel-event nil))
+			      &key (one-time nil) (cancel-event nil))
   (set-event obj "mousedown"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-mouse-event data))))
+		 (funcall handler obj (parse-mouse-event data))))
-             :one-time one-time
+	     :one-time one-time
-             :cancel-event cancel-event
+	     :cancel-event cancel-event
-             :call-back-script mouse-event-script))
+	     :call-back-script mouse-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-mouse-up ;;
 ;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-mouse-up (clog-obj on-mouse-up-handler)
+(defgeneric set-on-mouse-up (clog-obj on-mouse-up-handler
+			     &key one-time cancel-event)
   (:documentation "Set the ON-MOUSE-UP-HANDLER for CLOG-OBJ. If
 ON-MOUSE-UP-HANDLER is nil unbind the event."))
 
-(defmethod set-on-mouse-up ((obj clog-obj) handler)
+(defmethod set-on-mouse-up ((obj clog-obj) handler
+			    &key (one-time nil) (cancel-event nil))
   (set-event obj "mouseup"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-mouse-event data))))
+		 (funcall handler obj (parse-mouse-event data))))
-             :call-back-script mouse-event-script))
+	     :one-time one-time
+	     :cancel-event cancel-event
+	     :call-back-script mouse-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-mouse-move ;;
 ;;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-mouse-move (clog-obj on-mouse-move-handler)
+(defgeneric set-on-mouse-move (clog-obj on-mouse-move-handler
+			       &key one-time cancel-event)
   (:documentation "Set the ON-MOUSE-MOVE-HANDLER for CLOG-OBJ. If
 ON-MOUSE-MOVE-HANDLER is nil unbind the event."))
 
-(defmethod set-on-mouse-move ((obj clog-obj) handler)
+(defmethod set-on-mouse-move ((obj clog-obj) handler
+			    &key (one-time nil) (cancel-event nil))
   (set-event obj "mousemove"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-mouse-event data))))
+		 (funcall handler obj (parse-mouse-event data))))
-             :call-back-script mouse-event-script))
+	     :one-time one-time
+	     :cancel-event cancel-event
+	     :call-back-script mouse-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-pointer-enter ;;
@@ -1060,104 +1068,123 @@ ON-MOUSE-MOVE-HANDLER is nil unbind the event."))
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-pointer-down (clog-obj on-pointer-down-handler
-                                 &key capture-pointer one-time cancel-event)
+				 &key capture-pointer one-time cancel-event)
   (:documentation "Set the ON-POINTER-DOWN-HANDLER for CLOG-OBJ. If
 ON-POINTER-DOWN-HANDLER is nil unbind the event. If cancel event is t the
 even does not bubble."))
 
 (defmethod set-on-pointer-down ((obj clog-obj) handler
-                                &key (capture-pointer nil)
+				&key (capture-pointer nil)
-                                  (one-time nil)
+				  (one-time nil)
-                                  (cancel-event nil))
+				  (cancel-event nil))
   (set-event obj "pointerdown"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-pointer-event data))))
+		 (funcall handler obj (parse-pointer-event data))))
-             :post-eval (if capture-pointer
+	     :post-eval (if capture-pointer
-                            (format nil "; ~A.setPointerCapture(e.pointerId)"
+			    (format nil "; ~A.setPointerCapture(e.pointerId)"
-                                    (script-id obj))
+				    (script-id obj))
-                            "")
+			    "")
-             :one-time one-time
+	     :one-time one-time
-             :cancel-event cancel-event
+	     :cancel-event cancel-event
-             :call-back-script pointer-event-script))
+	     :call-back-script pointer-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-pointer-up ;;
 ;;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-pointer-up (clog-obj on-pointer-up-handler)
+(defgeneric set-on-pointer-up (clog-obj on-pointer-up-handler
+			       &key one-time cancel-event)
   (:documentation "Set the ON-POINTER-UP-HANDLER for CLOG-OBJ. If
 ON-POINTER-UP-HANDLER is nil unbind the event."))
 
-(defmethod set-on-pointer-up ((obj clog-obj) handler)
+(defmethod set-on-pointer-up ((obj clog-obj) handler
+			      &key (one-time nil) (cancel-event nil))
   (set-event obj "pointerup"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-pointer-event data))))
+		 (funcall handler obj (parse-pointer-event data))))
-             :post-eval (format nil "; ~A.releasePointerCapture(e.pointerId)"
+	     :post-eval (format nil "; ~A.releasePointerCapture(e.pointerId)"
-                                (script-id obj))
+				(script-id obj))
-             :call-back-script pointer-event-script))
+	     :one-time one-time
+	     :cancel-event cancel-event
+	     :call-back-script pointer-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-pointer-move ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-pointer-move (clog-obj on-pointer-move-handler)
+(defgeneric set-on-pointer-move (clog-obj on-pointer-move-handler
+				 &key one-time cancel-event)
   (:documentation "Set the ON-POINTER-MOVE-HANDLER for CLOG-OBJ. If
 ON-POINTER-MOVE-HANDLER is nil unbind the event."))
 
-(defmethod set-on-pointer-move ((obj clog-obj) handler)
+(defmethod set-on-pointer-move ((obj clog-obj) handler
+				&key (one-time nil) (cancel-event nil))
   (set-event obj "pointermove"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-pointer-event data))))
+		 (funcall handler obj (parse-pointer-event data))))
-             :call-back-script pointer-event-script))
+	     :one-time one-time
+	     :cancel-event cancel-event
+	     :call-back-script pointer-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-touch-start ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-touch-start (clog-obj on-touch-start-handler &key one-time)
+(defgeneric set-on-touch-start (clog-obj on-touch-start-handler
+				&key one-time cancel-event)
   (:documentation "Set the ON-TOUCH-START-HANDLER for CLOG-OBJ. If
 ON-TOUCH-START-HANDLER is nil unbind the event."))
 
-(defmethod set-on-touch-start ((obj clog-obj) handler &key (one-time nil))
+(defmethod set-on-touch-start ((obj clog-obj) handler
+			       &key (one-time nil) (cancel-event nil))
   (set-event obj "touchstart"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-touch-event data))))
+		 (funcall handler obj (parse-touch-event data))))
-             :one-time one-time
+	     :one-time one-time
-             :call-back-script touch-event-script))
+	     :cancel-event cancel-event
+	     :call-back-script touch-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-touch-move ;;
 ;;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-touch-move (clog-obj on-touch-move-handler)
+(defgeneric set-on-touch-move (clog-obj on-touch-move-handler
+			       &key one-time cancel-event)
   (:documentation "Set the ON-TOUCH-MOVE-HANDLER for CLOG-OBJ. If
 ON-TOUCH-MOVE-HANDLER is nil unbind the event."))
 
-(defmethod set-on-touch-move ((obj clog-obj) handler)
+(defmethod set-on-touch-move ((obj clog-obj) handler
+			      &key (one-time nil) (cancel-event nil))
   (set-event obj "touchmove"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-touch-event data))))
+		 (funcall handler obj (parse-touch-event data))))
-             :call-back-script touch-event-script))
+	     :one-time one-time
+	     :cancel-event cancel-event
+	     :call-back-script touch-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-touch-end ;;
 ;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-touch-end (clog-obj on-touch-end-handler)
+(defgeneric set-on-touch-end (clog-obj on-touch-end-handler
+			      &key one-time cancel-event)
   (:documentation "Set the ON-TOUCH-END-HANDLER for CLOG-OBJ. If
 ON-TOUCH-END-HANDLER is nil unbind the event."))
 
-(defmethod set-on-touch-end ((obj clog-obj) handler)
+(defmethod set-on-touch-end ((obj clog-obj) handler
+			     &key (one-time nil) (cancel-event nil))
   (set-event obj "touchend"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-touch-event data))))
+		 (declare (ignore dara))
-             :call-back-script touch-event-script))
+		 (funcall handler obj)))
+	     :one-time one-time
+	     :cancel-event cancel-event))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-touch-cancel ;;
@@ -1169,52 +1196,52 @@ ON-TOUCH-CANCEL-HANDLER is nil unbind the event."))
 
 (defmethod set-on-touch-cancel ((obj clog-obj) handler)
   (set-event obj "touchcancel"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-touch-event data))))
+		 (declare (ignore dara))
-             :call-back-script touch-event-script))
+		 (funcall handler obj)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-character ;;
 ;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-character (clog-obj on-character-handler
-                              &key one-time disable-default)
+			      &key one-time disable-default)
   (:documentation "Set the ON-CHARACTER-HANDLER for CLOG-OBJ. If
 ON-CHARACTER-HANDLER is nil unbind the event. If disable-default is t
 default key bindings in browser will not occur. Setting this event to
 nil will unbind on-key-press also."))
 
 (defmethod set-on-character ((obj clog-obj) handler
-                             &key (one-time nil) (disable-default nil))
+			     &key (one-time nil) (disable-default nil))
   (set-event obj "keypress"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-               (let ((f (parse-keyboard-event data)))
+	       (let ((f (parse-keyboard-event data)))
-                 (funcall handler obj (code-char (getf f :char-code))))))
+		 (funcall handler obj (code-char (getf f :char-code))))))
-             :one-time one-time
+	     :one-time one-time
-             :cancel-event disable-default
+	     :cancel-event disable-default
-             :call-back-script keyboard-event-script))
+	     :call-back-script keyboard-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-key-down ;;
 ;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-key-down (clog-obj on-key-down-handler
-                             &key one-time disable-default)
+			     &key one-time disable-default)
   (:documentation "Set the ON-KEY-DOWN-HANDLER for CLOG-OBJ. If
 disable-default is t default key bindings in browser will not occur.
 If ON-KEY-DOWN-HANDLER is nil unbind the event."))
 
 (defmethod set-on-key-down ((obj clog-obj) handler
-                            &key (one-time nil) (disable-default nil))
+			    &key (one-time nil) (disable-default nil))
   (set-event obj "keydown"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-keyboard-event data))))
+		 (funcall handler obj (parse-keyboard-event data))))
-             :one-time one-time
+	     :one-time one-time
-             :cancel-event disable-default
+	     :cancel-event disable-default
-             :call-back-script keyboard-event-script))
+	     :call-back-script keyboard-event-script))
 
 ;;;;;;;;;;;;;;;;;;;
 ;; set-on-key-up ;;
@@ -1226,30 +1253,30 @@ ON-KEY-UP-HANDLER is nil unbind the event."))
 
 (defmethod set-on-key-up ((obj clog-obj) handler &key (one-time nil))
   (set-event obj "keyup"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-keyboard-event data))))
+		 (funcall handler obj (parse-keyboard-event data))))
-             :one-time one-time
+	     :one-time one-time
-             :call-back-script keyboard-event-script))
+	     :call-back-script keyboard-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-key-press ;;
 ;;;;;;;;;;;;;;;;;;;;;;
 
 (defgeneric set-on-key-press (clog-obj on-key-press-handler
-                              &key one-time disable-default)
+			      &key one-time disable-default)
   (:documentation "Set the ON-KEY-PRESS-HANDLER for CLOG-OBJ. If
 ON-KEY-PRESS-HANDLER is nil unbind the event."))
 
 (defmethod set-on-key-press ((obj clog-obj) handler
-                             &key (one-time nil) (disable-default nil))
+			     &key (one-time nil) (disable-default nil))
   (set-event obj "keypress"
-             (when handler
+	     (when handler
-               (lambda (data)
+	       (lambda (data)
-                 (funcall handler obj (parse-keyboard-event data))))
+		 (funcall handler obj (parse-keyboard-event data))))
-             :one-time one-time
+	     :one-time one-time
-             :cancel-event disable-default
+	     :cancel-event disable-default
-             :call-back-script keyboard-event-script))
+	     :call-back-script keyboard-event-script))
 
 ;;;;;;;;;;;;;;;;;
 ;; set-on-copy ;;

tutorial/08-tutorial.lisp

@@ -5,11 +5,11 @@
 (in-package :clog-tut-8)
 
 (defclass app-data ()
-  ((in-drag
+  ((drag-type
-    :accessor in-drag-p
+    :accessor drag-type
     :initform nil
-    :documentation "Ensure only one box is dragged at a time.")
+    :documentation "Ensure only pointer or touch events.")
-   (drag-x
+    (drag-x
     :accessor drag-x
     :documentation "The location of the left side of the box relative to mouse during drag.")
    (drag-y
@@ -17,56 +17,55 @@
    :documentation "The location of the top of the box relative to mouse during drag."))
   (:documentation "App data specific to each instance of our tutorial 8 app"))
 
+(defun stop-tracking (obj)
+  (set-on-pointer-move obj nil)
+  (set-on-pointer-up obj nil)
+  (set-on-touch-move obj nil)
+  (set-on-touch-end obj nil)
+  (let ((app (connection-data-item obj "app-data")))
+    (setf (drag-type app) nil)))
+
 (defun on-mouse-down (obj data)
-  (with-sync-event (obj)                                 ; Serialize events to on-mouse-down.
+  (let ((app (connection-data-item obj "app-data")))
-    (let ((app (connection-data-item obj "app-data")))   ; Ensure the first event received
+    (with-sync-event (obj)                     ; Process one event at a time
-      (unless (in-drag-p app)                            ; to drag is the only one, ie only
+      (when (eq (drag-type app) :pointer)      ; Prefer touch events to pointer events
-        (setf (in-drag-p app) t)                         ; the innermost box is dragged.
+	(stop-tracking obj))                   ; to accomidate mobile devices emulating mice
-        (let* ((mouse-x  (getf data :screen-x))          ; Use the screen coordinates not
+      (setf (drag-type app) (getf data :event-type))
-               (mouse-y  (getf data :screen-y))          ; the coordinates relative to the obj
+      (let* ((mouse-x  (getf data :screen-x))  ; Use the screen coordinates not
-               (obj-top  (parse-integer (top obj) :junk-allowed t))
+	     (mouse-y  (getf data :screen-y))  ; the coordinates relative to the obj
-               (obj-left (parse-integer (left obj) :junk-allowed t)))
+	     (obj-top  (parse-integer (top obj) :junk-allowed t))
-          (setf (drag-x app) (- mouse-x obj-left))
+	     (obj-left (parse-integer (left obj) :junk-allowed t)))
-          (setf (drag-y app) (- mouse-y obj-top))
+	(setf (drag-x app) (- mouse-x obj-left))
-          (if (eq (getf data :event-type) :touch)
+	(setf (drag-y app) (- mouse-y obj-top))
-              (progn
+	(cond ((eq (getf data :event-type) :touch)
-                (set-on-touch-move obj 'on-mouse-move)
+	       (set-on-touch-move obj 'on-mouse-move)
-                (set-on-touch-end obj 'stop-obj-grab)
+	       (set-on-touch-end obj 'on-touch-end))
-                (set-on-touch-cancel obj 'on-mouse-leave))
+	      (t
-              (progn
+	       (set-on-pointer-move obj 'on-mouse-move)
-                (set-on-mouse-move obj 'on-mouse-move)
+	       (set-on-pointer-up obj 'on-mouse-up)))))))
-                (set-on-mouse-up obj 'stop-obj-grab)
-                (set-on-mouse-leave obj 'on-mouse-leave))))))))
 
 (defun on-mouse-move (obj data)
   (let* ((app (connection-data-item obj "app-data"))
-         (x   (getf data :screen-x))
+	 (x   (getf data :screen-x))
-         (y   (getf data :screen-y)))
+	 (y   (getf data :screen-y)))
     (setf (top obj) (unit :px (- y (drag-y app))))
     (setf (left obj) (unit :px (- x (drag-x app))))))
 
-(defun on-mouse-leave (obj)
+(defun on-mouse-up (obj data)
-  (let ((app (connection-data-item obj "app-data")))
+  (declare (ignore data))
-    (setf (in-drag-p app) nil)
+  (stop-tracking obj))
-    (set-on-touch-move obj nil)
-    (set-on-touch-end obj nil)
-    (set-on-touch-cancel obj nil)
-    (set-on-mouse-move obj nil)
-    (set-on-mouse-up obj nil)
-    (set-on-mouse-leave obj nil)))
 
-(defun stop-obj-grab (obj data)
+(defun on-touch-end (obj)
-  (on-mouse-move obj data)
+  (stop-tracking obj))
-  (on-mouse-leave obj))
 
 (defun on-new-window (body)
   (let ((app (make-instance 'app-data)))                 ; Create our "App-Data" for this instance
     (setf (connection-data-item body "app-data") app))   ; of our App.
   (setf (title (html-document body)) "Tutorial 08")
   (let* ((div1 (create-div body))
-         (div2 (create-div div1))
+	 (div2 (create-div div1))
-         (div3 (create-div div2))
+	 (div3 (create-div div2))
-         (dir  (create-div div1 :content "<b>Click and drag the boxes</b>")))
+	 (dir  (create-div div1 :content "<b>Click and drag the boxes</b>")))
     ;; Absolute allows fixed positioning relative to parent
     (setf (positioning dir) :absolute)
     (setf (bottom dir) 0)
@@ -85,15 +84,18 @@
     ;; to the entire window.
     (setf (positioning div1) :fixed)        ; Its location relative to window
     (setf (overflow div1) :hidden)          ; Clip the contents
-    (set-on-touch-start div1 'on-mouse-down)
-    (set-on-mouse-down div1 'on-mouse-down)
     (setf (positioning div2) :absolute)     ; Its location relative to its parent container
     (setf (overflow div2) :hidden)
-    (set-on-touch-start div2 'on-mouse-down)
-    (set-on-mouse-down div2 'on-mouse-down)
     (setf (positioning div3) :absolute)
-    (set-on-touch-start div3 'on-mouse-down)
+    ;; Setup mouse/touch/pointer events
-    (set-on-mouse-down div3 'on-mouse-down)))
+    ;; Since our divs are embedded on with in the other we use cancel-event so events do
+    ;; not bubble up from one div to another
+    (set-on-touch-start div1 'on-mouse-down :cancel-event t)
+    (set-on-touch-start div2 'on-mouse-down :cancel-event t)
+    (set-on-touch-start div3 'on-mouse-down :cancel-event t)
+    (set-on-pointer-down div1 'on-mouse-down :cancel-event t :capture-pointer t)
+    (set-on-pointer-down div2 'on-mouse-down :cancel-event t :capture-pointer t)
+    (set-on-pointer-down div3 'on-mouse-down :cancel-event t :capture-pointer t)))
 
 (defun start-tutorial ()
   "Start turtorial."