;;; -*- lexical-binding: t -*-
;;
;; this file:
;;   https://dataswamp.org/~incal/emacs-init/scroll.el

(require 'cl-lib)

;; civilized scrolling - one line at a time

(setq scroll-conservatively 10000)
(setq auto-window-vscroll nil)

;; scroll current window

(defun scroll-up-1 ()
  (interactive)
  (scroll-down 1) )

(defun scroll-down-1 ()
  (interactive)
  (scroll-up 1) )

;; scroll-o-matic

(defun start-automatic-scroll-down ()
  (interactive)
  (let ((win))
    (cl-loop do
      (setq win (window-end))
      (scroll-down-1)
      (sleep-for 1) ; put speed here in seconds
      (redisplay)
      until (= win (window-end)) )))

;; (start-automatic-scroll-down)
;;                              ^ test here, C-g to stop

;; scroll other window

(defun scroll-up-other-window ()
  (interactive)
  (scroll-other-window-down 1) )

(defun scroll-down-other-window ()
  (interactive)
  (scroll-other-window 1) )

;; pane scroll

(defun get-window-lines ()
  (let*((edges  (window-inside-edges))
        (top    (nth 1 edges))
        (bottom (nth 3 edges))
        (lines  (- bottom top)) )
    (if (member major-mode '(Buffer-menu-mode package-menu-mode w3m-mode))
        (1- lines)
      lines) ))

(defun scroll-up-pane ()
  (interactive)
  (condition-case nil
      (or (scroll-down (get-window-lines)) t)
    (error nil) ))

(defun scroll-down-pane ()
  (interactive)
  (condition-case nil
      (or (scroll-up (get-window-lines)) t)
    (error nil) ))

;; horizontal scroll

(put 'scroll-left  'disabled nil)
(put 'scroll-right 'disabled nil)

(setq hscroll-margin 1)
(setq hscroll-step   1)

(defun scroll-left-1 ()
  (interactive)
  (scroll-right 1 0) )

(defun scroll-right-1 ()
  (interactive)
  (scroll-left 1 0) )

;; keys

(defun set-pane-scroll-keys (kmap)
  "Set KMAP keys for vertical scrolling in panes."
  (keymap-set kmap "I" #'scroll-up-pane)
  (keymap-set kmap "K" #'scroll-down-pane) )

(defun set-scroll-keys (kmap &optional horizontally)
  "Set KMAP keys for scrolling, vertically and HORIZONTALLY.
Also invoke `set-pane-scroll-keys'."
  (when horizontally
    (keymap-set kmap "j" #'scroll-left-1)
    (keymap-set kmap "l" #'scroll-right-1) )
  (keymap-set kmap "i"   #'scroll-up-1)
  (keymap-set kmap "M-i" #'scroll-up-1)
  (keymap-set kmap "k"   #'scroll-down-1)
  (keymap-set kmap "M-k" #'scroll-down-1)
  (set-pane-scroll-keys kmap) )

(defun set-vertical-keys (kmap &optional button np tab funs)
  (pcase-let ((`(,up ,down) (or funs
                                (if button
                                    `(,#'backward-button ,#'forward-button)
                                  `(,#'previous-line ,#'forward-line) ))))
    (keymap-set kmap "i" up)
    (keymap-set kmap "k" down)
    (when np
      (keymap-set kmap "p" up)
      (keymap-set kmap "n" down) )
    (when tab
      (define-key kmap [backtab] up)
      (keymap-set kmap "TAB"     down) )))

(provide 'scroll)