config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

visual-fill-column.el (17200B)


      1 ;;; visual-fill-column.el --- fill-column for visual-line-mode  -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2015-2024 Joost Kremers
      4 ;; Copyright (C) 2016 Martin Rudalics
      5 ;; All rights reserved.
      6 
      7 ;; Author: Joost Kremers <joostkremers@fastmail.fm>
      8 ;; Maintainer: Joost Kremers <joostkremers@fastmail.fm>
      9 ;; URL: https://codeberg.org/joostkremers/visual-fill-column
     10 ;; Created: 2015
     11 ;; Version: 2.6.3
     12 ;; Package-Requires: ((emacs "25.1"))
     13 
     14 ;; This file is NOT part of GNU Emacs.
     15 
     16 ;; visual-fill-column is free software: you can redistribute it and/or modify
     17 ;; it under the terms of the GNU General Public License as published by
     18 ;; the Free Software Foundation, either version 3 of the License, or
     19 ;; (at your option) any later version.
     20 
     21 ;; visual-fill-column is distributed in the hope that it will be useful,
     22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     24 ;; GNU General Public License for more details.
     25 
     26 ;; You should have received a copy of the GNU General Public License
     27 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
     28 
     29 ;;; Commentary:
     30 
     31 ;; `visual-fill-column-mode' is a small Emacs minor mode that mimics the effect
     32 ;; of `fill-column' in `visual-line-mode'.  Instead of wrapping lines at the
     33 ;; window edge, which is the standard behaviour of `visual-line-mode', it wraps
     34 ;; lines at `fill-column' (or `visual-fill-column-width', if set).  This is
     35 ;; accomplished by widening the margins, which narrows the text area.  When the
     36 ;; window size changes, the margins are adjusted automatically.
     37 ;;
     38 ;; When `visual-fill-column-center-text' is set, the text is centered in the
     39 ;; window.  This can also be used in combination with `auto-fill-mode' instead
     40 ;; of `visual-line-mode', or in programming modes.
     41 
     42 
     43 ;;; Code:
     44 
     45 (defgroup visual-fill-column nil "Wrap lines according to `fill-column'."
     46   :group 'text
     47   :prefix "visual-fill-column-")
     48 
     49 (defcustom visual-fill-column-width nil
     50   "Width of the text area.
     51 By default, the global value of `fill-column' is used, but if
     52 this option is set to a value, it is used instead."
     53   :group 'visual-fill-column
     54   :type '(choice (const :tag "Use `fill-column'" :value nil)
     55                  (integer :tag "Specify width" :value 70)))
     56 (make-variable-buffer-local 'visual-fill-column-width)
     57 (put 'visual-fill-column-width 'safe-local-variable 'numberp)
     58 
     59 (defcustom visual-fill-column-extra-text-width nil
     60   "Additional columns added to the text area.
     61 This is a cons cell of two numbers: the first is subtracted from
     62 the left margin, the second from the right margin.  This option
     63 can be used to accommodate, e.g,, line numbers, which would
     64 otherwise reduce the actual size of the text area."
     65   :group 'visual-fill-column
     66   :type '(choice (const :tag "No extra text width" :value nil)
     67                  (cons :tag "Extra text width"
     68                        (integer :tag "Extra width left ")
     69                        (integer :tag "Extra width right"))))
     70 (make-variable-buffer-local 'visual-fill-column-extra-text-width)
     71 
     72 (defcustom visual-fill-column-fringes-outside-margins t
     73   "Put the fringes outside the margins."
     74   :group 'visual-fill-column
     75   :type '(choice (const :tag "Put fringes outside the margins" t)
     76                  (const :tag "Keep the fringes inside the margins" nil)))
     77 (make-variable-buffer-local 'visual-fill-column-fringes-outside-margins)
     78 (put 'visual-fill-column-fringes-outside-margins 'safe-local-variable 'symbolp)
     79 
     80 (defcustom visual-fill-column-center-text nil
     81   "If set, center the text area in the window."
     82   :group 'visual-fill-column
     83   :type '(choice (const :tag "Display text area at window margin" nil)
     84                  (const :tag "Center text area" t)))
     85 (make-variable-buffer-local 'visual-fill-column-center-text)
     86 (put 'visual-fill-column-center-text 'safe-local-variable 'symbolp)
     87 
     88 (defcustom visual-fill-column-enable-sensible-window-split nil
     89   "Set `split-window-preferred-function' so as to allow vertical window splits.
     90 If this option is set, `visual-fill-column' sets the variable
     91 `split-window-preferred-function' to
     92 `visual-fill-column-split-window-sensibly', in order to allow
     93 `display-buffer' to split windows in two side-by-side windows."
     94   :group 'visual-fill-column
     95   :type '(choice (const :tag "Allow vertical window split" nil)
     96                  (const :tag "Use standard window split" t)))
     97 
     98 (defcustom visual-fill-column-adjust-for-text-scale t
     99   "Adjust the margins for text scaling.
    100 If set to t, the calculated margins are additionally adjusted for
    101 the text scale factor, so that the text is wrapped at
    102 `fill-column'."
    103   :group 'visual-fill-column
    104   :type '(choice (const :tag "Adjust margins for text scaling" t)
    105                  (const :tag "Do not adjust margins for text scaling" nil)))
    106 
    107 (defvar visual-fill-column--use-split-window-parameter nil "If set, the window parameter `split-window' is used.")
    108 
    109 (defvar visual-fill-column--use-min-margins nil "If set, the window parameter `min-margins' is used.")
    110 
    111 (defvar visual-fill-column-mode-map
    112   (let ((map (make-sparse-keymap)))
    113     (define-key map [right-margin mouse-1] (global-key-binding [mouse-1])) ; #'mouse-set-point
    114     (define-key map [right-margin mouse-2] (global-key-binding [mouse-2])) ; #'mouse-yank-primary
    115     (define-key map [right-margin mouse-3] (global-key-binding [mouse-3])) ; #'mouse-save-then-kill
    116     (define-key map [right-margin drag-mouse-1] #'ignore)
    117     (define-key map [right-margin drag-mouse-2] #'ignore)
    118     (define-key map [right-margin drag-mouse-3] #'ignore)
    119     (define-key map [right-margin double-mouse-1] #'ignore)
    120     (define-key map [right-margin double-mouse-2] #'ignore)
    121     (define-key map [right-margin double-mouse-3] #'ignore)
    122     (define-key map [right-margin triple-mouse-1] #'ignore)
    123     (define-key map [right-margin triple-mouse-2] #'ignore)
    124     (define-key map [right-margin triple-mouse-3] #'ignore)
    125     (define-key map [left-margin mouse-1] (global-key-binding [mouse-1])) ; #'mouse-set-point
    126     (define-key map [left-margin mouse-2] (global-key-binding [mouse-2])) ; #'mouse-yank-primary
    127     (define-key map [left-margin mouse-3] (global-key-binding [mouse-3])) ; #'mouse-save-then-kill
    128     (define-key map [left-margin drag-mouse-1] #'ignore)
    129     (define-key map [left-margin drag-mouse-2] #'ignore)
    130     (define-key map [left-margin drag-mouse-3] #'ignore)
    131     (define-key map [left-margin double-mouse-1] #'ignore)
    132     (define-key map [left-margin double-mouse-2] #'ignore)
    133     (define-key map [left-margin double-mouse-3] #'ignore)
    134     (define-key map [left-margin triple-mouse-1] #'ignore)
    135     (define-key map [left-margin triple-mouse-2] #'ignore)
    136     (define-key map [left-margin triple-mouse-3] #'ignore)
    137     (when (bound-and-true-p mouse-wheel-mode)
    138       (define-key map [right-margin mouse-wheel-down-event] #'mwheel-scroll)
    139       (define-key map [right-margin mouse-wheel-up-event] #'mwheel-scroll)
    140       (define-key map [left-margin mouse-wheel-down-event] #'mwheel-scroll)
    141       (define-key map [left-margin mouse-wheel-up-event] #'mwheel-scroll))
    142     map))
    143 
    144 ;;;###autoload
    145 (define-minor-mode visual-fill-column-mode
    146   "Soft-wrap lines according to `fill-column'.
    147 This minor mode narrows the text area.  Its primary use is in
    148 conjunction with `visual-line-mode', to enable soft word-wrapping
    149 of long lines, but it can also be used in other contexts, e.g.,
    150 to center the text in a window.  To activate it together with
    151 `visual-line-mode', it is usually best to use
    152 `visual-line-fill-column-mode'."
    153   :init-value nil :lighter nil :global nil
    154   (if visual-fill-column-mode
    155       (visual-fill-column-mode--enable)
    156     (visual-fill-column-mode--disable)))
    157 
    158 ;;;###autoload
    159 (define-globalized-minor-mode global-visual-fill-column-mode visual-fill-column-mode turn-on-visual-fill-column-mode
    160   :require 'visual-fill-column-mode
    161   :group 'visual-fill-column)
    162 
    163 ;;;###autoload
    164 (define-minor-mode visual-line-fill-column-mode
    165   "Enable `visual-line-mode' and soft-wrap lines according to `fill-column'.
    166 Use this mode to activate and deactivate `visual-line-mode' and
    167 `visual-fill-column-mode' in conjunction."
    168   :init-value nil :lighter nil :global nil
    169   (cond (visual-line-fill-column-mode
    170 	 (visual-fill-column-mode 1)
    171 	 (visual-line-mode 1))
    172 	(t
    173 	 (visual-fill-column-mode -1)
    174 	 (visual-line-mode -1))))
    175 
    176 (defun turn-on-visual-fill-column-mode ()
    177   "Turn on `visual-fill-column-mode'.
    178 Note that `visual-fill-column-mode' is only turned on in buffers
    179 that actually visit a file."
    180   (when buffer-file-name
    181     (visual-fill-column-mode 1)))
    182 
    183 (defun visual-fill-column-mode--enable ()
    184   "Set up `visual-fill-column-mode' for the current buffer."
    185   (add-hook 'window-configuration-change-hook #'visual-fill-column--adjust-window 'append 'local)
    186 
    187   (when visual-fill-column-enable-sensible-window-split
    188     ;; Note that `split-window-preferred-function' is not reset to its original
    189     ;; value when `visual-fill-column-mode' is disabled, because it may still be
    190     ;; enabled in other buffers.  When `visual-fill-column-mode' is disabled,
    191     ;; `visual-fill-column-split-window-sensibly' simply invokes
    192     ;; `split-window-sensibly', so keeping it is harmless.
    193     (setq-default split-window-preferred-function #'visual-fill-column-split-window-sensibly))
    194 
    195   (cond
    196    ((< emacs-major-version 27)
    197     (add-hook 'window-size-change-functions #'visual-fill-column--adjust-frame))
    198    ((= emacs-major-version 27)
    199     (add-hook 'window-size-change-functions #'visual-fill-column--adjust-window 'append 'local)
    200     (setq visual-fill-column--use-split-window-parameter t))
    201    ((> emacs-major-version 27)
    202     (add-hook 'window-state-change-functions #'visual-fill-column--adjust-window 'append 'local)
    203     (setq visual-fill-column--use-min-margins t)))
    204 
    205   (visual-fill-column--adjust-window (selected-window)))
    206 
    207 (defun visual-fill-column-mode--disable ()
    208   "Disable `visual-fill-column-mode' for the current buffer."
    209   (remove-hook 'window-configuration-change-hook #'visual-fill-column--adjust-window 'local)
    210 
    211   (let ((window (get-buffer-window (current-buffer))))
    212     (cond
    213      ((< emacs-major-version 27)
    214       (remove-hook 'window-size-change-functions #'visual-fill-column--adjust-frame))
    215      ((= emacs-major-version 27)
    216       (remove-hook 'window-size-change-functions #'visual-fill-column--adjust-window 'local))
    217      ((> emacs-major-version 27)
    218       (remove-hook 'window-state-change-functions #'visual-fill-column--adjust-window 'local)
    219       (set-window-parameter window 'min-margins nil)))
    220     (set-window-margins window 0 0)
    221     (set-window-fringes window nil)))
    222 
    223 (defun visual-fill-column-split-window (&optional window size side)
    224   "Split WINDOW, unsetting its margins first.
    225 SIZE, and SIDE are passed on to `split-window'.  This function is
    226 for use in the window parameter `split-window'."
    227   ;; Note: `split-window' has another optional argument, `pixelwise', but this
    228   ;; is not passed to the function in the `split-window' window parameter.
    229   (let ((horizontal (memq side '(t left right)))
    230 	margins new)
    231     (when horizontal
    232       ;; Reset margins.
    233       (setq margins (window-margins window))
    234       (set-window-margins window nil))
    235     ;; Now try to split the window.
    236     (set-window-parameter window 'split-window nil)
    237     (unwind-protect
    238 	(setq new (split-window window size side))
    239       (set-window-parameter window 'split-window #'visual-fill-column-split-window)
    240       ;; Restore old margins if we failed.
    241       (when (and horizontal (not new))
    242 	(set-window-margins window (car margins) (cdr margins))))))
    243 
    244 ;;;###autoload
    245 (defun visual-fill-column-split-window-sensibly (&optional window)
    246   "Split WINDOW sensibly, unsetting its margins first.
    247 This function unsets the window margins and calls
    248 `split-window-sensibly'.
    249 
    250 By default, `split-window-sensibly' does not split a window in
    251 two side-by-side windows if it has wide margins, even if there is
    252 enough space for a vertical split.  This function is used as the
    253 value of `split-window-preferred-function' to allow
    254 `display-buffer' to split such windows."
    255   (let ((margins (window-margins window))
    256         new)
    257     ;; unset the margins and try to split the window
    258     (when (buffer-local-value 'visual-fill-column-mode (window-buffer window))
    259       (set-window-margins window nil))
    260     (unwind-protect
    261         (setq new (split-window-sensibly window))
    262       (when (not new)
    263         (set-window-margins window (car margins) (cdr margins))))))
    264 
    265 (defun visual-fill-column--reset-window (window)
    266   "Reset the parameters and margins of WINDOW."
    267   (set-window-parameter window 'split-window nil)
    268   (set-window-parameter window 'min-margins nil)
    269   (set-window-margins window nil))
    270 
    271 (defun visual-fill-column--adjust-window (&optional window)
    272   "Adjust the margins and fringes of WINDOW.
    273 WINDOW defaults to the selected window.  This function only
    274 adjusts the margins and fringes if the buffer displayed in the
    275 selected window has `visual-fill-column-mode' enabled."
    276   (or window (setq window (selected-window)))
    277   (with-selected-window window
    278     (visual-fill-column--reset-window window)
    279     (when visual-fill-column-mode
    280       (set-window-fringes window nil nil visual-fill-column-fringes-outside-margins)
    281       (if visual-fill-column--use-split-window-parameter
    282           (set-window-parameter window 'split-window #'visual-fill-column-split-window))
    283       (if visual-fill-column--use-min-margins  ; This is non-nil if the window parameter `min-margins' is used (Emacs 27.2).
    284           (set-window-parameter window 'min-margins '(0 . 0)))
    285       (visual-fill-column--set-margins window))))
    286 
    287 (defun visual-fill-column--adjust-frame (frame)
    288   "Adjust the windows on FRAME.
    289 This function is added to `window-size-change-functions' in older
    290 Emacsen (before 27.1), in which the functions in this hook are
    291 passed the frame as argument."
    292   (dolist (window (window-list frame))
    293     (visual-fill-column--adjust-window window)))
    294 
    295 (defun visual-fill-column-adjust (&optional _inc)
    296   "Adjust the window margins and fringes.
    297 This function is for use as advice to `text-scale-adjust'.  It
    298 calls `visual-fill-column--adjust-window', but only if
    299 `visual-fill-column' is active."
    300   (if visual-fill-column-mode
    301       (visual-fill-column--adjust-window (selected-window))))
    302 
    303 (defun visual-fill-column--window-max-text-width (&optional window)
    304   "Return the maximum possible text width of WINDOW.
    305 The maximum possible text width is the width of the current text
    306 area plus the margins, but excluding the fringes, scroll bar, and
    307 right divider.  WINDOW defaults to the selected window.  The
    308 return value is scaled to account for `text-scale-mode-amount'
    309 and `text-scale-mode-step'."
    310   (or window (setq window (selected-window)))
    311   (let* ((margins (window-margins window))
    312          (buffer (window-buffer window))
    313          (scale (if (and visual-fill-column-adjust-for-text-scale
    314                          (boundp 'text-scale-mode-step)
    315                          (boundp 'text-scale-mode-amount))
    316                     (with-current-buffer buffer
    317                       (expt text-scale-mode-step
    318                             text-scale-mode-amount))
    319                   1.0))
    320          (remap-scale
    321           (if (>= emacs-major-version 29)
    322               (/ (window-width window 'remap) (float (window-width window)))
    323             1.0)))
    324     (truncate (/ (+ (window-width window (and (>= emacs-major-version 29) 'remap))
    325                     (* (or (car margins) 0) remap-scale)
    326                     (* (or (cdr margins) 0) remap-scale))
    327                  (float scale)))))
    328 
    329 (defun visual-fill-column--add-extra-width (left right add-width)
    330   "Calculate new margins given additional text width.
    331 LEFT and RIGHT are the current margins, ADD-WIDTH a cons cell of
    332 additional columns to be added to the text area.  Return a cons
    333 cell of the new margins, which will never be less than zero."
    334   (cons (max 0 (- left (car add-width)))
    335         (max 0 (- right (cdr add-width)))))
    336 
    337 (defun visual-fill-column--set-margins (window)
    338   "Set window margins for WINDOW."
    339   ;; Calculate left & right margins.
    340   (let* ((total-width (visual-fill-column--window-max-text-width window))
    341          (remap-scale
    342           (if (>= emacs-major-version 29)
    343               (/ (window-width window 'remap) (float (window-width window)))
    344             1.0))
    345          (width (or visual-fill-column-width
    346                     fill-column))
    347          (margins (if (< (- total-width width) 0) ; margins must be >= 0
    348                       0
    349                     (round (/ (- total-width width) remap-scale))))
    350          (left (if visual-fill-column-center-text
    351                    (/ margins 2)
    352                  0))
    353          (right (- margins left)))
    354 
    355     (if visual-fill-column-extra-text-width
    356         (let ((add-width (visual-fill-column--add-extra-width left right visual-fill-column-extra-text-width)))
    357           (setq left (car add-width)
    358                 right (cdr add-width))))
    359 
    360     ;; put an explicitly R2L buffer on the right side of the window
    361     (when (and (eq bidi-paragraph-direction 'right-to-left)
    362                (= left 0))
    363       (setq left right)
    364       (setq right 0))
    365 
    366     (set-window-margins window left right)))
    367 
    368 (provide 'visual-fill-column)
    369 
    370 ;;; visual-fill-column.el ends here