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

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