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 ;; Version: 0.1
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; The main entrypoints to this extension are two minor modes
  25 ;;
  26 ;;    M-x darkroom-mode
  27 ;;    M-x darkroom-tentative-mode
  28 ;;
  29 ;; The first makes current buffer to enter `darkroom-mode'
  30 ;; immediately: keeping the window configuration untouched, text is
  31 ;; enlarged, centered on the window with margins, and the modeline is
  32 ;; elided.
  33 ;;
  34 ;; The second, `darkroom-tentative-mode', makes the current buffer
  35 ;; turn on `darkroom-mode' whenever all other windows are deleted,
  36 ;; i.e. the buffer is solo on the current Emacs frame. Whenever the
  37 ;; window is split to display some other buffer, the original buffer's
  38 ;; configuration is reset.
  39 ;;
  40 ;; Personally, I always use `darkroom-tentative-mode'.
  41 ;;
  42 ;; See also the customization options `darkroom-margins' and
  43 ;; `darkroom-fringes-outside-margins', which affect both modes.
  44
  45 ;;; Code:
  46
  47 (defgroup darkroom nil
  48   "Remove visual distractions and focus on writing"
  49   :prefix "darkroom-"
  50   :group 'emulations)
  51
  52 (defcustom darkroom-margins 0.15
  53   "Margins to use in `darkroom-mode'.
  54
  55 Its value can be:
  56
  57 - a floating point value betweeen 0 and 1, specifies percentage of
  58   window width in columns to use as a margin.
  59
  60 - a cons cell (LEFT RIGHT) specifying the left and right margins
  61   in columns.
  62
  63 - a function of no arguments that returns a cons cell interpreted
  64   like the previous option.
  65
  66 Value is effective when `darkroom-mode' is toggled, when
  67 changing window or by calling `darkroom-set-margins'"
  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-compute-margins ()
  88   (or darkroom-buffer-margins
  89       (cond ((functionp darkroom-margins)
  90              (funcall darkroom-margins))
  91             ((consp darkroom-margins)
  92              darkroom-margins)
  93             ((and (floatp darkroom-margins)
  94                   (< darkroom-margins 1))
  95              (let ((delta (darkroom-float-to-columns darkroom-margins)))
  96                (cons delta delta))))))
  97
  98 (defun darkroom-float-to-columns (f)
  99   (ceiling (* (let ((edges (window-edges)))
 100                 (- (nth 2 edges) (nth 0 edges)))
 101               f)))
 102
 103 (defvar darkroom-buffer-margins nil
 104   "Buffer-local version of `darkroom-margins' defcustom.
 105 Set by `darkroom-set-margins'")
 106
 107 (defun darkroom-set-margins (&optional margins)
 108   "Set margins from MARGINS or `darkroom-compute-margins'."
 109   (let* ((window-configuration-change-hook nil))
 110     (when margins
 111       (when (null (car margins)) (setcar margins 0))
 112       (when (null (cdr margins)) (setcdr margins 0)))
 113     (set (make-local-variable 'darkroom-buffer-margins)
 114          (or margins (darkroom-compute-margins)))
 115     (walk-windows #'(lambda (w)
 116                       (when (eq (window-buffer w) (current-buffer))
 117                         (setq fringes-outside-margins
 118                               darkroom-fringes-outside-margins)
 119                         ;; See description of
 120                         ;; `fringes-outside-margins' for the reason
 121                         ;; for this apparent noop
 122                         (set-window-buffer w (current-buffer))
 123                         (set-window-margins w (car darkroom-buffer-margins)
 124                                             (cdr darkroom-buffer-margins))))
 125                   nil
 126                   'all-frames)))
 127
 128 (defun darkroom-increase-margins (increment)
 129   (interactive (list darkroom-margin-increment))
 130   (unless (and (consp darkroom-buffer-margins)
 131                (numberp (car darkroom-buffer-margins))
 132                (numberp (cdr darkroom-buffer-margins)))
 133     (error "`darkroom-buffer-margins' corrupted. Must be a cons of numbers."))
 134   (setcar darkroom-buffer-margins
 135           (round (* (+ 1 increment) (car darkroom-buffer-margins))))
 136   (setcdr darkroom-buffer-margins
 137           (round (* (+ 1 increment) (cdr darkroom-buffer-margins))))
 138   (darkroom-set-margins darkroom-buffer-margins))
 139
 140 (defun darkroom-decrease-margins (decrement)
 141   (interactive (list darkroom-margin-increment))
 142   (darkroom-increase-margins (- decrement)))
 143
 144 (defvar darkroom-mode-map
 145   (let ((map (make-sparse-keymap)))
 146     (define-key map (kbd "C-M-+") 'darkroom-increase-margins)
 147     (define-key map (kbd "C-M--") 'darkroom-decrease-margins)
 148     map))
 149
 150 (defvar darkroom-saved-mode-line-format nil)
 151 (defvar darkroom-saved-header-line-format nil)
 152 (defvar darkroom-saved-margins nil)
 153
 154 (define-minor-mode darkroom-mode
 155   "Remove visual distractions and focus on writing.
 156 When this mode is active, everything but the buffer's text is
 157 elided from view. The buffer margins are set so that text is
 158 centered on screen. Text size is increased (display engine
 159 allowing) by `darkroom-text-scale-increase'." nil nil nil
 160 (cond (darkroom-mode
 161        (set (make-local-variable 'darkroom-saved-mode-line-format)
 162             mode-line-format)
 163        (set (make-local-variable 'darkroom-saved-header-line-format)
 164             header-line-format)
 165        (set (make-local-variable 'darkroom-saved-margins) (window-margins))
 166        (setq mode-line-format nil)
 167        (setq header-line-format nil)
 168        (darkroom-set-margins)
 169        (text-scale-increase darkroom-text-scale-increase)
 170        (add-hook 'window-configuration-change-hook 'darkroom-set-margins
 171                  nil t))
 172       (t
 173        (setq mode-line-format darkroom-saved-mode-line-format
 174              header-line-format darkroom-saved-header-line-format)
 175        (text-scale-decrease 2)
 176        (let (darkroom-buffer-margins)
 177          (darkroom-set-margins darkroom-saved-margins))
 178        (remove-hook 'window-configuration-change-hook 'darkroom-set-margins
 179                     t))))
 180
 181 (defun darkroom-maybe-enable ()
 182   (cond ((and (not darkroom-mode) (= (count-windows) 1))
 183          (darkroom-mode 1))
 184         ((and darkroom-mode (> (count-windows) 1))
 185          (darkroom-mode -1))
 186         (t
 187          ;; (message "debug: buffer: %s windows: %s darkroom-mode: %s"
 188          ;;          (current-buffer) (count-windows) darkroom-mode)
 189          )))
 190
 191
 192 (define-minor-mode darkroom-tentative-mode
 193   "Minor mode that enters `darkroom-mode' when all windws are deleted"
 194   nil "DarkroomT" nil
 195   (cond (darkroom-tentative-mode
 196          (add-hook 'window-configuration-change-hook
 197                    'darkroom-maybe-enable nil t)
 198          (darkroom-maybe-enable))
 199         (t
 200          (if darkroom-mode (darkroom-mode -1))
 201          (remove-hook 'window-configuration-change-hook
 202                       'darkroom-maybe-enable t))))
 203
 204
 205
 206 (provide 'darkroom)
 207 ;;; darkroom.el ends here