From 49606b182073ebb618875cdeda00d988f8cb879b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jacek=20TeMPOraL=20Z=C5=82ydach?= <temporal.pl@gmail.com> Date: Sat, 3 Jun 2017 13:07:49 +0200 Subject: [PATCH] Resolved runtime issues w/ scroll panes. - provided the default (likely invalid in principle) for the missing argument in callback functions. - replaced references to missing slots with what's my best guess about their correct value (through accessors) + notes on the previous changes wrt. that fourth parameter to scroll-bar callbacks. --- silica/scroll-pane.lisp | 71 ++++++++++++++++++++++++----------------- 1 file changed, 42 insertions(+), 29 deletions(-) diff --git a/silica/scroll-pane.lisp b/silica/scroll-pane.lisp index 84e3bfeb..be5ecf92 100644 --- a/silica/scroll-pane.lisp +++ b/silica/scroll-pane.lisp @@ -250,34 +250,44 @@ ;;; - 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) - (with-slots (current-size current-value port) scroll-bar + ;; (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))) (with-slots (viewport contents) scroller-pane (let* ((contents-range (contents-range scroller-pane orientation)) (line-value (if (= contents-range 0) 0 (the single-float - (/ (line-scroll-amount scroller-pane orientation :up) - (float contents-range 0.0s0))))) + (/ (line-scroll-amount scroller-pane orientation :up) + (float contents-range 0.0s0))))) (new-value (max 0.0 (- current-value line-value)))) (scroll-bar-value-changed-callback - scroll-bar scroller-pane orientation new-value current-size))))) + scroll-bar scroller-pane orientation new-value current-size))))) (defmethod scroll-down-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) - (with-slots (current-size current-value port) scroll-bar + ;; (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))) (with-slots (viewport contents) scroller-pane (let* ((contents-range (contents-range scroller-pane orientation)) (line-value (if (= contents-range 0) 0 (the single-float - (/ (line-scroll-amount scroller-pane orientation :down) - (float contents-range 0.0s0))))) + (/ (line-scroll-amount scroller-pane orientation :down) + (float contents-range 0.0s0))))) (new-value (+ current-value line-value))) (scroll-bar-value-changed-callback - scroll-bar scroller-pane orientation new-value current-size))))) + scroll-bar scroller-pane orientation new-value current-size))))) (defmethod scroll-up-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) - (with-slots (current-size current-value) scroll-bar + ;; (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))) (with-slots (viewport contents) scroller-pane (let* ((contents-range (contents-range scroller-pane orientation)) (viewport-range (bounding-rectangle-max-y viewport)) @@ -285,33 +295,36 @@ (if (zerop contents-range) (setq new-value current-value) (let ((page-value (the single-float - (/ viewport-range (float contents-range 0.0s0))))) + (/ viewport-range (float contents-range 0.0s0))))) (setq new-value (max 0.0 (- current-value page-value))))) (scroll-bar-value-changed-callback - scroll-bar scroller-pane orientation new-value current-size))))) + scroll-bar scroller-pane orientation new-value current-size))))) (defmethod scroll-down-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) - (with-slots (current-size current-value) scroll-bar + ;; (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))) (with-slots (viewport contents) scroller-pane (let* ((contents-range (contents-range scroller-pane orientation)) (viewport-range (bounding-rectangle-max-y viewport)) new-value) - (if (zerop contents-range) - (setq new-value current-value) - (let ((page-value (the single-float - (/ viewport-range (float contents-range 0.0s0))))) - (setq new-value (+ current-value page-value)))) - (scroll-bar-value-changed-callback - scroll-bar scroller-pane orientation new-value current-size))))) + (if (zerop contents-range) + (setq new-value current-value) + (let ((page-value (the single-float + (/ viewport-range (float contents-range 0.0s0))))) + (setq new-value (+ current-value page-value)))) + (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) - (with-slots (current-size current-value) scroll-bar + ;; (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) - (with-slots (current-size current-value) scroll-bar - (scroll-bar-value-changed-callback - scroll-bar client id 1.0 current-size))) + ;; (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))) (defmethod scroll-line-to-top-callback ((scroll-bar scroll-bar-pane) scroller-pane id orientation x y) @@ -582,21 +595,21 @@ (#.+pointer-left-button+ (ecase (slot-value pane 'end) (:greater-than - (scroll-down-page-callback scroll-bar client id)) + (scroll-down-page-callback scroll-bar client id nil)) ;NOTE WORKAROUND added last param = nil -- jacek.zlydach, 2017-06-03 (:less-than - (scroll-down-line-callback scroll-bar client id)))) + (scroll-down-line-callback scroll-bar client id nil)))) ;NOTE WORKAROUND added last param = nil -- jacek.zlydach, 2017-06-03 (#.+pointer-middle-button+ (ecase (slot-value pane 'end) (:greater-than - (scroll-to-bottom-callback scroll-bar client id)) + (scroll-to-bottom-callback scroll-bar client id nil)) ;NOTE WORKAROUND added last param = nil -- jacek.zlydach, 2017-06-03 (:less-than - (scroll-to-top-callback scroll-bar client id)))) + (scroll-to-top-callback scroll-bar client id nil)))) ;NOTE WORKAROUND added last param = nil -- jacek.zlydach, 2017-06-03 (#.+pointer-right-button+ (ecase (slot-value pane 'end) (:greater-than - (scroll-up-page-callback scroll-bar client id)) + (scroll-up-page-callback scroll-bar client id nil)) ;NOTE WORKAROUND added last param = nil -- jacek.zlydach, 2017-06-03 (:less-than - (scroll-up-line-callback scroll-bar client id))))))) + (scroll-up-line-callback scroll-bar client id nil))))))) ;NOTE WORKAROUND added last param = nil -- jacek.zlydach, 2017-06-03 (defmethod handle-event ((pane scroll-bar-shaft-pane) (event pointer-button-press-event)) -- GitLab