[mcclim-cvs] CVS update: mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp

[Duncan Rose]

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes
In directory common-lisp.net:/tmp/cvs-serv4648/beagle/native-panes

Modified Files:
	beagle-scroll-bar-pane.lisp 
Log Message:
Add NSScroller subclass (lisp-scroller) which I forgot to add previously;
remove some native scroll bar set-up that was performed implicitly
by Cocoa anyway.

Date: Fri Jun 10 00:42:32 2005
Author: drose

Index: mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp
diff -u mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.3 mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.4
--- mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp:1.3	Thu Jun  9 01:20:15 2005
+++ mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp	Fri Jun 10 00:42:32 2005
@@ -47,15 +47,24 @@
     ;; generates the actions). Not sure if this is a good architectural
     ;; decision or not...
     (send mirror :set-target mirror)
-    ;; Also need to specify when an action is sent (i.e. which actions
-    ;; result in an action being posted)
+
+;;;    Don't need to do the following... these are the defaults for
+;;;    NSScroller anyway.
+
+;;;    ;; Also need to specify when an action is sent (i.e. which actions
+;;;    ;; result in an action being posted)
 ;;;    (send mirror :send-action-on action-mask)
-    (send mirror :send-action-on #$NSScrollWheelMask)
-    ;; We want continuous actions when we can get them...
-    (send mirror :set-continuous #$YES)
+;;;    (send mirror :send-action-on #$NSScrollWheelMask)
+;;;    ;; We want continuous actions when we can get them...
+;;;    (send mirror :set-continuous #$YES)
+
     (send mirror :set-action (ccl::@selector "takeScrollerAction:"))
 
-    (setf (view-event-mask mirror) +ignores-events+)
+    ;; We ignore event masks etc. altogether; most things we would be
+    ;; interested in are handled as actions, and any other event we
+    ;; take any notice of, we're interested in (scroll wheel events).
+;;;    (setf (view-event-mask mirror) +ignores-events+)
+
     (port-register-mirror (port sheet) sheet mirror)
     (%beagle-mirror->sheet-assoc port mirror sheet)
     (send (sheet-mirror (sheet-parent sheet)) :add-subview mirror)
@@ -118,6 +127,7 @@
 	  :set-float-value (coerce position 'short-float)
 	  :knob-proportion (coerce loz-size 'short-float))))
 
+
 (defun action-handler (pane sender)
 
   ;; Now we need to decide exactly what we do with these events... not sure
@@ -132,18 +142,19 @@
   ;; which wouldn't suprise me... perhaps it's reasonable that 'up line' and
   ;; 'decrement line' are the same thing.
 
-  (let ((hit-part (send sender 'hit-part))
-	(value    (* (send sender 'float-value)    ; 0.0 - 1.0
-		     (- (gadget-max-value pane)    ; range of bar; 0.0 -> max extent ...
-			(gadget-min-value pane))))); ... (probably)
+  (let ((hit-part (send sender 'hit-part)))
     (cond ((or (eq hit-part #$NSScrollerKnob)      ; drag knob
 	       (eq hit-part #$NSScrollerKnobSlot)) ; click on knob (or alt-click on slot)
-	   #+nil
-	   (format *trace-output* "Action was NSScrollerKnob/Slot, value = ~a~%" value)
-	   (clim:drag-callback pane
-			       (gadget-client pane)
-			       (gadget-id pane)
-			       value))
+	   (let ((value    (* (send sender 'float-value) ; 0.0 - 1.0
+			      (- (gadget-max-value pane) ; range; 0.0 -> max extent ...
+				 (gadget-min-value pane)))))  ; ... (probably)
+
+	     #+nil
+	     (format *trace-output* "Action was NSScrollerKnob/Slot, value = ~a~%" value)
+	     (clim:drag-callback pane
+				 (gadget-client pane)
+				 (gadget-id pane)
+				 value)))
 	  ((eq hit-part #$NSScrollerDecrementLine)
 	   #+nil
 	   (format *trace-output* "Action was NSScrollerDecrementLine~%")