<commit_before>
(in-package :beagle)


;;;(defclass beagle-scroll-bar-pane (scroll-bar)
(defclass beagle-scroll-bar-pane (scroll-bar-pane)
  ((tk-obj :initform (%null-ptr) :accessor toolkit-object)))


(defmethod initialize-instance :after ((sb beagle-scroll-bar-pane) &rest args)
  (declare (ignore args))
  sb)


(defmethod realize-mirror ((port beagle-port)
			   (sheet beagle-scroll-bar-pane))
  ;; How do we construct one of these puppies so it looks right, is the
  ;; correct orientation, etc.? Cocoa docs are a little lacking in this
  ;; regard.
  ;; Orientation is defined by the longer relative dimension; if
  ;; maxx-minx > maxy - miny, we will get a :horizontal bar; otherwise
  ;; we get a vertical bar.
  ;; Use 'init with frame'?
  (let* ((q (compose-space sheet))
	 (rect (ccl::make-ns-rect 0.0
				  0.0
				  (space-requirement-width q)
				  (space-requirement-height q)))
	 (mirror (make-instance 'lisp-scroller :with-frame rect))
	 ;; Not sure if this is sufficient...
	 (action-mask (logior #$NSLeftMouseDown
			      #$NSScrollWheel)))
    (send mirror 'retain)
    ;; Scrollers are disabled by default; enable it (otherwise the
    ;; lozenge and buttons are not displayed).
    (send mirror :set-enabled #$YES)
    ;; Make knob fill pane initially.
    (send mirror :set-float-value 0.0 :knob-proportion 1.0)
    (setf (toolkit-object sheet) mirror)
    (setf (view-lisp-scroller mirror) sheet)

    ;; In this implementation, native scroll bars don't respond to events;
    ;; Cocoa handles all that for us. We set them up to handle _actions_
    ;; instead (analagous to callbacks). Set the target (recipient of
    ;; actions) to be the scroll bar itself (i.e. the same object that
    ;; 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)
    (send mirror :send-action-on action-mask)
    ;; We want continuous actions when we can get them...
    (send mirror :set-continuous #$YES)
    (send mirror :set-action (ccl::@selector "takeAction:"))

    (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)
    (#_free rect)
    mirror))


(defmethod handle-repaint :around ((pane beagle-scroll-bar-pane) region)
  (declare (ignore region))
  ;; send a 'mark view dirty' message so it will be redrawn at the right
  ;; time.
  (send (toolkit-object pane) 'set-needs-display))


(defmethod compose-space ((sb beagle-scroll-bar-pane) &key width height)
  (declare (ignore width height))
  (let ((width (send (@class ns-scroller)
		     :scroller-width-for-control-size
		     #$NSRegularControlSize)))
    ;; For vertical scroll bars, ensure y > x. For horizontal, ensure
    ;; x > y.
    (if (eq (gadget-orientation sb) :vertical)
	(make-space-requirement :min-width width
				:width     width
				:min-height (* 3 width)
				:height (* 4 width))
      (make-space-requirement :min-width (* 3 width)
			      :width (* 4 width)
			      :min-height width
			      :height width))))


;;; No need to update the scrollbar (most of the time) since Cocoa will move
;;; the 'thumb' appropriately. Stick some debug in to see when it's invoked.
;;; As expected, this is invoked all the time; also, the calculation below
;;; is wrong since the view coords are flipped for cocoa (scroll-bar moves
;;; the wrong way!)

;;; I believe it's safe to leave this alone though (other than the backwards
;;; behaviour) since the sb will only be redrawn once through the event loop
;;; it shouldn't be too inefficient to be changing its value regularly.
(defmethod (setf gadget-value) :before (value (gadget beagle-scroll-bar-pane)
					      &key invoke-callback)
  (declare (ignore invoke-callback))

  ;; (- gadget-max-value gadget-min-value) = range.
  ;; height (or width) of scrollbar        = proportional SIZE of lozenge.
  ;; value                                 = proportional POSITION of lozenge

  (let* ((range (- (gadget-max-value gadget) (gadget-min-value gadget)))
	 (size  (if (eq (gadget-orientation gadget) :vertical)
		    (bounding-rectangle-height gadget)
		  (bounding-rectangle-width gadget)))
	 (position (if (<= range 0)
		       0.0
		     (/ value range)))
	 (loz-size (if (<= range 0)
		       1.0
		     (/ size range))))
    (send (toolkit-object gadget)
	  :set-float-value (coerce position 'short-float)
	  :knob-proportion (coerce loz-size 'short-float))))

(defun action-handler (pane sender)
  (format *trace-output* "Got action to handle of ~a on pane ~a~%" sender pane)
  ;; Now we need to decide exactly what we do with these events... not sure
  ;; if this is the right way to invoke the callbacks... shouldn't
  ;; '(scroll-bar-scroll-up-line-callback sb)' come into it somewhere? Hmmm.

  ;; Note: because the coords are all over the place, to make these work nicely
  ;; with non-aqua panes, we reverse the 'up' and 'down' actions. I'm not
  ;; convinced this is actually a good idea, but until flipped coords are gone,
  ;; it'll have to do (how a full NSScrollView would work might be interesting).

  (let ((hit-part (send sender 'hit-part)))
    (cond ((eq hit-part #$NSScrollerKnob)   ; drag knob
	   (format *trace-output* "Action was NSScrollerKnob~%")
	   ;; Invoke '(drag-callback bar client id value)'
	   )
	  ((eq hit-part #$NSScrollerKnobSlot)   ; click on knob (or alt-click on slot)
	   (format *trace-output* "Action was NSScrollerKnobSlot~%")
	   ;; Invoke '(drag-callback bar client id value)'
	   )
	  ((eq hit-part #$NSScrollerDecrementLine)
	   (format *trace-output* "Action was NSScrollerDecrementLine~%")
	   (clim:scroll-down-line-callback pane (gadget-client pane) (gadget-id pane)))
	  ((eq hit-part #$NSScrollerDecrementPage)
	   (format *trace-output* "Action was NSScrollerDecrementPage~%")
	   (clim:scroll-down-page-callback pane (gadget-client pane) (gadget-id pane)))
	  ((eq hit-part #$NSScrollerIncrementLine)
	   (format *trace-output* "Action was NSScrollerIncrementLine~%")
	   (clim:scroll-up-line-callback pane (gadget-client pane) (gadget-id pane)))
	  ((eq hit-part #$NSScrollerIncrementPage)
	   (format *trace-output* "Action was NSScrollerIncrementPage~%")
	   (clim:scroll-up-page-callback pane (gadget-client pane) (gadget-id pane)))
	  ((eq hit-part #$NSScrollerNoPart)
	   (format *trace-output* "Action was NSScrollerNoPart~%"))
	  (t (format *trace-output* "Unknown action~%"))))

  )

<commit_msg>Fixed the invert problem (clicking on the up arrow moved the scroll bar thumb down); 'up-line' (in McCLIM) and 'increment-line' (in Cocoa) do the exact opposite of each other.<commit_after>
(in-package :beagle)


;;;(defclass beagle-scroll-bar-pane (scroll-bar)
(defclass beagle-scroll-bar-pane (scroll-bar-pane)
  ((tk-obj :initform (%null-ptr) :accessor toolkit-object)))


(defmethod initialize-instance :after ((sb beagle-scroll-bar-pane) &rest args)
  (declare (ignore args))
  sb)


(defmethod realize-mirror ((port beagle-port)
			   (sheet beagle-scroll-bar-pane))
  ;; How do we construct one of these puppies so it looks right, is the
  ;; correct orientation, etc.? Cocoa docs are a little lacking in this
  ;; regard.
  ;; Orientation is defined by the longer relative dimension; if
  ;; maxx-minx > maxy - miny, we will get a :horizontal bar; otherwise
  ;; we get a vertical bar.
  ;; Use 'init with frame'?
  (let* ((q (compose-space sheet))
	 (rect (ccl::make-ns-rect 0.0
				  0.0
				  (space-requirement-width q)
				  (space-requirement-height q)))
	 (mirror (make-instance 'lisp-scroller :with-frame rect))
	 ;; Not sure if this is sufficient...
	 #+nil
	 (action-mask (logior #$NSLeftMouseDown
			      #$NSScrollWheel)))
    (send mirror 'retain)
    ;; Scrollers are disabled by default; enable it (otherwise the
    ;; lozenge and buttons are not displayed).
    (send mirror :set-enabled #$YES)
    ;; Make knob fill pane initially.
    (send mirror :set-float-value 0.0 :knob-proportion 1.0)
    (setf (toolkit-object sheet) mirror)
    (setf (view-lisp-scroller mirror) sheet)

    ;; In this implementation, native scroll bars don't respond to events;
    ;; Cocoa handles all that for us. We set them up to handle _actions_
    ;; instead (analagous to callbacks). Set the target (recipient of
    ;; actions) to be the scroll bar itself (i.e. the same object that
    ;; 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)
;;;    (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 :set-action (ccl::@selector "takeScrollerAction:"))

    (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)
    (#_free rect)
    mirror))


(defmethod handle-repaint :around ((pane beagle-scroll-bar-pane) region)
  (declare (ignore region))
  ;; send a 'mark view dirty' message so it will be redrawn at the right
  ;; time.
  (send (toolkit-object pane) 'set-needs-display))


(defmethod compose-space ((sb beagle-scroll-bar-pane) &key width height)
  (declare (ignore width height))
  (let ((width (send (@class ns-scroller)
		     :scroller-width-for-control-size
		     #$NSRegularControlSize)))
    ;; For vertical scroll bars, ensure y > x. For horizontal, ensure
    ;; x > y.
    (if (eq (gadget-orientation sb) :vertical)
	(make-space-requirement :min-width width
				:width     width
				:min-height (* 3 width)
				:height (* 4 width))
      (make-space-requirement :min-width (* 3 width)
			      :width (* 4 width)
			      :min-height width
			      :height width))))


;;; No need to update the scrollbar (most of the time) since Cocoa will move
;;; the 'thumb' appropriately. Stick some debug in to see when it's invoked.
;;; => As expected, this is invoked all the time.

;;; I believe it's safe to leave this alone though since the sb will only be
;;; redrawn once through the event loop it shouldn't be too inefficient to
;;; be changing its value regularly.
(defmethod (setf gadget-value) :before (value (gadget beagle-scroll-bar-pane)
					      &key invoke-callback)
  (declare (ignore invoke-callback))

  ;; (- gadget-max-value gadget-min-value) = range.
  ;; height (or width) of scrollbar        = proportional SIZE of lozenge.
  ;; value                                 = proportional POSITION of lozenge

  (let* ((range (- (gadget-max-value gadget)
		   (gadget-min-value gadget)))
	 (size  (if (eq (gadget-orientation gadget) :vertical)
		    (bounding-rectangle-height gadget)
		  (bounding-rectangle-width gadget)))
	 (position (if (<= range 0)
		       0.0
		     (/ value range)))
	 (loz-size (if (<= range 0)
		       1.0
		     (/ size range))))
    (send (toolkit-object gadget)
	  :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
  ;; if this is the right way to invoke the callbacks... shouldn't
  ;; '(scroll-bar-scroll-up-line-callback sb)' come into it somewhere? Hmmm.

  ;; Note: because the coords are all over the place, to make these work nicely
  ;; with non-aqua panes, we reverse the 'up' and 'down' actions.

  ;; I actually think now that McCLIM + Cocoa have a different idea of what
  ;; increment / up and decrement / down mean; or I have misunderstood things
  ;; 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)
    (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))
	  ((eq hit-part #$NSScrollerDecrementLine)
	   #+nil
	   (format *trace-output* "Action was NSScrollerDecrementLine~%")
	   (clim:scroll-up-line-callback pane
					 (gadget-client pane)
					 (gadget-id pane)))
	  ((eq hit-part #$NSScrollerDecrementPage)
	   #+nil
	   (format *trace-output* "Action was NSScrollerDecrementPage~%")
	   (clim:scroll-up-page-callback pane
					 (gadget-client pane)
					 (gadget-id pane)))
	  ((eq hit-part #$NSScrollerIncrementLine)
	   #+nil
	   (format *trace-output* "Action was NSScrollerIncrementLine~%")
	   (clim:scroll-down-line-callback pane
					   (gadget-client pane)
					   (gadget-id pane)))
	  ((eq hit-part #$NSScrollerIncrementPage)
	   #+nil
	   (format *trace-output* "Action was NSScrollerIncrementPage~%")
	   (clim:scroll-down-page-callback pane
					   (gadget-client pane)
					   (gadget-id pane))))))



{'fraction_non_alphanumeric': 0.12582291589614616, 'fraction_numerical': 0.0031067386641023746, 'mean_word_length': 3.225, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1458718', 'n_tokens_mistral': 4743, 'n_tokens_neox': 4279, 'n_words': 1482}