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