;;; touchpad.el --- Scroll two dimensionally by touchpad

;; Copyright (C) 2017 Tak Kunihiro
;; Author: Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
;; Maintainer: Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
;; URL: http://dream.misasa.okayama-u.ac.jp
;; Package-Requires: ((emacs "26.1"))
;; Version: 1.0.0
;; Package-Version: 20170427.1515
;; Keywords: mouse, scroll

;;; This file is NOT part of GNU Emacs

;;; License

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.

;;; Commentary:

;; To interactively toggle the mode:
;;
;;   M-x touchpad-mode
;;
;; To make the mode permanent, add the following lines to your init
;; file.
;;
;;   (require 'touchpad)
;;   (touchpad-mode 1)
;;
;; This package offers a global minor mode which makes swiping
;; touchpad scroll smoothly.  This package disables
;; `auto-hscroll-mode' during scroll because of following two aspects.

;; (1) It should be off during vertical scroll.  Let¢s consider a
;;     buffer is with short and long alternative lines and when point
;;     is at the end of long line, at the top of current window.
;;     After `scroll-up 1', point jumps to the end of the next short
;;     line and you see scope shifts suddenly leftward.  This behavior
;;     is sometimes unexpected one.

;; (2) It should be off during horizontal scroll.  During horizontal
;;     scroll, you may scroll a little in vertical direction without
;;     intention.  The horizontal scroll should be tolerance against
;;     such perturbation.  The source of concern is same as (1).

;; After scroll, you want to set `auto-hscroll-mode' back again
;; otherwise too inconvenient for further edition.  Approach of this
;; package is to turn on another minor-mode `touchpad--2d-mode' with
;; `auto-hscroll-mode' nil at the beginning of `mwheel-scroll'.  The
;; minor mode is turned off upon any key inputs that move point.

;;; Change Log:

;; 20170409.1204
;;  - (setq scroll-conservatively 100) on minor mode may work as backup

;;; Todo:
;;  - Release as a package

(require 'mwheel)

;;; Code:
(defvar touchpad--cursor-type cursor-type
  "Cursor used by user.  This variable is used internally to
  restore original `cursor-type'.")

(define-minor-mode touchpad-mode
  "A minor mode to scroll text two dimensionally.  With a prefix argument ARG,
enable Touchpad Mode if ARG is positive, and disable it
otherwise.  If called from Lisp, enable Touchpad Mode if ARG is
omitted or nil."
  :init-value nil
  :group 'scrolling
  :global t

  (if touchpad-mode
      (progn
        (advice-add 'mwheel-scroll :before 'touchpad-enable--2d-mode)
        ;; (add-hook 'mwheel-pre-scroll-hook 'touchpad-enable--2d-mode)
        (setq mwheel-tilt-scroll-p t))
    (advice-remove 'mwheel-scroll #'touchpad-enable--2d-mode)
    ;; (remove-hook 'mwheel-pre-scroll-hook 'touchpad-enable--2d-mode)
    (dolist (var '(mwheel-tilt-scroll-p))
      (custom-reevaluate-setting var))))

;; (defun touchpad-enable--2d-mode ()
;;   "Enable minor mode `touchpad--2d-mode' to disable
;; `auto-hscroll-mode'.  This is supposed to be called before actual
;; scrolling."
;;   (let ((buffer (window-buffer (mwheel-event-window last-input-event))))
;;     (with-current-buffer buffer
;;       (touchpad--2d-mode 1)))) ; turn on minor-mode

(defun touchpad-enable--2d-mode (func &rest args)
  "Enable minor mode `touchpad--2d-mode' to disable
`auto-hscroll-mode'.  This is supposed to be adviced before
`mwheel-scroll'."
  (let ((buffer (window-buffer (mwheel-event-window last-input-event))))
    (with-current-buffer buffer
      (touchpad--2d-mode 1)))) ; turn on minor-mode

(defun touchpad-disable--2d-mode ()
  "Disable minor mode `touchpad--2d-mode' to enable
`auto-hscroll-mode' back.  Then invoke command that is bound to
the original key."
  (interactive)
  (touchpad--2d-mode 0) ; turn off minor-mode
  (call-interactively (key-binding (this-command-keys))))

(define-minor-mode touchpad--2d-mode
  "A minor-mode with `auto-hscroll-mode' off.  This minor mode is used
internally."
  :init-value nil
  :keymap (let ((map (make-sparse-keymap)))
            (define-key map [remap keyboard-quit] 'touchpad-disable--2d-mode)
            (define-key map [remap mouse-set-point] 'touchpad-disable--2d-mode)
            (define-key map [remap right-char] 'touchpad-disable--2d-mode)
            (define-key map [remap forward-char] 'touchpad-disable--2d-mode)
            (define-key map [remap forward-word] 'touchpad-disable--2d-mode)
            (define-key map [remap forward-sentence] 'touchpad-disable--2d-mode)
            (define-key map [remap forward-paragraph] 'touchpad-disable--2d-mode)
            (define-key map [remap forward-page] 'touchpad-disable--2d-mode)
            (define-key map [remap left-char] 'touchpad-disable--2d-mode)
            (define-key map [remap backward-char] 'touchpad-disable--2d-mode)
            (define-key map [remap backward-word] 'touchpad-disable--2d-mode)
            (define-key map [remap backward-sentence] 'touchpad-disable--2d-mode)
            (define-key map [remap backward-paragraph] 'touchpad-disable--2d-mode)
            (define-key map [remap backward-page] 'touchpad-disable--2d-mode)
            (define-key map [remap move-beginning-of-line] 'touchpad-disable--2d-mode)
            (define-key map [remap move-end-of-line] 'touchpad-disable--2d-mode)
            (define-key map [remap next-line] 'touchpad-disable--2d-mode)
            (define-key map [remap next-error] 'touchpad-disable--2d-mode)
            (define-key map [remap scroll-up-command] 'touchpad-disable--2d-mode)
            (define-key map [remap previous-line] 'touchpad-disable--2d-mode)
            (define-key map [remap previous-error] 'touchpad-disable--2d-mode)
            (define-key map [remap scroll-down-command] 'touchpad-disable--2d-mode)
            (define-key map [remap beginning-of-defun] 'touchpad-disable--2d-mode)
            (define-key map [remap beginning-of-buffer] 'touchpad-disable--2d-mode)
            (define-key map [remap end-of-defun] 'touchpad-disable--2d-mode)
            (define-key map [remap end-of-buffer] 'touchpad-disable--2d-mode)
            (define-key map [remap goto-char] 'touchpad-disable--2d-mode)
            (define-key map [remap goto-line] 'touchpad-disable--2d-mode)
            (define-key map [remap move-to-column] 'touchpad-disable--2d-mode)
            ;; list as much as think of ... or map all but
            ;; (where-is-internal 'mwheel-scroll)?
            map)
  :group 'scrolling

  (if touchpad--2d-mode
      (progn
        (setq-local auto-hscroll-mode nil)
        (setq-local cursor-type 'hollow))
    (setq-local auto-hscroll-mode t)
    (setq-local cursor-type touchpad--cursor-type)))

(provide 'touchpad)
;;; touchpad.el ends here