;;; lisp file for xyzzy ver0.2.2.234
;;; scroll-page-mouse.l ver.0.0.1.6 // crayonzen [2023-02-21]17:50:36(+0900)

;// how-to: load
;//       : write in .xyzzy or siteinit.l
;(load-library "scroll-page-mouse")

;;;１：中央クリックボタンで画面をドラッグするとスクロールします。
;;;２：クリックでページダウン。Shiftキー＋クリックでページアップ。

;;;ウィンドウ分割で2画面以上になると「ホイールマウスに反応する」*support-mouse-wheel*の設定が
;;;マウスアップの#\MBtnUpで反応せずにデフォルトに戻らないためコメントアウトして修正。

(provide "scroll-page-mouse")

(in-package "editor")

(export '(scroll-page-mouse-press
	  scroll-page-mouse-motion
	  ;;scroll-page-mouse-up
	  next-page-mouse
	  previous-page-mouse
	  ))

(defvar *scroll-page* nil)
(defvar *last-line* nil)
(defvar *count-i* nil)
(defvar *tick* nil)
;;(defvar *default-support-mouse-wheel* nil)

;;速い　枠外でもスクロール可
(defun scroll-page-mouse-press ()
  (interactive)
  (stop-selection)
;;  (setq *default-support-mouse-wheel* *support-mouse-wheel*)
;;  (setq *support-mouse-wheel* nil)
  (setq *last-line* nil)
  (setq *scroll-page* nil)
  (if (eq (selected-window) *last-mouse-window*)
      (progn
	(setq *last-line* *last-mouse-line*)
	(setq *scroll-page* t)
	(setq *count-i* 0)
	(setq *tick* (get-internal-real-time))
	)
    (progn
      (set-window *last-mouse-window*)
      (cancel-mouse-event)))
  )

(defun scroll-page-mouse-motion ()
  (interactive)
  (setq *count-i* (+ *count-i* 1))
  (setq n (- *last-mouse-line* *last-line*))
  (setq *last-line* *last-mouse-line*)
  (progn
    (if (> n 0)
	(scroll-window 1))
    (if (< n 0)
	(scroll-window -1))

    (if (or (>= *count-i* 1)
	    (> n 0) (< n 0)
	    (< 300 (- (get-internal-real-time) *tick*)))
	(setq *scroll-page* nil))
    )
  )

#|
(defun scroll-page-mouse-up ()
  (interactive)
  (setq *support-mouse-wheel* *default-support-mouse-wheel*)
  )
|#

(defun next-page-mouse ()
  (interactive)
  (if (and (>= 400 (- (get-internal-real-time) *tick*))
	  *scroll-page*)
      (next-page))
  ;(setq *support-mouse-wheel* *default-support-mouse-wheel*)
  ;(message "tick: ~D" (- (get-internal-real-time) *tick*))
  )

(defun previous-page-mouse ()
  (interactive)
  (if (and (>= 400 (- (get-internal-real-time) *tick*))
	  *scroll-page*)
      (previous-page))
  ;(setq *support-mouse-wheel* *default-support-mouse-wheel*)
  )

;;  (message "Scroll ~S" n)

;;;中央クリックボタン（ホイール）に割り当て
(global-set-key #\MBtnDown 'scroll-page-mouse-press)
(global-set-key #\MBtnMove 'scroll-page-mouse-motion)
;;;(global-set-key #\MBtnUp 'scroll-page-mouse-up)
;(global-set-key #\MBtnUp 'next-page-mouse)
;(global-set-key #\S-MBtnDown 'scroll-page-mouse-press)
;(global-set-key #\S-MBtnUp 'previous-page-mouse)


#|
;;;右クリックボタンに割り当て
(global-set-key #\RBtnDown 'scroll-page-mouse-press)
(global-set-key #\S-RBtnDown 'scroll-page-mouse-press)
(global-set-key #\RBtnMove 'scroll-page-mouse-motion)
(global-set-key #\RBtnUp 'next-page-mouse)
(global-set-key #\S-RBtnUp 'previous-page-mouse)
|#

#|
;;;中央クリックボタン（ホイール）に右クリックの機能を割り当て
(global-set-key #\MBtnDown 'mouse-nop)
(global-set-key #\MBtnUp 'mouse-menu-popup)
|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;参考：デフォルト割り当て
;;(global-set-key #\RBtnDown 'mouse-nop)
;;(global-set-key #\RBtnUp 'mouse-menu-popup)
;;(global-set-key #\MBtnDown 'begin-auto-scroll)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;キーにセットされてる機能を解除する例
;(global-unset-key #\MBtnDown)
;(global-unset-key #\MBtnUp)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(defun mouse-nop ()
;;  (interactive)
;;  (continue-pre-selection))

;;scroll-window
;;scroll-window-horizontally

;;(*last-mouse-window* (selected-window))
;;(*last-mouse-line* (current-virtual-line-number))
;;(*last-mouse-column* (current-virtual-column))

#|
;;遅い　安定　枠外スクロールなし
(defun scroll-page-mouse-press ()
  (interactive)
  (stop-selection)
  (setq *last-line* nil)
  (setq *scroll-page* nil)
  (if (eq (selected-window) *last-mouse-window*)
      (progn
	(setq *last-line* *last-mouse-line*)
	(setq *scroll-page* t)
	(setq *count-i* 0)
	)
    (progn
      (set-window *last-mouse-window*)
      (cancel-mouse-event)))
  )

(defun scroll-page-mouse-motion ()
  (interactive)
  (setq *count-i* (+ *count-i* 1))
  (setq n (- *last-mouse-line* *last-line*))
  (if (= *count-i* 2)
      (progn
	(if (> n 0)
	    (scroll-window 1))
	(if (< n 0)
	    (scroll-window -1))
	(if (or (> n 0) (< n 0))
	    (setq *scroll-page* nil))
	(setq *count-i* 0)
	(setq *last-line* *last-mouse-line*)
	))
  )
|#
