emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/topspace e5b65eccf9 010/181: Update and rename vertical


From: ELPA Syncer
Subject: [elpa] externals/topspace e5b65eccf9 010/181: Update and rename vertical-center-mode.el to topspace.el
Date: Tue, 23 Aug 2022 12:58:28 -0400 (EDT)

branch: externals/topspace
commit e5b65eccf92571163aa1b6bd738be22d8e0ad1a5
Author: Trevor Pogue <poguete@mcmaster.ca>
Commit: GitHub <noreply@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.pogue@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))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]