diff --git a/source/clog-base.lisp b/source/clog-base.lisp
index b516b91..ba0f448 100644
--- a/source/clog-base.lisp
+++ b/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].currentTarget.scrollLeft) + ':' +
+ e.touches[0].target.getBoundingClientRect().left +
+ e.touches[0].target.scrollLeft) + ':' +
(e.touches[0].clientY -
- e.touches[0].currentTarget.getBoundingClientRect().top +
- e.touches[0].currentTarget.scrollTop) + ':' +
+ e.touches[0].target.getBoundingClientRect().top +
+ 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
- eval-script
- post-eval
- cancel-event
- one-time)
+ &key call-back-script
+ eval-script
+ post-eval
+ cancel-event
+ one-time)
(:documentation "Create the hook for incoming events. (Private)"))
(defmethod set-event ((obj clog-obj) event handler
- &key (call-back-script "")
- (eval-script "")
- (post-eval "")
- (cancel-event nil)
- (one-time nil))
+ &key (call-back-script "")
+ (eval-script "")
+ (post-eval "")
+ (cancel-event 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
- (bind-event-script
- obj event (format nil "~Aws.send('E:~A '~A)~A~@[~A~]~@[~A~]"
- eval-script
- hook
- call-back-script
- post-eval
- (when one-time
- (format nil "; ~A.off('~A')"
- (jquery obj)
- event))
- (when cancel-event "; return false")))
- (setf (gethash hook cd) handler))
- (t
- (unbind-event-script obj event)
- (remhash hook cd)))
- (format t "Attempt to set event on non-existant connection.~%"))))
+ (cond (handler
+ (bind-event-script
+ obj event (format nil "~Aws.send('E:~A '~A)~A~@[~A~]~@[~A~]"
+ eval-script
+ hook
+ call-back-script
+ post-eval
+ (when one-time
+ (format nil "; ~A.off('~A')"
+ (jquery obj)
+ event))
+ (when cancel-event "; return false")))
+ (setf (gethash hook cd) handler))
+ (t
+ (unbind-event-script obj event)
+ (remhash hook cd)))
+ (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
- (escape-string value)))
+ property-name
+ (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
- (cancel-event nil)
- (one-time nil))
+ &key
+ (cancel-event nil)
+ (one-time nil))
(set-event obj event-name
- (when handler
- (lambda (data)
- (declare (ignore data))
- (funcall handler obj)))
- :cancel-event cancel-event
- :one-time one-time))
+ (when handler
+ (lambda (data)
+ (declare (ignore data))
+ (funcall handler obj)))
+ :cancel-event cancel-event
+ :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
- (cancel-event nil)
- (one-time nil))
+ &key
+ (cancel-event nil)
+ (one-time nil))
(set-event obj event-name
- (when handler
- (lambda (data)
- (funcall handler obj data)))
- :call-back-script "+data"
- :cancel-event cancel-event
- :one-time one-time))
+ (when handler
+ (lambda (data)
+ (funcall handler obj data)))
+ :call-back-script "+data"
+ :cancel-event cancel-event
+ :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
- (lambda (data)
- (declare (ignore data))
- (funcall handler obj)))
- :eval-script (format nil
- "e.originalEvent.dataTransfer.setData('~A','~A'); "
- drag-type
- drag-data)))
+ (when handler
+ (lambda (data)
+ (declare (ignore data))
+ (funcall handler obj)))
+ :eval-script (format nil
+ "e.originalEvent.dataTransfer.setData('~A','~A'); "
+ drag-type
+ 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
- (lambda (data)
- (declare (ignore data))
- (funcall handler obj)))
- :cancel-event t
- :eval-script "e.preventDefault(); "))
+ (when handler
+ (lambda (data)
+ (declare (ignore data))
+ (funcall handler obj)))
+ :cancel-event t
+ :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
- (lambda (data)
- (funcall handler obj (parse-drop-event data))))
- :call-back-script (format nil drop-event-script drag-type)
- :eval-script "e.preventDefault(); "
- :cancel-event t))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-drop-event data))))
+ :call-back-script (format nil drop-event-script drag-type)
+ :eval-script "e.preventDefault(); "
+ :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
- (lambda (data)
- (declare (ignore data))
- (funcall handler obj)))
- :cancel-event t))
+ (when handler
+ (lambda (data)
+ (declare (ignore data))
+ (funcall handler obj)))
+ :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
- (lambda (data)
- (declare (ignore data))
- (funcall handler obj)))
- :cancel-event t))
+ (when handler
+ (lambda (data)
+ (declare (ignore data))
+ (funcall handler obj)))
+ :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
- (lambda (data)
- (declare (ignore data))
- (funcall handler obj)))
- :one-time one-time
- :cancel-event t))
+ (when handler
+ (lambda (data)
+ (declare (ignore data))
+ (funcall handler obj)))
+ :one-time one-time
+ :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
- (lambda (data)
- (declare (ignore data))
- (funcall handler obj)))
- :one-time one-time
+ (when handler
+ (lambda (data)
+ (declare (ignore data))
+ (funcall handler obj)))
+ :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
- (lambda (data)
- (declare (ignore data))
- (funcall handler obj)))
- :one-time one-time
+ (when handler
+ (lambda (data)
+ (declare (ignore data))
+ (funcall handler obj)))
+ :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
- (lambda (data)
- (funcall handler obj (parse-mouse-event data))))
- :one-time one-time
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-mouse-event data))))
+ :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
- (lambda (data)
- (funcall handler obj (parse-mouse-event data))))
- :one-time one-time
- :call-back-script mouse-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-mouse-event data))))
+ :one-time one-time
+ :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
- (lambda (data)
- (funcall handler obj (parse-mouse-event data))))
- :one-time one-time
- :call-back-script mouse-event-script
- :cancel-event t))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-mouse-event data))))
+ :one-time one-time
+ :call-back-script mouse-event-script
+ :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
- (lambda (data)
- (funcall handler obj (parse-mouse-event data))))
- :one-time one-time
- :cancel-event cancel-event
- :call-back-script mouse-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-mouse-event data))))
+ :one-time one-time
+ :cancel-event cancel-event
+ :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
- (lambda (data)
- (funcall handler obj (parse-mouse-event data))))
- :call-back-script mouse-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-mouse-event data))))
+ :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
- (lambda (data)
- (funcall handler obj (parse-mouse-event data))))
- :call-back-script mouse-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-mouse-event data))))
+ :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)
- (one-time nil)
- (cancel-event nil))
+ &key (capture-pointer nil)
+ (one-time nil)
+ (cancel-event nil))
(set-event obj "pointerdown"
- (when handler
- (lambda (data)
- (funcall handler obj (parse-pointer-event data))))
- :post-eval (if capture-pointer
- (format nil "; ~A.setPointerCapture(e.pointerId)"
- (script-id obj))
- "")
- :one-time one-time
- :cancel-event cancel-event
- :call-back-script pointer-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-pointer-event data))))
+ :post-eval (if capture-pointer
+ (format nil "; ~A.setPointerCapture(e.pointerId)"
+ (script-id obj))
+ "")
+ :one-time one-time
+ :cancel-event cancel-event
+ :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
- (lambda (data)
- (funcall handler obj (parse-pointer-event data))))
- :post-eval (format nil "; ~A.releasePointerCapture(e.pointerId)"
- (script-id obj))
- :call-back-script pointer-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-pointer-event data))))
+ :post-eval (format nil "; ~A.releasePointerCapture(e.pointerId)"
+ (script-id obj))
+ :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
- (lambda (data)
- (funcall handler obj (parse-pointer-event data))))
- :call-back-script pointer-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-pointer-event data))))
+ :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
- (lambda (data)
- (funcall handler obj (parse-touch-event data))))
- :one-time one-time
- :call-back-script touch-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-touch-event data))))
+ :one-time one-time
+ :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
- (lambda (data)
- (funcall handler obj (parse-touch-event data))))
- :call-back-script touch-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-touch-event data))))
+ :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
- (lambda (data)
- (funcall handler obj (parse-touch-event data))))
- :call-back-script touch-event-script))
+ (when handler
+ (lambda (data)
+ (declare (ignore dara))
+ (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
- (lambda (data)
- (funcall handler obj (parse-touch-event data))))
- :call-back-script touch-event-script))
+ (when handler
+ (lambda (data)
+ (declare (ignore dara))
+ (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
- (lambda (data)
- (let ((f (parse-keyboard-event data)))
- (funcall handler obj (code-char (getf f :char-code))))))
- :one-time one-time
- :cancel-event disable-default
- :call-back-script keyboard-event-script))
+ (when handler
+ (lambda (data)
+ (let ((f (parse-keyboard-event data)))
+ (funcall handler obj (code-char (getf f :char-code))))))
+ :one-time one-time
+ :cancel-event disable-default
+ :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
- (lambda (data)
- (funcall handler obj (parse-keyboard-event data))))
- :one-time one-time
- :cancel-event disable-default
- :call-back-script keyboard-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-keyboard-event data))))
+ :one-time one-time
+ :cancel-event disable-default
+ :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
- (lambda (data)
- (funcall handler obj (parse-keyboard-event data))))
- :one-time one-time
- :call-back-script keyboard-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-keyboard-event data))))
+ :one-time one-time
+ :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
- (lambda (data)
- (funcall handler obj (parse-keyboard-event data))))
- :one-time one-time
- :cancel-event disable-default
- :call-back-script keyboard-event-script))
+ (when handler
+ (lambda (data)
+ (funcall handler obj (parse-keyboard-event data))))
+ :one-time one-time
+ :cancel-event disable-default
+ :call-back-script keyboard-event-script))
;;;;;;;;;;;;;;;;;
;; set-on-copy ;;
diff --git a/tutorial/08-tutorial.lisp b/tutorial/08-tutorial.lisp
index ff11b06..b94e629 100644
--- a/tutorial/08-tutorial.lisp
+++ b/tutorial/08-tutorial.lisp
@@ -5,11 +5,11 @@
(in-package :clog-tut-8)
(defclass app-data ()
- ((in-drag
- :accessor in-drag-p
+ ((drag-type
+ :accessor drag-type
:initform nil
- :documentation "Ensure only one box is dragged at a time.")
- (drag-x
+ :documentation "Ensure only pointer or touch events.")
+ (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"))) ; Ensure the first event received
- (unless (in-drag-p app) ; to drag is the only one, ie only
- (setf (in-drag-p app) t) ; the innermost box is dragged.
- (let* ((mouse-x (getf data :screen-x)) ; Use the screen coordinates not
- (mouse-y (getf data :screen-y)) ; the coordinates relative to the obj
- (obj-top (parse-integer (top obj) :junk-allowed t))
- (obj-left (parse-integer (left obj) :junk-allowed t)))
- (setf (drag-x app) (- mouse-x obj-left))
- (setf (drag-y app) (- mouse-y obj-top))
- (if (eq (getf data :event-type) :touch)
- (progn
- (set-on-touch-move obj 'on-mouse-move)
- (set-on-touch-end obj 'stop-obj-grab)
- (set-on-touch-cancel obj 'on-mouse-leave))
- (progn
- (set-on-mouse-move obj 'on-mouse-move)
- (set-on-mouse-up obj 'stop-obj-grab)
- (set-on-mouse-leave obj 'on-mouse-leave))))))))
+ (let ((app (connection-data-item obj "app-data")))
+ (with-sync-event (obj) ; Process one event at a time
+ (when (eq (drag-type app) :pointer) ; Prefer touch events to pointer events
+ (stop-tracking obj)) ; to accomidate mobile devices emulating mice
+ (setf (drag-type app) (getf data :event-type))
+ (let* ((mouse-x (getf data :screen-x)) ; Use the screen coordinates not
+ (mouse-y (getf data :screen-y)) ; the coordinates relative to the obj
+ (obj-top (parse-integer (top obj) :junk-allowed t))
+ (obj-left (parse-integer (left obj) :junk-allowed t)))
+ (setf (drag-x app) (- mouse-x obj-left))
+ (setf (drag-y app) (- mouse-y obj-top))
+ (cond ((eq (getf data :event-type) :touch)
+ (set-on-touch-move obj 'on-mouse-move)
+ (set-on-touch-end obj 'on-touch-end))
+ (t
+ (set-on-pointer-move obj 'on-mouse-move)
+ (set-on-pointer-up obj 'on-mouse-up)))))))
(defun on-mouse-move (obj data)
(let* ((app (connection-data-item obj "app-data"))
- (x (getf data :screen-x))
- (y (getf data :screen-y)))
+ (x (getf data :screen-x))
+ (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)
- (let ((app (connection-data-item obj "app-data")))
- (setf (in-drag-p app) nil)
- (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 on-mouse-up (obj data)
+ (declare (ignore data))
+ (stop-tracking obj))
-(defun stop-obj-grab (obj data)
- (on-mouse-move obj data)
- (on-mouse-leave obj))
+(defun on-touch-end (obj)
+ (stop-tracking 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))
- (div3 (create-div div2))
- (dir (create-div div1 :content "Click and drag the boxes")))
+ (div2 (create-div div1))
+ (div3 (create-div div2))
+ (dir (create-div div1 :content "Click and drag the boxes")))
;; 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)
- (set-on-mouse-down div3 'on-mouse-down)))
+ ;; Setup mouse/touch/pointer events
+ ;; 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."