visual-fill-column.el 8.55 KB
Newer Older
1 2
;;; visual-fill-column.el --- fill-column for visual-line-mode  -*- lexical-binding: t -*-

3
;; Copyright (C) 2015-2016 Joost Kremers
Joost Kremers's avatar
Joost Kremers committed
4
;; Copyright (C) 2016 Martin Rudalics
5 6 7 8 9
;; All rights reserved.

;; Author: Joost Kremers <joostkremers@fastmail.fm>
;; Maintainer: Joost Kremers <joostkremers@fastmail.fm>
;; Created: 2015
10
;; Version: 1.9
11 12 13 14
;; Package-Requires: ((emacs "24.3"))

;; This file is NOT part of GNU Emacs.

15
;; visual-fill-column is free software: you can redistribute it and/or modify
16 17 18 19
;; 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.

20
;; visual-fill-column is distributed in the hope that it will be useful,
21 22 23 24 25 26 27 28 29
;; 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

30 31 32 33 34
;; `visual-fill-column-mode' is a small Emacs minor mode that mimics the effect of `fill-column'
;; in `visual-line-mode'.  Instead of wrapping lines at the window edge, which
;; is the standard behaviour of `visual-line-mode', it wraps lines at
;; `fill-column'.  If `fill-column' is too large for the window, the text is
;; wrapped at the window edge.
35 36 37 38 39 40 41 42 43

;;; Code:

(defgroup visual-fill-column nil "Wrap lines according to `fill-column' in `visual-line-mode'."
  :group 'wp
  :prefix "visual-fill-column-")

(defcustom visual-fill-column-width nil
  "Width of the text area.
44
By default, the global value of `fill-column' is used, but if
45
this option is set to a value, it is used instead."
46
  :group 'visual-fill-column
47
  :type '(choice (const :tag "Use `fill-column'" :value nil)
48
                 (integer :tag "Specify width" :value 70)))
49
(make-variable-buffer-local 'visual-fill-column-width)
50
(put 'visual-fill-column-width 'safe-local-variable 'numberp)
51

52 53
(defcustom visual-fill-column-fringes-outside-margins t
  "Put the fringes outside the margins."
54
  :group 'visual-fill-column
55 56 57 58
  :type '(choice (const :tag "Put fringes outside the margins" t)
                 (const :tag "Keep the fringes inside the margins" nil)))
(make-variable-buffer-local 'visual-fill-column-fringes-outside-margins)
(put 'visual-fill-column-fringes-outside-margins 'safe-local-variable 'symbolp)
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89

(defcustom visual-fill-column-center-text nil
  "If set, center the text area in the window."
  :group 'visual-fill-column
  :type '(choice (const :tag "Display text area at window margin" nil)
                 (const :tag "Center text area" t)))
(make-variable-buffer-local 'visual-fill-column-center-text)
(put 'visual-fill-column-center-text 'safe-local-variable 'symbolp)

;;;###autoload
(define-minor-mode visual-fill-column-mode
  "Wrap lines according to `fill-column' in `visual-line-mode'."
  :init-value nil :lighter nil :global nil
  (if visual-fill-column-mode
      (visual-fill-column-mode--enable)
    (visual-fill-column-mode--disable)))

;;;###autoload
(define-globalized-minor-mode global-visual-fill-column-mode visual-fill-column-mode turn-on-visual-fill-column-mode
  :require 'visual-fill-column-mode
  :group 'visual-fill-column)

(defun turn-on-visual-fill-column-mode ()
  "Turn on `visual-fill-column-mode'.
Note that `visual-fill-column-mode' is only turned on in buffers
in which `visual-line-mode' is active as well."
  (when visual-line-mode
    (visual-fill-column-mode 1)))

(defun visual-fill-column-mode--enable ()
  "Set up `visual-fill-column-mode' for the current buffer."
90 91
  (add-hook 'window-configuration-change-hook #'visual-fill-column--adjust-window 'append 'local)
  (visual-fill-column--adjust-window))
92 93 94

(defun visual-fill-column-mode--disable ()
  "Disable `visual-fill-column-mode' for the current buffer."
95
  (remove-hook 'window-configuration-change-hook #'visual-fill-column--adjust-window 'local)
96 97
  (set-window-fringes (get-buffer-window (current-buffer)) nil)
  (set-window-margins (get-buffer-window (current-buffer)) nil))
98

99
(defun visual-fill-column-split-window (&optional window size side pixelwise)
Joost Kremers's avatar
Joost Kremers committed
100
  "Split WINDOW, unsetting its margins first.
101 102
SIZE, SIDE, and PIXELWISE are passed on to `split-window'.  This
function is for use in the window parameter `split-window'."
Joost Kremers's avatar
Joost Kremers committed
103 104 105 106 107
  (let ((horizontal (memq side '(t left right)))
	margins new)
    (when horizontal
      ;; Reset margins.
      (setq margins (window-margins window))
108
      (set-window-margins window nil))
Joost Kremers's avatar
Joost Kremers committed
109 110 111
    ;; Now try to split the window.
    (set-window-parameter window 'split-window nil)
    (unwind-protect
112
	(setq new (split-window window size side pixelwise))
113
      (set-window-parameter window 'split-window #'visual-fill-column-split-window)
Joost Kremers's avatar
Joost Kremers committed
114 115 116 117
      ;; Restore old margins if we failed.
      (when (and horizontal (not new))
	(set-window-margins window (car margins) (cdr margins))))))

118
;;;###autoload
119 120 121 122 123 124 125
(defun visual-fill-column-split-window-sensibly (&optional window)
  "Split WINDOW sensibly, unsetting its margins first.
This function unsets the window margins and calls
`split-window-sensibly'.

By default, `split-window-sensibly' does not split a window
vertically if it has wide margins, even if there is enough space
126
for a vertical split.  This function can be used as the value of
127 128 129 130 131
`split-window-preferred-function' to enable vertically splitting
windows with wide margins."
  (let ((margins (window-margins window))
        new)
    ;; unset the margins and try to split the window
132 133
    (when (buffer-local-value 'visual-fill-column-mode (window-buffer window))
      (set-window-margins window nil))
134 135 136 137 138
    (unwind-protect
        (setq new (split-window-sensibly window))
      (when (not new)
        (set-window-margins window (car margins) (cdr margins))))))

139 140
(defun visual-fill-column--adjust-window ()
  "Adjust the window margins and fringes."
141 142 143 144 145 146
  ;; Only run when we're really looking at a buffer that has v-f-c-mode enabled. See #22.
  (when (buffer-local-value 'visual-fill-column-mode (window-buffer (selected-window)))
    (set-window-fringes (get-buffer-window (current-buffer)) nil nil visual-fill-column-fringes-outside-margins)
    (if (>= emacs-major-version 25)
        (set-window-parameter (get-buffer-window (current-buffer)) 'split-window #'visual-fill-column-split-window))
    (visual-fill-column--set-margins)))
147

148 149 150 151 152 153 154 155
(defun visual-fill-column-adjust (&optional _inc)
  "Adjust the window margins and fringes.
This function is for use as advice to `text-scale-adjust'.  It
calls `visual-fill-column--adjust-window', but only if
`visual-fill-column' is active."
  (if visual-fill-column-mode
      (visual-fill-column--adjust-window)))

156 157 158 159
(defun visual-fill-column--window-max-text-width (&optional window)
  "Return the maximum possible text width of WINDOW.
The maximum possible text width is the width of the current text
area plus the margins, but excluding the fringes, scroll bar and
160 161 162
right divider.  WINDOW defaults to the selected window.  The
return value is scaled to account for `text-scale-mode-amount'
and `text-scale-mode-step'."
163
  (or window (setq window (get-buffer-window (current-buffer))))
164 165 166 167 168 169 170 171 172 173 174 175
  (let* ((margins (window-margins window))
         (buffer (window-buffer window))
         (scale (if (and (boundp 'text-scale-mode-step)
                         (boundp 'text-scale-mode-amount))
                    (with-current-buffer buffer
                      (expt text-scale-mode-step
                            text-scale-mode-amount))
                  1.0)))
    (truncate (/ (+ (window-width window)
                    (or (car margins) 0)
                    (or (cdr margins) 0))
                 (float scale)))))
176

177 178 179
(defun visual-fill-column--set-margins ()
  "Set window margins for the current window."
  ;; calculate left & right margins
180
  (let* ((window (get-buffer-window (current-buffer)))
181
         (total-width (visual-fill-column--window-max-text-width window))
182 183
         (width (or visual-fill-column-width
                    fill-column))
184 185 186
         (margins (if (< (- total-width width) 0) ; margins must be >= 0
                      0
                    (- total-width width)))
187 188 189 190 191 192
         (left (if visual-fill-column-center-text
                   (/ margins 2)
                 0))
         (right (if visual-fill-column-center-text
                    (/ margins 2)
                  margins)))
193

194 195 196 197 198
    ;; put an explicitly R2L buffer on the right side of the window
    (when (and (eq bidi-paragraph-direction 'right-to-left)
               (= left 0))
      (setq left right)
      (setq right 0))
199

200 201 202 203 204
    (set-window-margins window left right)))

(provide 'visual-fill-column)

;;; visual-fill-column.el ends here