spacemacs/layers/+distributions/spacemacs-base/local/centered-buffer-mode/centered-buffer-mode.el

;;; centered-buffer-mode.el --- Centering minor mode -*- lexical-binding: t -*-
;;
;; Copyright (C) 2012-2017 Sylvain Benner & Contributors
;;
;; Author: Eugene "JAremko" Yaremenko <w3techplayground@gmail.com>
;; Keywords: centering buffer minor-mode
;; Created: 1 July 2016
;; Version: 1.02
;; Package-Requires: ((emacs "24.4"))
;; URL: https://github.com/syl20bnr/spacemacs

;; This file is not part of GNU Emacs.

;; 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 <http://www.gnu.org/licenses/>.

;;; Code:
(require 'face-remap)

(defgroup spacemacs-centered-buffer-mode nil
  "Minor mode to center buffer in its window."
  :group 'convenience)

(defcustom spacemacs-centered-buffer-mode-min-fringe-width 50
  "Minimal fringe width. `centered-buffer-mode' will be disabled
if one of windows displaying it becomes too narrow."
  :type 'integer
  :group 'spacemacs-centered-buffer-mode)

(defcustom spacemacs-centered-buffer-mode-min-content-width 400
  "Minimal width of the centered buffer content."
  :type 'integer
  :group 'spacemacs-centered-buffer-mode)

(defcustom spacemacs-centered-buffer-mode-max-content-width 800
  "Maximal width of the centered buffer content before it stops starching."
  :type 'integer
  :group 'spacemacs-centered-buffer-mode)

(defcustom spacemacs-centered-buffer-mode-safety-gap-width 20
  "Add extra width to the modified buffer to make sure
that differed modifications won't cause an overflow."
  :type 'integer
  :group 'spacemacs-centered-buffer-mode)

(defcustom spacemacs-centered-buffer-mode-fringe-color
  (face-background 'default)
  "Color of the fringes."
  :type 'color
  :group 'spacemacs-centered-buffer-mode)

(defcustom spacemacs-centered-buffer-mode-deferred-update nil
  "Defer buffer re-centering if t.
If set to t it may improve input latency."
  :type 'boolean
  :group 'spacemacs-centered-buffer-mode)

(defcustom spacemacs-centered-buffer-mode-only-grow nil
  "If t ignore reduction of the centered buffer width.
NOTE: Useful with some types of line wrappings but also
can be mush slower with huge buffers."
  :type 'boolean
  :group 'spacemacs-centered-buffer-mode)

(defcustom spacemacs-centered-buffer-mode-visual-line-mode t
  "If t also enable `visual-line-mode' when `centered-buffer-mode' is enabled."
  :type 'boolean
  :group 'spacemacs-centered-buffer-mode)

(defvar-local spacemacs--centered-buffer-origin-buffer nil)
(defvar-local spacemacs--centered-buffer-indirect-buffer nil)
(defvar-local spacemacs--centered-buffer-text-pixel-size nil)
(defvar spacemacs--centered-buffer-adviced-fontify-fs (list))
(defvar spacemacs-centered-buffer-mode-default-fringe-color (face-background
                                                             'fringe))
(defvar spacemacs--centered-buffer-indirect-buffers (list))
(defvar-local spacemacs--centered-buffer-on-buffer-updated-timer nil)
(defvar-local spacemacs--centered-buffer-update-all-timer nil)
(defvar-local spacemacs--centered-buffer-fontify-region-min-pos nil)
(defvar-local spacemacs--centered-buffer-fontify-region-max-pos nil)

(define-minor-mode spacemacs-centered-buffer-mode
  "Minor mode to center buffer in its window."
  :init-value nil
  :group 'spacemacs-centered-buffer-mode
  (if (display-graphic-p)
      (if spacemacs-centered-buffer-mode
          (if (not (window-dedicated-p))
              (spacemacs//centered-buffer-enable-branch
               (called-interactively-p 'any))
            (setq spacemacs-centered-buffer-mode nil)
            (when (called-interactively-p 'any)
              (message "Can't center in dedicated window!")))
        (spacemacs//centered-buffer-disable-branch))
    (message "centered buffer mode doesn't work in terminal :(")))

(defun spacemacs//centered-buffer-enable-branch (interact)
  "Used it `spacemacs-centered-buffer-mode'.
Assume to be called interactively when INTERACT has non nil value."
  ;; Mode will be applied to the indirect buffer.
  (setq spacemacs-centered-buffer-mode nil)
  ;; Don't run if the mode is enabled(we are in the indirect buffer).
  (unless spacemacs--centered-buffer-origin-buffer
    (when spacemacs-centered-buffer-mode-visual-line-mode
      (visual-line-mode +1))
    (let* ((window (selected-window))
           (origin-buffer (window-buffer window))
           (indirect-buffer
            (if (buffer-live-p
                 spacemacs--centered-buffer-indirect-buffer)
                spacemacs--centered-buffer-indirect-buffer
              (setq spacemacs--centered-buffer-indirect-buffer
                    (make-indirect-buffer origin-buffer
                                          (format "%s(centered)"
                                                  origin-buffer)
                                          t)))))
      (spacemacs//centered-buffer-buffer-fringr-color-toggle origin-buffer
                                                                  t)
      (setq  spacemacs--centered-buffer-indirect-buffer
             indirect-buffer
             spacemacs-centered-buffer-mode-default-fringe-color
             (face-background 'fringe))
      (switch-to-buffer indirect-buffer nil t)
      (with-mode-disabled
          page-break-lines-mode
        (let* ((fringe-w (spacemacs//centered-buffer-calc-fringe
                          window)))
          (if (> fringe-w spacemacs-centered-buffer-mode-min-fringe-width)
              (progn
                ;; Fix visual glitch.
                (spacemacs/toggle-line-numbers)
                (spacemacs/toggle-line-numbers)
                ;;
                (setq spacemacs--centered-buffer-indirect-buffers
                      (append (list indirect-buffer)
                              spacemacs--centered-buffer-indirect-buffers)
                      spacemacs--centered-buffer-origin-buffer
                      origin-buffer
                      spacemacs-centered-buffer-mode t
                      indicate-empty-lines nil
                      fringes-outside-margins t
                      left-fringe-width fringe-w
                      right-fringe-width fringe-w
                      ;; looks better with some margin.
                      left-margin-width (if (or (not left-margin-width)
                                                (= left-margin-width 0))
                                            1
                                          left-margin-width)
                      spacemacs--centered-buffer-text-pixel-size
                      (spacemacs//centered-buffer-window-text-pixel-size
                       window))
                (face-remap-add-relative
                 'fringe
                 :background
                 spacemacs-centered-buffer-mode-fringe-color)
                (set-window-buffer window indirect-buffer)
                (spacemacs//centered-buffer-toggle-hooks t))
            (setq spacemacs--centered-buffer-origin-buffer nil)
            (set-buffer origin-buffer)
            (spacemacs//centered-buffer-buffer-fringr-color-toggle
             origin-buffer
             nil)
            (kill-buffer indirect-buffer)
            (setq spacemacs--centered-buffer-indirect-buffer nil)
            (when interact
              (message "Not enough space to center the buffer!"))))))))

(defun spacemacs//centered-buffer-on-buffer-update-internal (buffer)
  "Calls `spacemacs//centered-buffer-update-fringes' on the buffer
using `spacemacs--centered-buffer-fontify-region-min-pos' and
`spacemacs--centered-buffer-fontify-region-max-pos' as BEGIN END."
  (when (buffer-live-p buffer)
    (with-current-buffer buffer
      (when spacemacs--centered-buffer-origin-buffer
        (if spacemacs-centered-buffer-mode-only-grow
            (spacemacs//centered-buffer-update-fringes
             spacemacs--centered-buffer-fontify-region-min-pos
             spacemacs--centered-buffer-fontify-region-max-pos
             buffer)
          (spacemacs//centered-buffer-update-fringes
           (point-min)
           (point-max)
           buffer)))
      (setq spacemacs--centered-buffer-fontify-region-min-pos nil
            spacemacs--centered-buffer-fontify-region-max-pos nil
            spacemacs--centered-buffer-on-buffer-updated-timer nil))))
(byte-compile 'spacemacs//centered-buffer-on-buffer-update-internal)

(defun spacemacs//centered-buffer-on-buffer-updated (begin end _)
  "Schedules call to `spacemacs//centered-buffer-on-buffer-update-internal'
with `run-with-idle-timer'. BEGIN and END are pushed to
`spacemacs--centered-buffer-fontify-region-min-pos' and
`spacemacs--centered-buffer-fontify-region-max-pos'"
  (when spacemacs--centered-buffer-origin-buffer
    (setq
     spacemacs--centered-buffer-fontify-region-min-pos
     (min
      (or spacemacs--centered-buffer-fontify-region-min-pos
          most-positive-fixnum)
      begin)
     spacemacs--centered-buffer-fontify-region-max-pos
     (max
      (or spacemacs--centered-buffer-fontify-region-max-pos
          most-negative-fixnum)
      end))
    (unless spacemacs--centered-buffer-on-buffer-updated-timer
      (setq
       spacemacs--centered-buffer-on-buffer-updated-timer
       (run-with-idle-timer
         (if spacemacs-centered-buffer-mode-deferred-update 0.5 0)
         nil
         'spacemacs//centered-buffer-on-buffer-update-internal
        (current-buffer))))))
(byte-compile 'spacemacs//centered-buffer-on-buffer-updated)

(defun spacemacs//centered-buffer-toggle-hooks (on?)
  "Add `centered-buffer-mode' hooks and advices if ON? non-nil
otherwise remove them."
  (if on?
      (progn
        (unless (= spacemacs-centered-buffer-mode-min-content-width
                   spacemacs-centered-buffer-mode-max-content-width)
          (let ((fontify-func (or font-lock-fontify-region-function
                                  'font-lock-default-fontify-region)))
            (unless (memq fontify-func
                          spacemacs--centered-buffer-adviced-fontify-fs)
              (push fontify-func spacemacs--centered-buffer-adviced-fontify-fs)
              (advice-add fontify-func
                          :after
                          #'spacemacs//centered-buffer-on-buffer-updated)))
          (add-hook 'after-change-functions
                    #'spacemacs//centered-buffer-on-buffer-updated
                    nil
                    t))
        (add-hook 'kill-buffer-hook
                  #'spacemacs//centered-buffer-prune-indirect-buffer-list)
        (advice-add 'toggle-frame-fullscreen
                    :after
                    #'spacemacs//centered-buffer-window-configuration-change-hk)
        (advice-add 'toggle-frame-maximized
                    :after
                    #'spacemacs//centered-buffer-window-configuration-change-hk)
        (add-hook 'window-configuration-change-hook
                  #'spacemacs//centered-buffer-window-configuration-change-hk))
    (dolist (func spacemacs--centered-buffer-adviced-fontify-fs)
      (when (fboundp func)
       (advice-remove func
                      #'spacemacs//centered-buffer-on-buffer-updated)))
    (setq spacemacs--centered-buffer-adviced-fontify-fs nil)
    (remove-hook 'after-change-functions
                 #'spacemacs//centered-buffer-on-buffer-updated)
    (advice-remove 'toggle-frame-maximized
                   #'spacemacs//centered-buffer-window-configuration-change-hk)
    (advice-remove 'toggle-frame-fullscreen
                   #'spacemacs//centered-buffer-window-configuration-change-hk)
    (remove-hook 'window-configuration-change-hook
                 #'spacemacs//centered-buffer-window-configuration-change-hk)))

(defun spacemacs//centered-buffer-disable-branch ()
  "Used in `spacemacs-centered-buffer-mode'."
  ;; Don't run if the mode is disabled(we are not in the indirect buffer).
  (when spacemacs--centered-buffer-origin-buffer
    (let* ((window (selected-window))
           (origin-buffer spacemacs--centered-buffer-origin-buffer)
           (indirect-buffer (window-buffer window)))
      (setq spacemacs--centered-buffer-origin-buffer nil)
      (switch-to-buffer origin-buffer nil t)
      (spacemacs//centered-buffer-buffer-fringr-color-toggle origin-buffer
                                                                  nil)
      (setq spacemacs--centered-buffer-indirect-buffer nil)
      (when (buffer-live-p indirect-buffer)
        (dolist (window (get-buffer-window-list indirect-buffer 2))
          (set-window-buffer window origin-buffer))
        (kill-buffer indirect-buffer)))))

(defun spacemacs//centered-buffer-buffer-fringr-color-toggle (buffer flag)
  "Change fringe color of the BUFFER if FLAG has non-nil value.
Revert changes Otherwise."
  (with-current-buffer buffer
    (if flag
        (face-remap-add-relative 'fringe :background
                                 spacemacs-centered-buffer-mode-fringe-color)
      (face-remap-reset-base 'fringe)
      (face-remap-add-relative
       'fringe
       :background
       spacemacs-centered-buffer-mode-default-fringe-color))))

(defsubst spacemacs//centered-buffer-window-text-pixel-size (window
                                                             &optional from to)
  "Calculate WINDOW text pixel width with `window-text-pixel-size' in
FROM TO region
and clamp it in between `spacemacs-centered-buffer-mode-min-content-width'
and `spacemacs-centered-buffer-mode-max-content-width'.
If `spacemacs-centered-buffer-mode-min-content-width' and
`spacemacs-centered-buffer-mode-max-content-width' are equal return
their value instead."
  (if (= spacemacs-centered-buffer-mode-min-content-width
         spacemacs-centered-buffer-mode-max-content-width)
      spacemacs-centered-buffer-mode-max-content-width
    (max
     spacemacs-centered-buffer-mode-min-content-width
     (car (window-text-pixel-size
           window
           from
           to
           spacemacs-centered-buffer-mode-max-content-width)))))
(byte-compile 'spacemacs//centered-buffer-window-text-pixel-size)

(defsubst spacemacs//centered-buffer-calc-fringe
  (&optional window text-pixel-size)
  "Calculate fringe width for `spacemacs-centered-buffer-mode'.
The function Uses TEXT-PIXEL-SIZE if provided,
otherwise calculates it with `window-pixel-width'."
  (-(/ (- (window-pixel-width window)
          (or text-pixel-size
              (spacemacs//centered-buffer-window-text-pixel-size
               window)))
       2)
    (if (bound-and-true-p org-indent-mode) 40
      spacemacs-centered-buffer-mode-safety-gap-width)))
(byte-compile 'spacemacs//centered-buffer-calc-fringe)

(defsubst spacemacs//centered-buffer-buffer-update-window-fringes (window)
  "Update fringe width of WINDOW if it displays `centered-buffer-mode' buffer."
  (when (and (buffer-local-value 'spacemacs--centered-buffer-origin-buffer
                                 (window-buffer window))
             ;; Might be needed because
             ;; (spacemacs-centered-buffer-mode -1) kills buffers.
             (buffer-live-p (window-buffer window)))
    (let ((fringe-w (spacemacs//centered-buffer-calc-fringe
                      window
                      (buffer-local-value
                        'spacemacs--centered-buffer-text-pixel-size
                        (window-buffer window)))))
      (if (> fringe-w spacemacs-centered-buffer-mode-min-fringe-width)
          (set-window-fringes window fringe-w fringe-w t)
        (spacemacs-centered-buffer-mode -1)
        (when spacemacs--centered-buffer-indirect-buffers
          (spacemacs//centered-buffer-prune-indirect-buffer-list))))))

(defun spacemacs//centered-buffer-update-all ()
  "Update fringe width of all `centered-buffer-mode' windows."
  (setq spacemacs--centered-buffer-update-all-timer nil)
  (dolist (frame (frame-list))
    (when (frame-live-p frame)
      (dolist (window (window-list frame 2))
        (spacemacs//centered-buffer-buffer-update-window-fringes window)))))
(byte-compile 'spacemacs//centered-buffer-update-all)

(defun spacemacs//centered-buffer-window-configuration-change-hk ()
  "Schedules call to `spacemacs//centered-buffer-update-all'."
  (when (and spacemacs--centered-buffer-indirect-buffers
             (not spacemacs--centered-buffer-update-all-timer))
    (setq
     spacemacs--centered-buffer-update-all-timer
     (run-with-idle-timer
       (if spacemacs-centered-buffer-mode-deferred-update 0.5 0)
       nil
       'spacemacs//centered-buffer-update-all))))
(byte-compile 'spacemacs//centered-buffer-window-configuration-change-hk)

(defun spacemacs//centered-buffer-update-fringes (begin end buffer)
  "Check BEGIN END region pixel width and update fringes width
if BUFFER's content doesn't fit."
  (when (buffer-live-p buffer)
    (with-current-buffer buffer
      (dolist (window (get-buffer-window-list buffer 2 t))
        (save-excursion
          (let* ((min-pos (progn (goto-char begin)
                                 (point-at-bol)))
                 (max-pos (progn (goto-char end)
                                 (point-at-eol)))
                 (updated-segment-max-width
                  (spacemacs//centered-buffer-window-text-pixel-size
                   window
                   min-pos
                   max-pos)))
            (when (or (not spacemacs-centered-buffer-mode-only-grow)
                      (> updated-segment-max-width
                         spacemacs--centered-buffer-text-pixel-size))
              (setq spacemacs--centered-buffer-text-pixel-size
                    updated-segment-max-width))
            (spacemacs//centered-buffer-buffer-update-window-fringes
             window)))))))
(byte-compile 'spacemacs//centered-buffer-update-fringes)

(defsubst spacemacs//centered-buffer-prune-indirect-buffer-list ()
  "Remove dead buffers from `spacemacs--centered-buffer-indirect-buffers'
and disables `centered-buffer-mode' hooks and advices if
`spacemacs--centered-buffer-indirect-buffers' in empty (nil)."
  (dolist (buffer spacemacs--centered-buffer-indirect-buffers)
    (unless (or (buffer-live-p buffer)
                (not spacemacs--centered-buffer-indirect-buffers))
      (let ((origin-buffer (buffer-local-value
                            'spacemacs--centered-buffer-origin-buffer
                            buffer)))
        (setq spacemacs--centered-buffer-indirect-buffers
              (delete buffer
                      spacemacs--centered-buffer-indirect-buffers))
        (when (buffer-live-p origin-buffer)
          (spacemacs//centered-buffer-buffer-fringr-color-toggle
           origin-buffer nil)
          (with-current-buffer origin-buffer
            (setq spacemacs--centered-buffer-indirect-buffers nil))))))
  ;; Remove hooks and advices when they are not needed anymore.
  (unless spacemacs--centered-buffer-indirect-buffers
    (spacemacs//centered-buffer-toggle-hooks nil)))

(defmacro with-mode-disabled (mode &rest body)
  "Evaluate BODY with MODE disabled."
  (declare (indent 1) (debug t))
  `(if (not (bound-and-true-p ,mode))
       (progn ,@body)
     (,mode -1)
     ,@body
     (,mode +1)))

(provide 'centered-buffer-mode)

;;; centered-buffer-mode.el ends here