branch: externals/topspace
commit e5b65eccf92571163aa1b6bd738be22d8e0ad1a5
Author: Trevor Pogue <pogu...@mcmaster.ca>
Commit: GitHub <nore...@github.com>
Update and rename vertical-center-mode.el to topspace.el
---
topspace.el | 429 ++++++++++++++++++++++++++++++++++++++++++++++++
vertical-center-mode.el | 223 -------------------------
2 files changed, 429 insertions(+), 223 deletions(-)
diff --git a/topspace.el b/topspace.el
new file mode 100644
index 0000000000..fb530a3e73
--- /dev/null
+++ b/topspace.el
@@ -0,0 +1,429 @@
+;;; topspace.el --- Scroll above the top line to vertically center top text
-*- lexical-binding: t -*-
+
+;; Copyright (C) 2021-2022 Trevor Edwin Pogue
+
+;; Author: Trevor Edwin Pogue <trevor.po...@gmail.com>
+;; URL: https://github.com/trevorpogue/topspace
+;; Keywords: convenience, scrolling, center, margin, padding
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "25.1"))
+
+;; 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 of the License, 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. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; Scroll above the top line to vertically center top text.
+;; Gives the effect of having blank space/padding/margin being automatically
+;; drawn above the top text line using overlays as you scroll above,
+;; giving the equivalent effect of being able to scroll above the top line.
+
+;; No new keybindings are required as topspace automatically works for any
+;; commands or subsequent function calls which use `scroll-up', `scroll-down',
+;; or `recenter' as the underlying primitives for scrolling. This includes all
+;; scrolling commands/functions available in Emacs that the author is aware of.
+
+;;; Code:
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Private variables
+
+(defvar-local topspace--heights '())
+(defvar-local topspace--autocenter-heights '())
+(defvar-local topspace--previous-window-heights '())
+(defvar-local topspace--current-line-numbers '())
+(defvar-local topspace--window-start-before-scroll 2)
+(defvar-local topspace--total-lines-scrolling 0)
+(defvar-local topspace--pre-command-point 1)
+(defvar-local topspace--pre-command-window-start 2)
+(defvar-local topspace--total-lines-before-change 0)
+(defvar-local topspace--enabled nil)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Customization
+
+(defgroup topspace nil
+ "Scroll above the top line to vertically center top text."
+ :group 'scrolling
+ :group 'convenience
+ :link '(emacs-library-link :tag "Source Lisp File" "topspace.el")
+ :link '(url-link "https://github.com/trevorpogue/topspace";)
+ :link '(emacs-commentary-link :tag "Commentary" "topspace"))
+
+(defcustom topspace-autocenter-buffers
+ t
+ "Vertically center small buffers when first opened or window sizes change."
+ :group 'topspace
+ :type 'boolean)
+
+(defcustom topspace-center-position
+ 0.5
+ "Suggested position when centering buffers as a ratio of frame height.
+A value from 0 to 1 where lower values center buffers higher up in the screen.
+
+Used in `topspace-recenter-buffer' when called or when opening/resizing buffers
+if `topspace-autocenter-buffers' is non-nil."
+ :group 'topspace
+ :type 'float)
+
+(defcustom topspace-mode-line " T"
+ "Mode line lighter for Topspace.
+
+The value of this variable is a mode line template as in
+`mode-line-format'. See Info Node `(elisp)Mode Line Format' for
+more information. Note that it should contain a _single_ mode
+line construct only.
+
+Set this variable to nil to disable the mode line completely."
+ :group 'topspace
+ :type 'sexp)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Advice for `scroll-up', `scroll-down', and `recenter'
+
+(defun topspace--after-recenter (&optional line-offset redisplay)
+ "Recenter near the top of buffers by adding top space appropriately.
+LINE-OFFSET and REDISPLAY are used in the same way as in `recenter'."
+ ;; redisplay is unused but needed since this function
+ ;; must take the same arguments as `recenter'
+ redisplay ; remove flycheck warning for unused argument (see above)
+ (when (= (window-start) 1)
+ (unless line-offset
+ (setq line-offset (round (/ (topspace--window-height) line-offset))))
+ (when (< line-offset 0)
+ (setq line-offset (- (topspace--window-height) line-offset)))
+ (topspace--put (- line-offset (topspace--count-lines (window-start)
+ (point))))))
+
+(defun topspace--scroll (total-lines)
+ "Run before `scroll-up'/`scroll-down' for scrolling above the top line.
+TOTAL-LINES is used in the same way as in `scroll-down'."
+ (let ((old-topspace-height (topspace--height))
+ (new-topspace-height))
+ (setq new-topspace-height (topspace--correct-height
+ (+ old-topspace-height total-lines)))
+ (setq topspace--window-start-before-scroll (window-start))
+ (topspace--put new-topspace-height)
+ (- total-lines (- new-topspace-height old-topspace-height))))
+
+(defun topspace--filter-args-scroll-down (&optional total-lines)
+ "Run before `scroll-down' for scrolling above the top line.
+TOTAL-LINES is used in the same way as in `scroll-down'."
+ (setq total-lines (car total-lines))
+ (setq total-lines (or total-lines (- (topspace--window-height)
+ next-screen-context-lines)))
+ (setq topspace--total-lines-scrolling total-lines)
+ (list (topspace--scroll total-lines)))
+
+(defun topspace--filter-args-scroll-up (&optional total-lines)
+ "Run before `scroll-up' for scrolling above the top line.
+TOTAL-LINES is used in the same way as in `scroll-up'."
+ (setq total-lines (car total-lines))
+ (setq total-lines (* (or total-lines (- (topspace--window-height)
+ next-screen-context-lines)) -1))
+ (setq topspace--total-lines-scrolling total-lines)
+ (list (* (topspace--scroll total-lines) -1)))
+
+(defun topspace--after-scroll (&optional total-lines)
+ "Run after `scroll-up'/`scroll-down' for scrolling above the top line.
+TOTAL-LINES is used in the same way as in `scroll-down'.
+
+This is needed when scrolling down (moving buffer text lower in the screen)
+and no top space was present before scrolling but it should be after scrolling.
+The reason this is needed is because `topspace--put' only draws the overlay
when
+`window-start` equals 1, which can only be true after the scroll command is run
+in the described case."
+ (setq total-lines topspace--total-lines-scrolling)
+ (when (and (> topspace--window-start-before-scroll 1) (= (window-start) 1))
+ (let ((lines-already-scrolled (topspace--count-lines
+ 1 topspace--window-start-before-scroll)))
+ (setq total-lines (abs total-lines))
+ (set-window-start (selected-window) 1)
+ (topspace--put (- total-lines lines-already-scrolled)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Top space line height calculation
+
+(defun topspace--set-height (height)
+ "Set the top space line height for the selected window to HEIGHT.
+Will only set to HEIGHT if HEIGHT is a valid value based on (window-start)."
+ (setf (alist-get (selected-window) topspace--heights)
+ (topspace--correct-height height)))
+
+(defun topspace--height ()
+ "Get the top space line height for the selected window.
+If the existing value is invalid, set and return a valid value.
+If no previous value exists, return the appropriate value to
+ center the buffer when `topspace-autocenter-buffers' is non-nil, else 0."
+ (let ((height) (window (selected-window)))
+ (setq height (alist-get window topspace--heights))
+ (unless (or height (topspace--recenter-buffers-p)) (setq height 0))
+ (when height (topspace--set-height (topspace--correct-height height)))
+ (when (and (not height) (topspace--recenter-buffers-p))
+ (setq height (alist-get (selected-window) topspace--autocenter-heights))
+ (unless height (setq height (topspace--height-to-make-buffer-centered)))
+ (setq height (topspace--correct-height height))
+ (setf (alist-get window topspace--heights) height))
+ height))
+
+(defun topspace--correct-height (height)
+ "Used before setting a top space line height value to HEIGHT.
+Return HEIGHT if it is a valid value, else return a valid value.
+
+Valid top space heights are:
+- never negative,
+- only positive when `window-start' equals 1,
+- not larger than `topspace--window-height' minus `next-screen-context-lines'."
+ (let ((max-height (- (topspace--window-height) next-screen-context-lines)))
+ (when (> (window-start) 1) (setq height 0))
+ (when (< height 0) (setq height 0))
+ (when (> height max-height) (setq height max-height)))
+ height)
+
+(defun topspace--total-lines-past-max (&optional topspace-height)
+ "Used when making sure top space height does not push cursor off-screen.
+Return how many lines past the bottom of the window the cursor would get pushed
+if setting the top space to the suggested value TOPSPACE-HEIGHT.
+Any value above 0 flags that the suggested TOPSPACE-HEIGHT is too large."
+ (- (topspace--current-line-plus-topspace topspace-height)
+ (- (topspace--window-height) next-screen-context-lines)))
+
+(defun topspace--current-line-plus-topspace (&optional topspace-height)
+ "Used when making sure top space height does not push cursor off-screen.
+Return the current line plus the top space height TOPSPACE-HEIGHT."
+ (+ (topspace--count-lines (window-start) (point))
+ (or topspace-height (topspace--height))))
+
+(defun topspace--height-to-make-buffer-centered ()
+ "Return the necessary top space height to center selected window's buffer."
+ (let ((buffer-height (topspace--count-lines (window-start) (window-end)))
+ (result)
+ (window-height (topspace--window-height)))
+ (setq result (- (- (topspace--center-frame-line)
+ (round (/ buffer-height 2)))
+ (window-top-line (selected-window))))
+ (when (> (+ result buffer-height) (- window-height
+ next-screen-context-lines))
+ (setq result (- (- window-height buffer-height)
+ next-screen-context-lines)))
+ result))
+
+(defun topspace--center-frame-line ()
+ "Return a center line number based on `topspace-center-position'.
+The return value is only valid for windows starting at the top of the frame,
+which must be accounted for in the calling functions."
+ (round (* (frame-text-lines) topspace-center-position)))
+
+(defun topspace--recenter-buffers-p ()
+ "Return non-nil if buffer is allowed to be auto-centered.
+
+Buffers will not be auto-centered if `topspace-autocenter-buffers' is nil
+or if the selected window is in a child-frame."
+ (and topspace-autocenter-buffers
+ (or ;; frame-parent is only provided in Emacs 26.1, so first check
+ ;; if fhat function is boundp.
+ (not (boundp 'frame-parent))
+ (not (frame-parent)))))
+
+ (defun topspace--window-height ()
+ "Return the number of screen lines in the selected window rounded up."
+ (ceiling (window-screen-lines)))
+
+ (defun topspace--count-lines (start end)
+ "Return screen lines between START and END.
+Will use `count-screen-lines' except `count-screen-lines' will
+return unexpected value when end is in column 0. This fixes that issue."
+ (let ((adjustment 0) (column))
+ (save-excursion
+ (goto-char end)
+ (setq column (mod (current-column) (window-text-width)))
+ (unless (= column 0) (setq adjustment -1)))
+ (+ (count-screen-lines start end) adjustment)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Overlay drawing
+
+ (defun topspace--put (&optional height)
+ "Put/draw the top space as an overlay with the suggested line height
HEIGHT."
+ (let ((old-height (topspace--height)))
+ (when height (setq height (topspace--set-height height)))
+ (when (not height) (setq height old-height))
+ (when (and (> height 0) (> height old-height))
+ (let ((lines-past-max (topspace--total-lines-past-max height)))
+ (when (> lines-past-max 0) (forward-line (* lines-past-max -1)))))
+ (let ((topspace (make-overlay 0 0)))
+ (remove-overlays 1 1 'topspace--remove-from-window-tag
+ (selected-window))
+ (overlay-put topspace 'window (selected-window))
+ (overlay-put topspace 'topspace--remove-from-window-tag
+ (selected-window))
+ (overlay-put topspace 'topspace--remove-from-buffer-tag t)
+ (overlay-put topspace 'before-string (when (> height 0)
+ (make-string height ?\n))))
+ height))
+
+ (defun topspace--put-increase-height (total-lines)
+ "Increase the top space line height by the suggested amount of
TOTAL-LINES."
+ (topspace--put (+ (topspace--height) total-lines)))
+
+ (defun topspace--put-decrease-height (total-lines)
+ "Decrease the top space line height by the suggested amount of
TOTAL-LINES."
+ (topspace--put (- (topspace--height) total-lines)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Hooks
+
+ (defun topspace--window-configuration-change ()
+ "Update top spaces when window buffers change or windows are resized."
+ (let ((current-height (topspace--window-height)) (window
(selected-window)))
+ (let ((previous-height (alist-get window
topspace--previous-window-heights
+ current-height)))
+ (if (and (topspace--recenter-buffers-p)
+ (not (= previous-height current-height)))
+ (topspace-recenter-buffer)
+ (topspace--put))
+ (setf (alist-get window topspace--previous-window-heights)
+ current-height))))
+
+ (defun topspace--pre-command ()
+ "Reduce the amount of code that must execute in `topspace--after-command'."
+ (setq-local topspace--pre-command-point (window-start))
+ (setq-local topspace--pre-command-window-start (window-start)))
+
+ (defun topspace--after-command ()
+ "Gradually reduce top space before the cursor will move past the bottom."
+ (when (and (= topspace--pre-command-window-start 1)
+ (< (- (line-number-at-pos (point))
+ (line-number-at-pos topspace--pre-command-point))
+ (topspace--window-height)))
+ (let ((topspace-height (topspace--height)) (total-lines-past-max))
+ (when (> topspace-height 0)
+ (setq total-lines-past-max (topspace--total-lines-past-max
+ topspace-height))
+ (when (> total-lines-past-max 0)
+ (topspace--put-decrease-height total-lines-past-max))))))
+
+ (defvar topspace--hook-alist
+ '((window-configuration-change-hook .
topspace--window-configuration-change)
+ (pre-command-hook . topspace--pre-command)
+ (post-command-hook . topspace--after-command))
+ "A list of hooks to add/remove in the format (hook-variable . function).")
+
+ (defun topspace--add-hooks ()
+ "Add hooks defined in `topspace--hook-alist'."
+ (dolist (hook-func-pair topspace--hook-alist)
+ (add-hook (car hook-func-pair) (cdr hook-func-pair) 0 t)))
+
+ (defun topspace--remove-hooks ()
+ "Remove hooks defined in `topspace--hook-alist'."
+ (dolist (hook-func-pair topspace--hook-alist)
+ (remove-hook (car hook-func-pair) (cdr hook-func-pair) t)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; User functions
+
+;;;###autoload
+ (defun topspace-recenter-buffer ()
+ "Add enough top space in the selected window to center small buffers.
+
+Top space will not be added if the number of text lines in the buffer is larger
+than or close to the selected window's height.
+
+Customize `topspace-center-position' to adjust the centering position.
+Customize `topspace-autocenter-buffers' to run this command automatically
+after first opening buffers and after window sizes change."
+ (interactive)
+ (let ((center-height (topspace--height-to-make-buffer-centered)))
+ (setf (alist-get (selected-window) topspace--autocenter-heights)
+ center-height)
+ (topspace--put center-height)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Mode definition and setup
+
+ (defvar topspace-keymap (make-sparse-keymap)
+ "Keymap for Topspace commands.
+By default this is left empty for users to set with their own
+preferred bindings.")
+
+;;;###autoload
+ (define-minor-mode topspace-mode
+ "Scroll above the top line to vertically center top text.
+
+Gives the effect of having blank space/padding/margin being automatically
+drawn above the top text line using overlays as you scroll above,
+giving the equivalent effect of being able to scroll above the top line.
+
+No new keybindings are required as topspace automatically works for any
+commands or subsequent function calls which use `scroll-up', `scroll-down',
+or `recenter' as the underlying primitives for scrolling. This includes all
+scrolling commands/functions available in Emacs that the author is aware of.
+
+When called interactively, toggle `topspace-mode'. With prefix
+ARG, enable `topspace-mode' if ARG is positive, otherwise disable it.
+
+When called from Lisp, enable `topspace-mode' if ARG is omitted,
+nil or positive. If ARG is `toggle', toggle `topspace-mode'.
+Otherwise behave as if called interactively."
+ :init-value nil
+ :ligher topspace-mode-line
+ :keymap topspace-keymap
+ :group 'topspace
+ (if topspace-mode (topspace-enable) (topspace-disable)))
+
+;;;###autoload
+ (define-globalized-minor-mode global-topspace-mode topspace-mode
+ topspace-mode
+ :group 'topspace)
+
+ (defun topspace--enable-p ()
+ "Return non-nil if buffer is allowed to enable `topspace-mode.'.
+
+Topspace will not be enabled for:
+
+- minibuffers
+- ephemeral buffers (See Info node `(elisp)Buffer Names')
+- if `topspace-mode' is already enabled"
+ (not (or topspace--enabled
+ (minibufferp) (string-prefix-p " " (buffer-name)))))
+
+;;;###autoload
+ (defun topspace-enable ()
+ "Enable topspace-mode if not already enabled, otherwise do nothing."
+ (interactive)
+ (when (topspace--enable-p)
+ (topspace--add-hooks)
+ (setq topspace--enabled t)
+ (advice-add #'scroll-up :filter-args #'topspace--filter-args-scroll-up)
+ (advice-add #'scroll-down :filter-args
+ #'topspace--filter-args-scroll-down)
+ (advice-add #'scroll-up :after #'topspace--after-scroll)
+ (advice-add #'scroll-down :after #'topspace--after-scroll)
+ (advice-add #'recenter :after #'topspace--after-recenter)))
+
+;;;###autoload
+ (defun topspace-disable ()
+ "Disable topspace-mode if already enabled, otherwise do nothing."
+ (interactive)
+ (when topspace--enabled
+ (setq topspace--enabled nil)
+ (remove-overlays 1 1 'topspace--remove-from-buffer-tag t)
+ (advice-remove #'scroll-up #'topspace--filter-args-scroll-up)
+ (advice-remove #'scroll-down #'topspace--filter-args-scroll-down)
+ (advice-remove #'scroll-up #'topspace--after-scroll)
+ (advice-remove #'scroll-down #'topspace--after-scroll)
+ (advice-remove #'recenter #'topspace--after-recenter)
+ (topspace--remove-hooks)))
+
+ (provide 'topspace)
+
+;;; topspace.el ends here
diff --git a/vertical-center-mode.el b/vertical-center-mode.el
deleted file mode 100644
index f594232f38..0000000000
--- a/vertical-center-mode.el
+++ /dev/null
@@ -1,223 +0,0 @@
-;;; vertical-center-mode.el --- Center buffers vertically in their window and
scroll above the top line -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2021 Trevor Pogue, ...
-
-;; 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 of the License, 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; Automatically center buffers vertically in the window after opening files
and
-;; during editing. Users can also adjust the centering offset with scrolling to
-;; further scroll up or down by any amount above the top lines in a buffer.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; TODO:
-;; - support scrolling above top line with page scrolling as well
-;; - centered-cursor-mode todo: isearch top centering
-;; - cannot scroll above top line if buffer open in multiple windows and
-;; one or more windows is scrolled above beginning of buffer
-;; - recentering on window resize only occurs in selected buffer
-;; - issues if enabling when top line in window is > line 1
-;; - submit to MELPA? (after optimizing/cleaning up code more)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Mode definition and setup
-
-;;;###autoload
-(define-global-minor-mode global-vertical-center-mode vertical-center-mode
- vcm--turn-on-from-global)
-
-(defun vcm--turn-on-from-global ()
- "Try to turn on vertical-center-mode from global call.
-Called when calling command `global-vertical-center-mode'.
-vertical-center-mode will not start in minibuffer or hidden buffers, or helm."
- (unless (or (bound-and-true-p vcm-on)
-
(string-match " \\*.*\\*" (buffer-name))
-
(string-match "helm" (buffer-name))
-
(minibufferp))
- (vertical-center-mode 1)))
-
-;;;###autoload
-(define-minor-mode vertical-center-mode
- "Allows vertical padding or scrolling above the top line of a
buffer.
-When opening a buffer, the contents are initially vertically centered with
-respect to the window height. The user can also scroll as well to adjust the
-centering offset. The buffer also recenters if transfered to
-another window unless user has previously adjusted its height with scrolling.
-"
- :init-value nil
- :ligher " vc"
- :keymap nil
- ;; only turn on if mode was previously off
- (if (and vertical-center-mode (not (bound-and-true-p vcm-on)))
- (vcm--turn-on))
- ;; only turn off if mode was previously on
- (if (and (not vertical-center-mode) (bound-and-true-p vcm-on))
- (vcm--turn-off)))
-
-(defun vcm--turn-on ()
- (setq-local vcm-on t)
- (setq-local vcm-overlay (make-overlay (point-min) (point-max)))
- (setq-local vcm-scroll-offset 0)
- (setq-local vcm-user-scrolled nil)
- (vcm--set-prev-buffer-lines)
- (vcm--add-hooks)
- (if (not (boundp 'vcm-first-recenter-done))
- ;; vcm-first-recenter-done is
used to block too many recenterings occuring
- ;; that are triggered by
window-based hooks,
- (setq-local
vcm-first-recenter-done nil))
- ;; Below: let user turn the mode off then on again to recenter
while preventing
- ;; recentering here on initial mode turn-on. This avoids a bug
with buffer
- ;; not being centered on emacs startup, but need to investigate
further to
- ;; understand the root cause behind this bug/solution
relationship.
- (if vcm-first-recenter-done (vcm--recenter-reset-scroll)))
-
-(defun vcm--turn-off ()
- "Delete/unset data structures when the mode is turned off."
- (vcm--remove-hooks)
- (makunbound 'vcm-on)
- (delete-overlay vcm-overlay)
- (makunbound 'vcm-overlay)
- (makunbound 'vcm-scroll-offset)
- (makunbound 'vcm-user-scrolled)
- (makunbound 'vcm-prev-buf-size)
- (makunbound 'vcm-buffer-lines)
- )
-
-(defun vcm--kill-buffer ()
- (makunbound 'vcm-first-recenter-done)
- (vcm--turn-off))
-
-(provide 'vertical-center-mode)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Properties (inspired specifically by definition of properties from Python)
-
-(defun vcm--center-offset ()
- "Portion of the overlay that makes small buffers centered."
- (if (not (boundp 'vcm-buffer-lines)) (vcm--update-buffer-lines))
- ;; dividing by slightly less than 2 here made buffers more dead
centered
- (let ((center-offset (/ (* (- (vcm--window-lines)
vcm-buffer-lines
-
) 31) 64)))
- (when (< center-offset 0) (setq center-offset
0))
- center-offset))
-
-(defun vcm--add-to-scroll-offset (direction)
- (let ((pos (+ (- (line-number-at-pos) (vcm--top-line))
(vcm--overlay-size)))
- (bottom (-
(vcm--window-lines) 5)))
- ;; avoids a bug with cursor suddenly scrolling
up
- (when (> pos bottom) (previous-line)))
- ;; only put overlay when top line is 1
- (when (= (vcm--top-line) 1)
- ;; block scrolling text fully below bottom of
window
- (unless (and (> direction 0)
-
(>= (vcm--overlay-size)
(- (vcm--window-lines) 5)))
- (setq vcm-scroll-offset (+
vcm-scroll-offset direction)))))
-
-(defun vcm--overlay-size ()
- "The total overlay size."
- (+ vcm-scroll-offset (vcm--center-offset)))
-
-(defun vcm--set-prev-buffer-lines (&optional arg0 arg1 arg2)
- "Size of the buffer text in lines."
- (setq-local vcm-prev-buf-size (count-screen-lines (point-min)
(point-max))))
-
-(defun vcm--top-line ()
- "Line number of the top line of text shown in the window."
- (line-number-at-pos (window-start)))
-
-(defun vcm--update-buffer-lines ()
- (setq-local vcm-buffer-lines (count-screen-lines (point-min)
(point-max))))
-
-(defun vcm--window-lines ()
- (floor (window-screen-lines)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Overlay dislaying and recentering hooks
-
-;; the optional unused args in this section are just for hook compatibility
-
-(defun vcm--recenter-keep-scroll (&optional arg0 arg1 arg2)
- "Use an overlay to display empty lines at the beginning of the
buffer.
-This emulates the ability to scroll above the top line."
- (let ((overlay-size (vcm--overlay-size)))
- (overlay-put vcm-overlay 'before-string
-
(when (> overlay-size
0) (make-string overlay-size ?\n))))
- (setq vcm-first-recenter-done t))
-
-(defun vcm--recenter-keep-scroll-after-change (&optional arg0 arg1 arg2)
- (vcm--update-buffer-lines)
- (when (not (= vcm-prev-buf-size vcm-buffer-lines))
- (vcm--recenter-keep-scroll)))
-
-(defun vcm--recenter-reset-scroll (&optional arg0 arg1 arg2)
- (setq vcm-scroll-offset 0)
- (vcm--recenter-keep-scroll))
-
-(defun vcm--recenter-reset-scroll-conditional (&optional arg0 arg1 arg2)
- (unless vcm-user-scrolled
- (vcm--recenter-reset-scroll)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Scrolling hooks
-
-(defun vcm--scroll (scroll-list ccm-list scroll-direction)
- "Emulate scrolling if user command was a scrolling command."
- (let ((user-is-scrolling (member this-command scroll-list))
-
(centering-cursor (member this-command ccm-list)))
- ;; shouldn't scroll from moving cursor unless
in centered-cursor-mode
- (unless (bound-and-true-p centered-cursor-mode)
(setq centering-cursor nil))
- (when (or user-is-scrolling centering-cursor)
- (vcm--add-to-scroll-offset
scroll-direction)
- (setq vcm-user-scrolled t)
- (vcm--recenter-keep-scroll))))
-
-(defun vcm--scroll-increase-overlay ()
- "Check if user command should initiate scrolling down."
- (vcm--scroll '(scroll-down-line evil-scroll-line-up)
-
'(previous-line
evil-previous-visual-line) 1))
-
-(defun vcm--scroll-decrease-overlay ()
- "Check if user command should initiate scrolling up."
- (vcm--scroll '(scroll-up-line evil-scroll-line-down)
-
'(next-line evil-next-visual-line) -1))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Hooks
-
-(defvar vcm--hook-alist
- '(
- (window-configuration-change-hook .
vcm--recenter-reset-scroll-conditional)
- (kill-buffer-hook . vcm--kill-buffer)
- (before-change-functions .
vcm--set-prev-buffer-lines)
- (after-change-functions .
vcm--recenter-keep-scroll-after-change)
- (pre-command-hook .
vcm--scroll-increase-overlay)
- (post-command-hook .
vcm--scroll-decrease-overlay))
- "A list of hooks so they only need to be written in one spot.
-List of cons cells in format (hook-variable . function).")
-
-(defun vcm--add-hooks ()
- "Add hooks defined in variable `vcm-hook-alist'."
- (mapc (lambda (entry) (add-hook (car entry) (cdr entry) t t))
-
vcm--hook-alist))
-
-(defun vcm--remove-hooks ()
- "Remove hooks defined in variable `vcm-hook-alist'."
- (mapc (lambda (entry) (remove-hook (car entry) (cdr entry) t))
-
vcm--hook-alist))
