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 ;; The first makes current buffer to enter `darkroom-mode'
  31 ;; immediately: keeping the window configuration untouched, text is
  32 ;; enlarged, centered on the window with margins, and the modeline is
  33 ;; elided.
  34 ;;
  35 ;; The second, `darkroom-tentative-mode', makes the current buffer
  36 ;; turn on `darkroom-mode' whenever all other windows are deleted,
  37 ;; i.e. the buffer is solo on the current Emacs frame. Whenever the
  38 ;; window is split to display some other buffer, the original buffer's
  39 ;; configuration is reset.
  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 (defgroup darkroom nil
  49   "Remove visual distractions and focus on writing"
  50   :prefix "darkroom-"
  51   :group 'emulations)
  52
  53 (defcustom darkroom-margins 0.15
  54   "Margins to use in `darkroom-mode'.
  55
  56 Its value can be:
  57
  58 - a floating point value betweeen 0 and 1, specifies percentage of
  59   window width in columns to use as a margin.
  60
  61 - a cons cell (LEFT RIGHT) specifying the left and right margins
  62   in columns.
  63
  64 - a function of no arguments that returns a cons cell interpreted
  65   like the previous option.
  66
  67 Value is effective when `darkroom-mode' is toggled, when
  68 changing window or by calling `darkroom--set-margins'"
  69   :type 'float
  70   :group 'darkroom)
  71
  72 (defcustom darkroom-text-scale-increase 2
  73   "Steps to increase text size when in `darkroom-mode'.
  74 Value is passed to `text-scale-increase'."
  75   :type 'integer
  76   :group 'darkroom)
  77
  78 (defcustom darkroom-fringes-outside-margins t
  79   "If non-nil use fringes outside margins for `darkroom-mode'"
  80   :type 'boolean
  81   :group 'darkroom)
  82
  83 (defcustom darkroom-margin-increment 0.05
  84   "Increment to add used in `darkroom-increase-margins'."
  85   :type 'float
  86   :group 'darkroom)
  87
  88 (defun darkroom-guess-margins ()
  89   "Guess suitable margins for `darkroom-margins'.
  90 Collects some statistics about the buffer's line lengths, and
  91 apply a heuristic to figure out how wide to set the margins. If
  92 the buffer's paragraphs are mostly filled to `fill-column',
  93 margins should center it on the window, otherwise, margins of
  94 0.15 percent are used."
  95   ;;; FIXME: broken when darkroom-text-scale-increase is anything but
  96   ;;; 0, since window-width ignores text scaling. Otherwise, a
  97   ;;; suitable default to put in `darkroom-margins', I guess.
  98   (if visual-line-mode
  99       0.15
 100     (let* ((window-width (window-width))
 101            (line-widths (save-excursion
 102                           (goto-char (point-min))
 103                           (cl-loop for start = (point)
 104                                    while (search-forward "\n"
 105                                                          20000
 106                                                          'no-error)
 107                                    for width = (- (point) start 1)
 108                                    unless (zerop width)
 109                                    collect width)))
 110            (_longest-width (cl-reduce #'max line-widths :initial-value 0))
 111            (top-quartile-avg (cl-loop with n = (/ (length line-widths)
 112                                                   4)
 113                                       for width in (copy-sequence
 114                                                     (sort line-widths #'>))
 115                                       for i from 1 upto n
 116                                       sum width into total
 117                                       finally (return (/ total n 1.0)))))
 118       (cond
 119        ((> top-quartile-avg
 120            window-width)
 121         (when (y-or-n-p
 122                (format
 123                 (mapconcat
 124                  #'identity
 125                  '("Long lines detected!"
 126                    "(top 25%% average %s chars and window-width is %s)"
 127                    "Perhaps turn on visual-line-mode for a better darkroom?")
 128                  "\n")
 129                 top-quartile-avg window-width))
 130           (visual-line-mode 1))
 131         0.15)
 132        ((> top-quartile-avg (* 0.9 fill-column))
 133         (let ((margin (round (/ (- window-width top-quartile-avg) 2))))
 134           (cons margin margin)))
 135        (t
 136         0.15)))))
 137
 138 (defun darkroom--compute-margins ()
 139   (let ((darkroom-margins
 140          (if (functionp darkroom-margins)
 141              (funcall darkroom-margins)
 142            darkroom-margins)))
 143     (cond ((consp darkroom-margins)
 144            darkroom-margins)
 145           ((and (floatp darkroom-margins)
 146                 (< darkroom-margins 1))
 147            (let ((delta (darkroom--float-to-columns darkroom-margins)))
 148              (cons delta delta)))
 149           (t
 150            (error "Illegal value in `darkroom-margins'")))))
 151
 152 (defun darkroom--float-to-columns (f)
 153   (ceiling (* (let ((edges (window-edges)))
 154                 (- (nth 2 edges) (nth 0 edges)))
 155               f)))
 156
 157 (defvar darkroom--buffer-margins nil
 158   "Buffer-local version of `darkroom-margins' defcustom.
 159 Set by `darkroom--set-margins'")
 160
 161 (defun darkroom--set-margins (&optional margins)
 162   "Set margins from MARGINS or `darkroom--buffer-margins'."
 163   (let* ((window-configuration-change-hook nil))
 164     (when margins
 165       (when (null (car margins)) (setcar margins 0))
 166       (when (null (cdr margins)) (setcdr margins 0)))
 167     (set (make-local-variable 'darkroom--buffer-margins)
 168          (or margins darkroom--buffer-margins))
 169     (walk-windows #'(lambda (w)
 170                       (when (eq (window-buffer w) (current-buffer))
 171                         (setq fringes-outside-margins
 172                               darkroom-fringes-outside-margins)
 173                         ;; See description of
 174                         ;; `fringes-outside-margins' for the reason
 175                         ;; for this apparent noop
 176                         (set-window-buffer w (current-buffer))
 177                         (set-window-margins w (car darkroom--buffer-margins)
 178                                             (cdr darkroom--buffer-margins))))
 179                   nil
 180                   'all-frames)))
 181
 182 (defun darkroom-increase-margins (increment)
 183   "Increase darkroom margins by INCREMENT."
 184   (interactive (list darkroom-margin-increment))
 185   (unless (and (consp darkroom--buffer-margins)
 186                (numberp (car darkroom--buffer-margins))
 187                (numberp (cdr darkroom--buffer-margins)))
 188     (error "`darkroom--buffer-margins' corrupted. Must be a cons of numbers."))
 189   (setcar darkroom--buffer-margins
 190           (round (* (+ 1 increment) (car darkroom--buffer-margins))))
 191   (setcdr darkroom--buffer-margins
 192           (round (* (+ 1 increment) (cdr darkroom--buffer-margins))))
 193   (darkroom--set-margins darkroom--buffer-margins))
 194
 195 (defun darkroom-decrease-margins (decrement)
 196   "Decrease darkroom margins by DECREMENT."
 197   (interactive (list darkroom-margin-increment))
 198   (darkroom-increase-margins (- decrement)))
 199
 200 (defvar darkroom-mode-map
 201   (let ((map (make-sparse-keymap)))
 202     (define-key map (kbd "C-M-+") 'darkroom-increase-margins)
 203     (define-key map (kbd "C-M--") 'darkroom-decrease-margins)
 204     map))
 205
 206 (defvar darkroom--saved-mode-line-format nil)
 207 (defvar darkroom--saved-header-line-format nil)
 208 (defvar darkroom--saved-margins nil)
 209
 210 (define-minor-mode darkroom-mode
 211   "Remove visual distractions and focus on writing. When this
 212 mode is active, everything but the buffer's text is elided from
 213 view. The buffer margins are set so that text is centered on
 214 screen. Text size is increased (display engine allowing) by
 215 `darkroom-text-scale-increase'." nil nil nil
 216   (cond (darkroom-mode
 217          (set (make-local-variable 'darkroom--saved-margins) (window-margins))
 218          (set (make-local-variable 'darkroom--saved-mode-line-format)
 219               mode-line-format)
 220          (set (make-local-variable 'darkroom--saved-header-line-format)
 221               header-line-format)
 222          (setq mode-line-format nil)
 223          (setq header-line-format nil)
 224          (text-scale-increase darkroom-text-scale-increase)
 225          (darkroom--set-margins (darkroom--compute-margins))
 226          (add-hook 'window-configuration-change-hook 'darkroom--set-margins
 227                    nil t))
 228         (t
 229          (setq mode-line-format darkroom--saved-mode-line-format
 230                header-line-format darkroom--saved-header-line-format)
 231          (text-scale-decrease darkroom-text-scale-increase)
 232          (let (darkroom--buffer-margins)
 233            (darkroom--set-margins darkroom--saved-margins))
 234          (remove-hook 'window-configuration-change-hook 'darkroom--set-margins
 235                       t))))
 236
 237 (defun darkroom--maybe-enable ()
 238   (cond ((and (not darkroom-mode) (= (count-windows) 1))
 239          (darkroom-mode 1))
 240         ((and darkroom-mode (> (count-windows) 1))
 241          (darkroom-mode -1))
 242         (t
 243          ;; (message "debug: buffer: %s windows: %s darkroom-mode: %s"
 244          ;;          (current-buffer) (count-windows) darkroom-mode)
 245          )))
 246
 247
 248 (define-minor-mode darkroom-tentative-mode
 249   "Minor mode that enters `darkroom-mode' when all windws are deleted"
 250   nil "DarkroomT" nil
 251   (cond (darkroom-tentative-mode
 252          (add-hook 'window-configuration-change-hook
 253                    'darkroom--maybe-enable nil t)
 254          (darkroom--maybe-enable))
 255         (t
 256          (if darkroom-mode (darkroom-mode -1))
 257          (remove-hook 'window-configuration-change-hook
 258                       'darkroom--maybe-enable t))))
 259
 260
 261
 262 (provide 'darkroom)
 263 ;;; darkroom.el ends here