code.delx.au - gnu-emacs-elpa/blob - packages/darkroom/darkroom.el

   1 ;;; darkroom.el --- Remove visual distractions and focus on writing  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2014  Free Software Foundation, Inc.
   4
   5 ;; Author: João Távora <joaotavora@gmail.com>
   6 ;; Maintainer: João Távora <joaotavora@gmail.com>
   7 ;; Keywords: convenience, emulations
   8 ;; Package-Requires: ((cl-lib "0.5"))
   9 ;; Version: 0.1
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; The main entrypoints to this extension are two minor modes:
  27 ;;
  28 ;;    M-x darkroom-mode
  29 ;;    M-x darkroom-tentative-mode
  30 ;;
  31 ;; `darkroom-mode' makes visual distractions disappear: the
  32 ;; mode-line is temporarily elided, text is enlarged and margins are
  33 ;; adjusted so that it's centered on the window.
  34 ;;
  35 ;; `darkroom-tentative-mode' is similar, but it doesn't immediately
  36 ;; turn-on `darkroom-mode', unless the current buffer lives in the
  37 ;; sole window of the Emacs frame (i.e. all other windows are
  38 ;; deleted). Whenever the frame is split to display more windows and
  39 ;; more buffers, the buffer exits `darkroom-mode'. Whenever they are
  40 ;; deleted, the buffer re-enters `darkroom-mode'.
  41 ;;
  42 ;; Personally, I always use `darkroom-tentative-mode'.
  43 ;;
  44 ;; See also the customization options `darkroom-margins' and
  45 ;; `darkroom-fringes-outside-margins', which affect both modes.
  46
  47 ;;; Code:
  48
  49 (require 'cl-lib)
  50
  51 (defgroup darkroom nil
  52   "Remove visual distractions and focus on writing"
  53   :prefix "darkroom-"
  54   :group 'emulations)
  55
  56 (defcustom darkroom-margins 'darkroom-guess-margins
  57   "Margins to use in `darkroom-mode'.
  58
  59 Its value can be:
  60
  61 - a floating point value betweeen 0 and 1, specifies percentage of
  62   window width in columns to use as a margin.
  63
  64 - a cons cell (LEFT RIGHT) specifying the left and right margins
  65   in columns.
  66
  67 - a function of a single argument, a window, that returns a cons
  68   cell interpreted like the previous option. An example is
  69   `darkroom-guess-margins', which see. Beware that this function
  70   is called very often, so if it does some non-trivial processing
  71   on the buffer's text, consider caching that value.
  72
  73 Value is effective when `darkroom-mode' is toggled."
  74   :type '(choice float
  75                  (cons integer integer)
  76                  (function-item darkroom-guess-margins :doc "Guess margins")
  77                  (function darkroom-guess-margins))
  78   :group 'darkroom)
  79
  80 (defcustom darkroom-text-scale-increase 2
  81   "Steps to increase text size when in `darkroom-mode'.
  82 Value is passed to `text-scale-increase'."
  83   :type 'integer
  84   :group 'darkroom)
  85
  86 (defcustom darkroom-fringes-outside-margins t
  87   "If non-nil use fringes outside margins for `darkroom-mode'"
  88   :type 'boolean
  89   :group 'darkroom)
  90
  91 (defcustom darkroom-margin-increment 0.05
  92   "Increment to add used in `darkroom-increase-margins'."
  93   :type 'float
  94   :group 'darkroom)
  95
  96 (defcustom darkroom-margins-if-failed-guess 0.15
  97   "Margins when `darkroom-guess-margins' fails.
  98 If `darkroom-guess-margins' failed to figure out margins to
  99 center the text, use this percentage of window width for the
 100 symmetical margins."
 101   :type 'float
 102   :group 'darkroom)
 103
 104 (defcustom darkroom-verbose nil
 105   "If non-nil, be verbose about darkroom operations."
 106   :type 'boolean
 107   :group 'darkroom)
 108
 109 (defvar darkroom--guess-margins-statistics-cache nil
 110   "Cache used by `darkroom-guess-margins'.")
 111
 112 (defun darkroom--window-width (&optional window)
 113   "Calculate width of WINDOW in columns, considering text scaling.
 114 WINDOW defaults to the currently selected window. The function
 115 assumes the buffer to be filled with at least one character of an
 116 arbitrary, but fixed width. Narrowing is taken in consideration.
 117 The return value is a cons (COLS . SCALED-CHAR-WIDTH) where COLS
 118 is the desired width in columns and SCALED-CHAR-WIDTH is the
 119 width in pixels of a single character."
 120   (when (= (point-min) (point-max))
 121     (error "Cannot calculate the width of a single character"))
 122   (let* ((window (or window (selected-window)))
 123          (scaled-char-width (car (window-text-pixel-size
 124                                   window
 125                                   (point-min) (1+ (point-min)))))
 126          (char-width (frame-char-width))
 127          (margins (window-margins window)))
 128     (cons (truncate
 129            (+ (window-width window 'pixelwise)
 130               (* char-width (or (car margins) 0))
 131               (* char-width (or (cdr margins) 0)))
 132            scaled-char-width)
 133           scaled-char-width)))
 134
 135 (defun darkroom-guess-margins (window)
 136   "Guess suitable margins for `darkroom-margins'.
 137 If in suitable conditions, collect some statistics about the
 138 buffer's line lengths, and apply a heuristic to figure out how
 139 wide to set the margins, comparing it to WINDOW's width in
 140 columns. If the buffer's paragraphs are mostly filled to
 141 `fill-column', margins should center it on the window, otherwise,
 142 the margins specified in `darkroom-margins-if-failed-guess'.
 143
 144 In any of these conditions,`darkroom-margins-if-failed-guess' is
 145 also used:
 146
 147 * if `visual-line-mode' is on;
 148 * if `variable-pitch-mode' is on;
 149 * if the buffer is empty.
 150
 151 For testing purposes, WINDOW can also be an integer number which
 152 is a width in columns, in which case it will be used instead of a
 153 window's geometry."
 154   (if (or visual-line-mode
 155           (and buffer-face-mode
 156                (eq 'variable-pitch buffer-face-mode-face))
 157           (= (point-min) (point-max)))
 158       darkroom-margins-if-failed-guess
 159     (let* ((window-width-info (if (integerp window)
 160                                   window
 161                                 (darkroom--window-width window)))
 162            (window-width (car window-width-info))
 163            (scaled-char-width (cdr window-width-info))
 164            (top-quartile-avg
 165             (or darkroom--guess-margins-statistics-cache
 166                 (set
 167                  (make-local-variable 'darkroom--guess-margins-statistics-cache)
 168                  (let* ((line-widths
 169                          (save-excursion
 170                            (goto-char (point-min))
 171                            (cl-loop for start = (point)
 172                                     while (search-forward "\n"
 173                                                           20000
 174                                                           'no-error)
 175                                     for width = (truncate
 176                                                  (car
 177                                                   (window-text-pixel-size
 178                                                    window
 179                                                    start (1- (point))))
 180                                                  scaled-char-width)
 181                                     unless (zerop width)
 182                                     collect width)))
 183                         (n4 (max 1 (/ (length line-widths) 4))))
 184                    (/ (apply '+ (cl-subseq (sort line-widths '>) 0 n4)) n4))))))
 185       (cond
 186        ((> top-quartile-avg
 187            window-width)
 188         (message "Long lines detected. Consider turning on `visual-line-mode'")
 189         darkroom-margins-if-failed-guess)
 190        ((> top-quartile-avg (* 0.9 fill-column))
 191         ;; calculate margins so that `fill-column' + 1 colums are
 192         ;; centered on the window.
 193         ;;
 194         (let ((margin (truncate (* (- window-width (1+ fill-column))
 195                                    (/ (float scaled-char-width)
 196                                       (frame-char-width)))
 197                                 2)))
 198           (if darkroom-verbose
 199               (message "Choosing %s-wide margins based on fill-column %s"
 200                        margin fill-column))
 201           (cons margin margin)))
 202        (t
 203         darkroom-margins-if-failed-guess)))))
 204
 205 (defun darkroom--compute-margins (window)
 206   "From `darkroom-margins', computes desired margins for WINDOW."
 207   (let ((darkroom-margins
 208          (if (functionp darkroom-margins)
 209              (funcall darkroom-margins window)
 210            darkroom-margins)))
 211     (cond ((consp darkroom-margins)
 212            darkroom-margins)
 213           ((and (floatp darkroom-margins)
 214                 (< darkroom-margins 1))
 215            (let ((delta (darkroom--float-to-columns darkroom-margins)))
 216              (cons delta delta)))
 217           (t
 218            (error "Illegal value in `darkroom-margins'")))))
 219
 220 (defun darkroom--float-to-columns (f)
 221   (ceiling (* (let ((edges (window-edges)))
 222                 (- (nth 2 edges) (nth 0 edges)))
 223               f)))
 224
 225 (defvar darkroom--margin-factor 1
 226   "Buffer local factor affecting `darkroom--set-margins'")
 227
 228 (defun darkroom--set-margins ()
 229   "Set darkroom margins for currently selected window"
 230   (let* ((window-configuration-change-hook nil)
 231          (window (selected-window))
 232          (margins (darkroom--compute-margins window)))
 233     ;; See description of
 234     ;; `fringes-outside-margins' for the reason
 235     ;; for this apparent noop
 236     (set-window-buffer window (current-buffer))
 237     (set-window-margins window
 238                         (round
 239                          (* darkroom--margin-factor
 240                             (car margins)))
 241                         (round
 242                          (* darkroom--margin-factor
 243                             (cdr margins))))))
 244
 245 (defun darkroom--reset-margins ()
 246   "Reset darkroom margins for currently selected window."
 247   (set-window-margins (selected-window) 0 0))
 248
 249 (defun darkroom-increase-margins (increment)
 250   "Increase darkroom margins by INCREMENT."
 251   (interactive (list darkroom-margin-increment))
 252   (set (make-local-variable 'darkroom--margin-factor)
 253        (* darkroom--margin-factor (+ 1 increment)))
 254   (mapc #'(lambda (w)
 255             (with-selected-window w
 256               (darkroom--set-margins)))
 257         (get-buffer-window-list (current-buffer))))
 258
 259 (defun darkroom-decrease-margins (decrement)
 260   "Decrease darkroom margins by DECREMENT."
 261   (interactive (list darkroom-margin-increment))
 262   (darkroom-increase-margins (- decrement)))
 263
 264 (defvar darkroom-mode-map
 265   (let ((map (make-sparse-keymap)))
 266     (define-key map (kbd "C-M-+") 'darkroom-increase-margins)
 267     (define-key map (kbd "C-M--") 'darkroom-decrease-margins)
 268     map))
 269
 270 (defconst darkroom--saved-variables
 271   '(mode-line-format
 272     header-line-format
 273     fringes-outside-margins)
 274   "Variables saved in `darkroom--saved-state'")
 275
 276 (defvar darkroom--saved-state nil
 277   "Saved state before `darkroom-mode' is turned on.
 278 Alist of (VARIABLE . BEFORE-VALUE)")
 279
 280 ;; (defvar darkroom--saved-text-scale-mode-amount nil
 281 ;;   "Text scale before `darkroom-mode' is turned on.")
 282
 283 (defun darkroom--enter (&optional just-margins)
 284   "Save current state and enter darkroom for the current buffer.
 285 With optional JUST-MARGINS, just set the margins."
 286   (unless just-margins
 287     (setq darkroom--saved-state
 288           (mapcar #'(lambda (sym)
 289                       (cons sym (buffer-local-value sym (current-buffer))))
 290                   darkroom--saved-variables))
 291     (setq mode-line-format nil
 292           header-line-format nil
 293           fringes-outside-margins darkroom-fringes-outside-margins)
 294     (text-scale-increase darkroom-text-scale-increase))
 295   (mapc #'(lambda (w)
 296             (with-selected-window w
 297               (darkroom--set-margins)))
 298         (get-buffer-window-list (current-buffer))))
 299
 300 (defun darkroom--leave ()
 301   "Undo the effects of `darkroom--enter'."
 302   (mapc #'(lambda (pair)
 303             (set (make-local-variable (car pair)) (cdr pair)))
 304         darkroom--saved-state)
 305   (setq darkroom--saved-state nil)
 306   (text-scale-decrease darkroom-text-scale-increase)
 307   (mapc #'(lambda (w)
 308             (with-selected-window w
 309               (darkroom--reset-margins)))
 310         (get-buffer-window-list (current-buffer))))
 311
 312 (defun darkroom--enter-or-leave ()
 313   "Enter or leave darkroom according to window configuration."
 314   (cond ((= (count-windows) 1)
 315          (darkroom--enter darkroom--saved-state))
 316         (darkroom--saved-state
 317          (darkroom--leave))
 318         (t
 319          ;; for clarity, don't do anything
 320          )))
 321
 322 (declare-function darkroom-tentative-mode "darkroom" t)
 323
 324 ;;;###autoload
 325 (define-minor-mode darkroom-mode
 326   "Remove visual distractions and focus on writing. When this
 327 mode is active, everything but the buffer's text is elided from
 328 view. The buffer margins are set so that text is centered on
 329 screen. Text size is increased (display engine allowing) by
 330 `darkroom-text-scale-increase'." nil nil nil
 331   (when darkroom-tentative-mode
 332     (display-warning
 333      'darkroom
 334      (concat "Turning off `darkroom-tentative-mode' first. "
 335              "It doesn't go with `darkroom-mode'.")
 336      (let ((darkroom-mode nil))
 337        (darkroom-tentative-mode -1))))
 338   (cond (darkroom-mode
 339          (darkroom--enter)
 340          (add-hook 'window-configuration-change-hook 'darkroom--set-margins
 341                    t t))
 342         (t
 343          (darkroom--leave)
 344          (remove-hook 'window-configuration-change-hook 'darkroom--set-margins
 345                       t))))
 346
 347 ;;;###autoload
 348 (define-minor-mode darkroom-tentative-mode
 349   "Enters `darkroom-mode' when all other windows are deleted."
 350   nil " Room" darkroom-mode-map
 351   ;; always begin by removing the hook
 352   ;;
 353   (remove-hook 'window-configuration-change-hook
 354                'darkroom--enter-or-leave 'local)
 355   (when darkroom-mode
 356     (display-warning
 357      'darkroom
 358      (concat "Turning off `darkroom-mode' first. "
 359              "It doesn't go with `darkroom-tentative-mode'.")
 360      (let ((darkroom-tentative-mode nil))
 361        (darkroom-mode -1))))
 362   ;; turn darkroom on or off according to window state
 363   ;;
 364   (cond (darkroom-tentative-mode
 365          ;; re-add the hook when we are turning ourselves on
 366          ;;
 367          (add-hook 'window-configuration-change-hook
 368                    'darkroom--enter-or-leave 'append 'local)
 369          ;; call this right away if we're supposed to turn darkroom on
 370          ;; immediately.
 371          ;;
 372          (darkroom--enter-or-leave))
 373         (t
 374          (darkroom--leave))))
 375
 376
 377 (provide 'darkroom)
 378 ;;; darkroom.el ends here