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 'darkroom-guess-margins
  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. An example is
  66   `darkroom-guess-margins', which see.
  67
  68 Value is effective when `darkroom-mode' is toggled."
  69   :type '(choice float
  70                  (cons integer integer)
  71                  (function-item darkroom-guess-margins :doc "Guess margins")
  72                  (function darkroom-guess-margins))
  73   :group 'darkroom)
  74
  75 (defcustom darkroom-text-scale-increase 2
  76   "Steps to increase text size when in `darkroom-mode'.
  77 Value is passed to `text-scale-increase'."
  78   :type 'integer
  79   :group 'darkroom)
  80
  81 (defcustom darkroom-fringes-outside-margins t
  82   "If non-nil use fringes outside margins for `darkroom-mode'"
  83   :type 'boolean
  84   :group 'darkroom)
  85
  86 (defcustom darkroom-margin-increment 0.05
  87   "Increment to add used in `darkroom-increase-margins'."
  88   :type 'float
  89   :group 'darkroom)
  90
  91 (defcustom darkroom-margins-if-failed-guess 0.15
  92   "Margins when `darkroom-guess-margins' fails.
  93 If `darkroom-guess-margins' failed to figure out margins to
  94 center the text, use this percentage of window width for the
  95 symmetical margins."
  96   :type 'float
  97   :group 'darkroom)
  98
  99 (defun darkroom--real-window-width ()
 100   "Horrible hack to get the window width in characters.
 101 `window-width' ignores text scaling."
 102   (let ((inhibit-read-only t)
 103         (buffer-undo-list t)
 104         (truncate-lines nil)
 105         (truncate-partial-width-windows nil)
 106         (word-wrap t)
 107         (line-move-visual t))
 108     (save-excursion
 109       (with-silent-modifications
 110         (let ((begin (point)))
 111           (unwind-protect
 112               (progn
 113                 (insert (make-string 10000 ?!))
 114                 (save-excursion
 115                   (goto-char begin)
 116                   (next-line)
 117                   (backward-char)
 118                   (current-column)))
 119             (delete-region begin (point))))))))
 120
 121 (defun darkroom-guess-margins ()
 122   "Guess suitable margins for `darkroom-margins'.
 123 Collects some statistics about the buffer's line lengths, and
 124 apply a heuristic to figure out how wide to set the margins. If
 125 the buffer's paragraphs are mostly filled to `fill-column',
 126 margins should center it on the window, otherwise, margins of
 127 0.15 percent are used."
 128   (if visual-line-mode
 129       darkroom-margins-if-failed-guess
 130     (let* ((window-width (darkroom--real-window-width))
 131            (line-widths (save-excursion
 132                           (goto-char (point-min))
 133                           (cl-loop for start = (point)
 134                                    while (search-forward "\n"
 135                                                          20000
 136                                                          'no-error)
 137                                    for width = (- (point) start 1)
 138                                    unless (zerop width)
 139                                    collect width)))
 140            (_longest-width (cl-reduce #'max line-widths :initial-value 0))
 141            (top-quartile-avg
 142             (let ((n4 (/ (length line-widths) 4)))
 143               (/ (apply '+ (cl-subseq (sort line-widths '>) 0 n4)) n4))))
 144       (cond
 145        ((> top-quartile-avg
 146            window-width)
 147         (message "Long lines detected. Consider turning on `visual-line-mode'")
 148         darkroom-margins-if-failed-guess)
 149        ((> top-quartile-avg (* 0.9 fill-column))
 150         (let ((margin (truncate (/ (- window-width top-quartile-avg) 2))))
 151           (cons margin margin)))
 152        (t
 153         darkroom-margins-if-failed-guess)))))
 154
 155 (defun darkroom--compute-margins ()
 156   "Computes (LEFT . RIGHT) margins from `darkroom-margins'."
 157   (let ((darkroom-margins
 158          (if (functionp darkroom-margins)
 159              (funcall darkroom-margins)
 160            darkroom-margins)))
 161     (cond ((consp darkroom-margins)
 162            darkroom-margins)
 163           ((and (floatp darkroom-margins)
 164                 (< darkroom-margins 1))
 165            (let ((delta (darkroom--float-to-columns darkroom-margins)))
 166              (cons delta delta)))
 167           (t
 168            (error "Illegal value in `darkroom-margins'")))))
 169
 170 (defun darkroom--float-to-columns (f)
 171   (ceiling (* (let ((edges (window-edges)))
 172                 (- (nth 2 edges) (nth 0 edges)))
 173               f)))
 174
 175 (defvar darkroom--buffer-margins nil
 176   "Buffer-local version of `darkroom-margins' defcustom.
 177 Set by `darkroom--set-margins'")
 178
 179 (defun darkroom--set-margins (&optional margins)
 180   "Set margins from MARGINS or `darkroom--buffer-margins'."
 181   (let* ((window-configuration-change-hook nil))
 182     (when margins
 183       (when (null (car margins)) (setcar margins 0))
 184       (when (null (cdr margins)) (setcdr margins 0)))
 185     (set (make-local-variable 'darkroom--buffer-margins)
 186          (or margins darkroom--buffer-margins))
 187     (walk-windows #'(lambda (w)
 188                       (when (eq (window-buffer w) (current-buffer))
 189                         (setq fringes-outside-margins
 190                               darkroom-fringes-outside-margins)
 191                         ;; See description of
 192                         ;; `fringes-outside-margins' for the reason
 193                         ;; for this apparent noop
 194                         (set-window-buffer w (current-buffer))
 195                         (set-window-margins w (car darkroom--buffer-margins)
 196                                             (cdr darkroom--buffer-margins))))
 197                   nil
 198                   'all-frames)))
 199
 200 (defun darkroom-increase-margins (increment)
 201   "Increase darkroom margins by INCREMENT."
 202   (interactive (list darkroom-margin-increment))
 203   (unless (and (consp darkroom--buffer-margins)
 204                (numberp (car darkroom--buffer-margins))
 205                (numberp (cdr darkroom--buffer-margins)))
 206     (error "`darkroom--buffer-margins' corrupted. Must be a cons of numbers."))
 207   (setcar darkroom--buffer-margins
 208           (round (* (+ 1 increment) (car darkroom--buffer-margins))))
 209   (setcdr darkroom--buffer-margins
 210           (round (* (+ 1 increment) (cdr darkroom--buffer-margins))))
 211   (darkroom--set-margins darkroom--buffer-margins))
 212
 213 (defun darkroom-decrease-margins (decrement)
 214   "Decrease darkroom margins by DECREMENT."
 215   (interactive (list darkroom-margin-increment))
 216   (darkroom-increase-margins (- decrement)))
 217
 218 (defvar darkroom-mode-map
 219   (let ((map (make-sparse-keymap)))
 220     (define-key map (kbd "C-M-+") 'darkroom-increase-margins)
 221     (define-key map (kbd "C-M--") 'darkroom-decrease-margins)
 222     map))
 223
 224 (defvar darkroom--saved-mode-line-format nil
 225   "Mode line before `darkroom-mode' is turned on.")
 226 (defvar darkroom--saved-header-line-format nil
 227   "Header line before `darkroom-mode' is turned on.")
 228 (defvar darkroom--saved-margins nil
 229   "Margins before `darkroom-mode' is turned on.")
 230 ;; (defvar darkroom--saved-text-scale-mode-amount nil
 231 ;;   "Text scale before `darkroom-mode' is turned on.")
 232
 233 (defvar darkroom--tentative-mode-driving nil
 234   "Non-nil if `darkroom-tentative-mode' toggles
 235   `darkroom-mode'.")
 236
 237 (define-minor-mode darkroom-mode
 238   "Remove visual distractions and focus on writing. When this
 239 mode is active, everything but the buffer's text is elided from
 240 view. The buffer margins are set so that text is centered on
 241 screen. Text size is increased (display engine allowing) by
 242 `darkroom-text-scale-increase'." nil nil nil
 243   (when (and darkroom-tentative-mode
 244              (not darkroom--tentative-mode-driving))
 245     (error
 246      "Don't try to toggle `darkroom-mode' when in `darkroom-tentative-mode'"))
 247   (cond (darkroom-mode
 248          (set (make-local-variable 'darkroom--saved-margins) (window-margins))
 249          (set (make-local-variable 'darkroom--saved-mode-line-format)
 250               mode-line-format)
 251          (set (make-local-variable 'darkroom--saved-header-line-format)
 252               header-line-format)
 253          (setq mode-line-format nil)
 254          (setq header-line-format nil)
 255          (text-scale-increase darkroom-text-scale-increase)
 256          (darkroom--set-margins (darkroom--compute-margins))
 257          (add-hook 'window-configuration-change-hook 'darkroom--set-margins
 258                    t t))
 259         (t
 260          (setq mode-line-format darkroom--saved-mode-line-format
 261                header-line-format darkroom--saved-header-line-format)
 262          (text-scale-decrease darkroom-text-scale-increase)
 263          (let (darkroom--buffer-margins)
 264            (darkroom--set-margins darkroom--saved-margins))
 265          (remove-hook 'window-configuration-change-hook 'darkroom--set-margins
 266                       t))))
 267
 268 (defun darkroom--maybe-enable ()
 269   (let ((darkroom--tentative-mode-driving t))
 270     (cond ((and (not darkroom-mode) (= (count-windows) 1))
 271            (darkroom-mode 1))
 272           ((and darkroom-mode (> (count-windows) 1))
 273            (darkroom-mode -1))
 274           (t
 275            ;; (message "debug: buffer: %s windows: %s darkroom-mode: %s"
 276            ;;          (current-buffer) (count-windows) darkroom-mode)
 277            ))))
 278
 279
 280 (define-minor-mode darkroom-tentative-mode
 281   "Enters `darkroom-mode' when all other windows are deleted."
 282   nil " Room" nil
 283   (cond (darkroom-tentative-mode
 284          (add-hook 'window-configuration-change-hook
 285                    'darkroom--maybe-enable nil t)
 286          (darkroom--maybe-enable))
 287         (t
 288          (if darkroom-mode (darkroom-mode -1))
 289          (remove-hook 'window-configuration-change-hook
 290                       'darkroom--maybe-enable t))))
 291
 292
 293
 294 (provide 'darkroom)
 295 ;;; darkroom.el ends here