;;; centered-buffer-mode.el --- Centering minor mode -*- lexical-binding: t -*- ;; ;; Copyright (C) 2012-2017 Sylvain Benner & Contributors ;; ;; Author: Eugene "JAremko" Yaremenko ;; 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 . ;;; 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