diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp index f37b6feffbe5a298c9b538b8c1c549a5d4b7e286..536f67da87ca9b9b868a3232b48bcec24f8839e8 100644 --- a/silica/gadgets.lisp +++ b/silica/gadgets.lisp @@ -67,6 +67,33 @@ (defmethod note-gadget-deactivated ((client t) (gadget basic-gadget)) nil) + + +;;; defgenerics for callbacks. +;;; Added by jacek.zlydach on 2017-07-30. +;;; NOTE: There's some discrepancy between the code here and CLIM spec - the latter +;;; defines following callbacks as 3-argument generic functions. To resolve it, +;;; the fourth argument, used by this implementation, has been marked optional. + +(defgeneric scroll-to-bottom-callback (pane client id &optional value) + (:documentation "Invoked when appropriate hotspot of a scroll bar is clicked on.")) + +(defgeneric scroll-to-top-callback (pane client id &optional value) + (:documentation "Invoked when appropriate hotspot of a scroll bar is clicked on.")) + +(defgeneric scroll-up-line-callback (pane client id &optional value) + (:documentation "Invoked when appropriate hotspot of a scroll bar is clicked on.")) + +(defgeneric scroll-down-line-callback (pane client id &optional value) + (:documentation "Invoked when appropriate hotspot of a scroll bar is clicked on.")) + +(defgeneric scroll-up-page-callback (pane client id &optional value) + (:documentation "Invoked when appropriate hotspot of a scroll bar is clicked on.")) + +(defgeneric scroll-down-page-callback (pane client id &optional value) + (:documentation "Invoked when appropriate hotspot of a scroll bar is clicked on.")) + + ;;; Value Gadgets @@ -399,32 +426,32 @@ ;;; Here are the callbacks that were once called out in the CLIM spec: -(defmethod scroll-to-bottom-callback ((pane scroll-bar) client id value) +(defmethod scroll-to-bottom-callback ((pane scroll-bar) client id &optional value) ;TODO some sane default value? -- jacek.zlydach 2017-07-30 (value-changed-callback pane client id value) (let ((callback (scroll-bar-scroll-to-bottom-callback pane))) (when callback (funcall callback pane)))) -(defmethod scroll-to-top-callback ((pane scroll-bar) client id value) +(defmethod scroll-to-top-callback ((pane scroll-bar) client id &optional value) ;TODO some sane default value? -- jacek.zlydach 2017-07-30 (value-changed-callback pane client id value) (let ((callback (scroll-bar-scroll-to-top-callback pane))) (when callback (funcall callback pane)))) -(defmethod scroll-up-line-callback ((pane scroll-bar) client id value) +(defmethod scroll-up-line-callback ((pane scroll-bar) client id &optional value) ;TODO some sane default value? -- jacek.zlydach 2017-07-30 (value-changed-callback pane client id value) (let ((callback (scroll-bar-scroll-up-line-callback pane))) (when callback (funcall callback pane)))) -(defmethod scroll-down-line-callback ((pane scroll-bar) client id value) +(defmethod scroll-down-line-callback ((pane scroll-bar) client id &optional value) ;TODO some sane default value? -- jacek.zlydach 2017-07-30 (value-changed-callback pane client id value) (let ((callback (scroll-bar-scroll-down-line-callback pane))) (when callback (funcall callback pane)))) -(defmethod scroll-up-page-callback ((pane scroll-bar) client id value) +(defmethod scroll-up-page-callback ((pane scroll-bar) client id &optional value) ;TODO some sane default value? -- jacek.zlydach 2017-07-30 (value-changed-callback pane client id value) (let ((callback (scroll-bar-scroll-up-page-callback pane))) (when callback (funcall callback pane)))) -(defmethod scroll-down-page-callback ((pane scroll-bar) client id value) +(defmethod scroll-down-page-callback ((pane scroll-bar) client id &optional value) ;TODO some sane default value? -- jacek.zlydach 2017-07-30 (value-changed-callback pane client id value) (let ((callback (scroll-bar-scroll-down-page-callback pane))) (when callback (funcall callback pane)))) diff --git a/silica/scroll-pane.lisp b/silica/scroll-pane.lisp index ffdc18e2d787ea8a8852e7ea2c2a954cc8675a89..b10b1a278a99d0ee5defe2513a9dce65534bcf4f 100644 --- a/silica/scroll-pane.lisp +++ b/silica/scroll-pane.lisp @@ -239,22 +239,9 @@ (:horizontal (- right left)) (:vertical (- bottom top)))))) -;;; NOTE WORKAROUND -;;; The following methods requires 4 parameters. Added `workaround' parameter for that, -;;; but the methods should be further reviewed for correctness. -;;; - scroll-up-line-callback -;;; - scroll-down-line-callback -;;; - scroll-up-page-callback -;;; - scroll-down-page-callback -;;; - scroll-to-top-callback -;;; - scroll-to-bottom-callback -;;; -;;; -- jacek.zlydach 2017-05-14 -;;; -;;; Also NOTE that the CLIM docs seem to require those methods to have 3 arguments instead. -;;; -;;; -- jacek.zlydach 2017-06-03 -(defmethod scroll-up-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) +;;; FIXME scroller-pane, orientation don't match expected: client, gadget-id -- jacek.zlydach 2017-07-30 +(defmethod scroll-up-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation &optional value) + (declare (ignore value)) ;; (with-slots (current-size current-value port) scroll-bar) -- NOTE those slots don't exist. -- jacek.zlydach 2017-06-03 (let ((current-size (scroll-bar-size scroll-bar)) (current-value (gadget-value scroll-bar))) @@ -269,7 +256,9 @@ (scroll-bar-value-changed-callback scroll-bar scroller-pane orientation new-value current-size))))) -(defmethod scroll-down-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) +;;; FIXME scroller-pane, orientation don't match expected: client, gadget-id -- jacek.zlydach 2017-07-30 +(defmethod scroll-down-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation &optional value) + (declare (ignore value)) ;; (with-slots (current-size current-value port) scroll-bar) -- NOTE those slots don't exist. -- jacek.zlydach 2017-06-03 (let ((current-size (scroll-bar-size scroll-bar)) (current-value (gadget-value scroll-bar))) @@ -284,7 +273,9 @@ (scroll-bar-value-changed-callback scroll-bar scroller-pane orientation new-value current-size))))) -(defmethod scroll-up-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) +;;; FIXME scroller-pane, orientation don't match expected: client, gadget-id -- jacek.zlydach 2017-07-30 +(defmethod scroll-up-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation &optional value) + (declare (ignore value)) ;; (with-slots (current-size current-value) scroll-bar) -- NOTE those slots don't exist. -- jacek.zlydach 2017-06-03 (let ((current-size (scroll-bar-size scroll-bar)) (current-value (gadget-value scroll-bar))) @@ -300,7 +291,9 @@ (scroll-bar-value-changed-callback scroll-bar scroller-pane orientation new-value current-size))))) -(defmethod scroll-down-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) +;;; FIXME scroller-pane, orientation don't match expected: client, gadget-id -- jacek.zlydach 2017-07-30 +(defmethod scroll-down-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation &optional value) + (declare (ignore value)) ;; (with-slots (current-size current-value) scroll-bar) -- NOTE those slots don't exist. -- jacek.zlydach 2017-06-03 (let ((current-size (scroll-bar-size scroll-bar)) (current-value (gadget-value scroll-bar))) @@ -316,12 +309,16 @@ (scroll-bar-value-changed-callback scroll-bar scroller-pane orientation new-value current-size))))) -(defmethod scroll-to-top-callback ((scroll-bar scroll-bar-pane) client id whatever) +;;; FIXME scroller-pane, orientation don't match expected: client, gadget-id -- jacek.zlydach 2017-07-30 +(defmethod scroll-to-top-callback ((scroll-bar scroll-bar-pane) client id &optional value) + (declare (ignore value)) ;; (with-slots (current-size current-value) scroll-bar) -- NOTE those slots don't exist. -- jacek.zlydach 2017-06-03 (let ((current-size (scroll-bar-size scroll-bar))) (scroll-bar-value-changed-callback scroll-bar client id 0 current-size))) -(defmethod scroll-to-bottom-callback ((scroll-bar scroll-bar-pane) client id whatever) +;;; FIXME scroller-pane, orientation don't match expected: client, gadget-id -- jacek.zlydach 2017-07-30 +(defmethod scroll-to-bottom-callback ((scroll-bar scroll-bar-pane) client id &optional value) + (declare (ignore value)) ;; (with-slots (current-size current-value) scroll-bar) -- NOTE those slots don't exist. -- jacek.zlydach 2017-06-03 (let ((current-size (scroll-bar-size scroll-bar))) (scroll-bar-value-changed-callback scroll-bar client id 1.0 current-size))) @@ -601,21 +598,21 @@ (#.+pointer-left-button+ (ecase (slot-value pane 'end) (:greater-than - (scroll-down-page-callback scroll-bar client id 0.0)) ;NOTE WORKAROUND added last param = 0.0 -- jacek.zlydach, 2017-06-03 + (scroll-down-page-callback scroll-bar client id)) (:less-than - (scroll-down-line-callback scroll-bar client id 0.0)))) ;NOTE WORKAROUND added last param = 0.0 -- jacek.zlydach, 2017-06-03 + (scroll-down-line-callback scroll-bar client id)))) (#.+pointer-middle-button+ (ecase (slot-value pane 'end) (:greater-than - (scroll-to-bottom-callback scroll-bar client id 0.0)) ;NOTE WORKAROUND added last param = 0.0 -- jacek.zlydach, 2017-06-03 + (scroll-to-bottom-callback scroll-bar client id)) (:less-than - (scroll-to-top-callback scroll-bar client id 0.0)))) ;NOTE WORKAROUND added last param = 0.0 -- jacek.zlydach, 2017-06-03 + (scroll-to-top-callback scroll-bar client id)))) (#.+pointer-right-button+ (ecase (slot-value pane 'end) (:greater-than - (scroll-up-page-callback scroll-bar client id 0.0)) ;NOTE WORKAROUND added last param = 0.0 -- jacek.zlydach, 2017-06-03 + (scroll-up-page-callback scroll-bar client id)) (:less-than - (scroll-up-line-callback scroll-bar client id 0.0))))))) ;NOTE WORKAROUND added last param = 0.0 -- jacek.zlydach, 2017-06-03 + (scroll-up-line-callback scroll-bar client id))))))) (defmethod handle-event ((pane scroll-bar-shaft-pane) (event pointer-button-press-event))