;;; darkroom.el --- Remove visual distractions and focus on writing -*- lexical-binding: t; -*-
-;; Copyright (C) 2014 João Távora
+;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Author: João Távora <joaotavora@gmail.com>
+;; Maintainer: João Távora <joaotavora@gmail.com>
;; Keywords: convenience, emulations
;; Package-Requires: ((cl-lib "0.5"))
;; Version: 0.1
;;; Commentary:
-;; The main entrypoints to this extension are two minor modes
+;; The main entrypoints to this extension are two minor modes:
;;
;; M-x darkroom-mode
;; M-x darkroom-tentative-mode
;;
-;; The first makes current buffer to enter `darkroom-mode'
-;; immediately: keeping the window configuration untouched, text is
-;; enlarged, centered on the window with margins, and the modeline is
-;; elided.
+;; `darkroom-mode' makes visual distractions disappear: the
+;; mode-line is temporarily elided, text is enlarged and margins are
+;; adjusted so that it's centered on the window.
;;
-;; The second, `darkroom-tentative-mode', makes the current buffer
-;; turn on `darkroom-mode' whenever all other windows are deleted,
-;; i.e. the buffer is solo on the current Emacs frame. Whenever the
-;; window is split to display some other buffer, the original buffer's
-;; configuration is reset.
+;; `darkroom-tentative-mode' is similar, but it doesn't immediately
+;; turn-on `darkroom-mode', unless the current buffer lives in the
+;; sole window of the Emacs frame (i.e. all other windows are
+;; deleted). Whenever the frame is split to display more windows and
+;; more buffers, the buffer exits `darkroom-mode'. Whenever they are
+;; deleted, the buffer re-enters `darkroom-mode'.
;;
;; Personally, I always use `darkroom-tentative-mode'.
;;
;;; Code:
+(require 'cl-lib)
+
(defgroup darkroom nil
"Remove visual distractions and focus on writing"
:prefix "darkroom-"
:group 'emulations)
-(defcustom darkroom-margins 0.15
+(defcustom darkroom-margins 'darkroom-guess-margins
"Margins to use in `darkroom-mode'.
Its value can be:
- a cons cell (LEFT RIGHT) specifying the left and right margins
in columns.
-- a function of no arguments that returns a cons cell interpreted
- like the previous option.
-
-Value is effective when `darkroom-mode' is toggled, when
-changing window or by calling `darkroom--set-margins'"
- :type 'float
+- a function of a single argument, a window, that returns a cons
+ cell interpreted like the previous option. An example is
+ `darkroom-guess-margins', which see. Beware that this function
+ is called very often, so if it does some non-trivial processing
+ on the buffer's text, consider caching that value.
+
+Value is effective when `darkroom-mode' is toggled."
+ :type '(choice float
+ (cons integer integer)
+ (function-item darkroom-guess-margins :doc "Guess margins")
+ (function darkroom-guess-margins))
:group 'darkroom)
(defcustom darkroom-text-scale-increase 2
:type 'float
:group 'darkroom)
-(defun darkroom-guess-margins ()
+(defcustom darkroom-margins-if-failed-guess 0.15
+ "Margins when `darkroom-guess-margins' fails.
+If `darkroom-guess-margins' failed to figure out margins to
+center the text, use this percentage of window width for the
+symmetical margins."
+ :type 'float
+ :group 'darkroom)
+
+(defcustom darkroom-verbose nil
+ "If non-nil, be verbose about darkroom operations."
+ :type 'boolean
+ :group 'darkroom)
+
+(defvar darkroom--guess-margins-statistics-cache nil
+ "Cache used by `darkroom-guess-margins'.")
+
+(defun darkroom--window-width (&optional window)
+ "Calculate width of WINDOW in columns, considering text scaling.
+WINDOW defaults to the currently selected window. The function
+assumes the buffer to be filled with at least one character of an
+arbitrary, but fixed width. Narrowing is taken in consideration.
+The return value is a cons (COLS . SCALED-CHAR-WIDTH) where COLS
+is the desired width in columns and SCALED-CHAR-WIDTH is the
+width in pixels of a single character."
+ (when (= (point-min) (point-max))
+ (error "Cannot calculate the width of a single character"))
+ (let* ((window (or window (selected-window)))
+ (scaled-char-width (car (window-text-pixel-size
+ window
+ (point-min) (1+ (point-min)))))
+ (char-width (frame-char-width))
+ (margins (window-margins window)))
+ (cons (truncate
+ (+ (window-width window 'pixelwise)
+ (* char-width (or (car margins) 0))
+ (* char-width (or (cdr margins) 0)))
+ scaled-char-width)
+ scaled-char-width)))
+
+(defun darkroom-guess-margins (window)
"Guess suitable margins for `darkroom-margins'.
-Collects some statistics about the buffer's line lengths, and
-apply a heuristic to figure out how wide to set the margins. If
-the buffer's paragraphs are mostly filled to `fill-column',
-margins should center it on the window, otherwise, margins of
-0.15 percent are used."
- ;;; FIXME: broken when darkroom-text-scale-increase is anything but
- ;;; 0, since window-width ignores text scaling. Otherwise, a
- ;;; suitable default to put in `darkroom-margins', I guess.
- (if visual-line-mode
- 0.15
- (let* ((window-width (window-width))
- (line-widths (save-excursion
- (goto-char (point-min))
- (cl-loop for start = (point)
- while (search-forward "\n"
- 20000
- 'no-error)
- for width = (- (point) start 1)
- unless (zerop width)
- collect width)))
- (_longest-width (cl-reduce #'max line-widths :initial-value 0))
- (top-quartile-avg (cl-loop with n = (/ (length line-widths)
- 4)
- for width in (copy-sequence
- (sort line-widths #'>))
- for i from 1 upto n
- sum width into total
- finally (return (/ total n 1.0)))))
+If in suitable conditions, collect some statistics about the
+buffer's line lengths, and apply a heuristic to figure out how
+wide to set the margins, comparing it to WINDOW's width in
+columns. If the buffer's paragraphs are mostly filled to
+`fill-column', margins should center it on the window, otherwise,
+the margins specified in `darkroom-margins-if-failed-guess'.
+
+In any of these conditions,`darkroom-margins-if-failed-guess' is
+also used:
+
+* if `visual-line-mode' is on;
+* if `variable-pitch-mode' is on;
+* if the buffer is empty.
+
+For testing purposes, WINDOW can also be an integer number which
+is a width in columns, in which case it will be used instead of a
+window's geometry."
+ (if (or visual-line-mode
+ (and buffer-face-mode
+ (eq 'variable-pitch buffer-face-mode-face))
+ (= (point-min) (point-max)))
+ darkroom-margins-if-failed-guess
+ (let* ((window-width-info (if (integerp window)
+ window
+ (darkroom--window-width window)))
+ (window-width (car window-width-info))
+ (scaled-char-width (cdr window-width-info))
+ (top-quartile-avg
+ (or darkroom--guess-margins-statistics-cache
+ (set
+ (make-local-variable 'darkroom--guess-margins-statistics-cache)
+ (let* ((line-widths
+ (save-excursion
+ (goto-char (point-min))
+ (cl-loop for start = (point)
+ while (search-forward "\n"
+ 20000
+ 'no-error)
+ for width = (truncate
+ (car
+ (window-text-pixel-size
+ window
+ start (1- (point))))
+ scaled-char-width)
+ unless (zerop width)
+ collect width)))
+ (n4 (max 1 (/ (length line-widths) 4))))
+ (/ (apply '+ (cl-subseq (sort line-widths '>) 0 n4)) n4))))))
(cond
((> top-quartile-avg
window-width)
- (when (y-or-n-p
- (format
- (mapconcat
- #'identity
- '("Long lines detected!"
- "(top 25%% average %s chars and window-width is %s)"
- "Perhaps turn on visual-line-mode for a better darkroom?")
- "\n")
- top-quartile-avg window-width))
- (visual-line-mode 1))
- 0.15)
+ (message "Long lines detected. Consider turning on `visual-line-mode'")
+ darkroom-margins-if-failed-guess)
((> top-quartile-avg (* 0.9 fill-column))
- (let ((margin (round (/ (- window-width top-quartile-avg) 2))))
+ ;; calculate margins so that `fill-column' + 1 colums are
+ ;; centered on the window.
+ ;;
+ (let ((margin (truncate (* (- window-width (1+ fill-column))
+ (/ (float scaled-char-width)
+ (frame-char-width)))
+ 2)))
+ (if darkroom-verbose
+ (message "Choosing %s-wide margins based on fill-column %s"
+ margin fill-column))
(cons margin margin)))
(t
- 0.15)))))
+ darkroom-margins-if-failed-guess)))))
-(defun darkroom--compute-margins ()
+(defun darkroom--compute-margins (window)
+ "From `darkroom-margins', computes desired margins for WINDOW."
(let ((darkroom-margins
(if (functionp darkroom-margins)
- (funcall darkroom-margins)
+ (funcall darkroom-margins window)
darkroom-margins)))
(cond ((consp darkroom-margins)
darkroom-margins)
(- (nth 2 edges) (nth 0 edges)))
f)))
-(defvar darkroom--buffer-margins nil
- "Buffer-local version of `darkroom-margins' defcustom.
-Set by `darkroom--set-margins'")
-
-(defun darkroom--set-margins (&optional margins)
- "Set margins from MARGINS or `darkroom--buffer-margins'."
- (let* ((window-configuration-change-hook nil))
- (when margins
- (when (null (car margins)) (setcar margins 0))
- (when (null (cdr margins)) (setcdr margins 0)))
- (set (make-local-variable 'darkroom--buffer-margins)
- (or margins darkroom--buffer-margins))
- (walk-windows #'(lambda (w)
- (when (eq (window-buffer w) (current-buffer))
- (setq fringes-outside-margins
- darkroom-fringes-outside-margins)
- ;; See description of
- ;; `fringes-outside-margins' for the reason
- ;; for this apparent noop
- (set-window-buffer w (current-buffer))
- (set-window-margins w (car darkroom--buffer-margins)
- (cdr darkroom--buffer-margins))))
- nil
- 'all-frames)))
+(defvar darkroom--margin-factor 1
+ "Buffer local factor affecting `darkroom--set-margins'")
+
+(defun darkroom--set-margins ()
+ "Set darkroom margins for currently selected window"
+ (let* ((window-configuration-change-hook nil)
+ (window (selected-window))
+ (margins (darkroom--compute-margins window)))
+ ;; See description of
+ ;; `fringes-outside-margins' for the reason
+ ;; for this apparent noop
+ (set-window-buffer window (current-buffer))
+ (set-window-margins window
+ (round
+ (* darkroom--margin-factor
+ (car margins)))
+ (round
+ (* darkroom--margin-factor
+ (cdr margins))))))
+
+(defun darkroom--reset-margins ()
+ "Reset darkroom margins for currently selected window."
+ (set-window-margins (selected-window) 0 0))
(defun darkroom-increase-margins (increment)
"Increase darkroom margins by INCREMENT."
(interactive (list darkroom-margin-increment))
- (unless (and (consp darkroom--buffer-margins)
- (numberp (car darkroom--buffer-margins))
- (numberp (cdr darkroom--buffer-margins)))
- (error "`darkroom--buffer-margins' corrupted. Must be a cons of numbers."))
- (setcar darkroom--buffer-margins
- (round (* (+ 1 increment) (car darkroom--buffer-margins))))
- (setcdr darkroom--buffer-margins
- (round (* (+ 1 increment) (cdr darkroom--buffer-margins))))
- (darkroom--set-margins darkroom--buffer-margins))
+ (set (make-local-variable 'darkroom--margin-factor)
+ (* darkroom--margin-factor (+ 1 increment)))
+ (mapc #'(lambda (w)
+ (with-selected-window w
+ (darkroom--set-margins)))
+ (get-buffer-window-list (current-buffer))))
(defun darkroom-decrease-margins (decrement)
"Decrease darkroom margins by DECREMENT."
(define-key map (kbd "C-M--") 'darkroom-decrease-margins)
map))
-(defvar darkroom--saved-mode-line-format nil)
-(defvar darkroom--saved-header-line-format nil)
-(defvar darkroom--saved-margins nil)
+(defconst darkroom--saved-variables
+ '(mode-line-format
+ header-line-format
+ fringes-outside-margins)
+ "Variables saved in `darkroom--saved-state'")
+
+(defvar darkroom--saved-state nil
+ "Saved state before `darkroom-mode' is turned on.
+Alist of (VARIABLE . BEFORE-VALUE)")
+
+;; (defvar darkroom--saved-text-scale-mode-amount nil
+;; "Text scale before `darkroom-mode' is turned on.")
+
+(defun darkroom--enter (&optional just-margins)
+ "Save current state and enter darkroom for the current buffer.
+With optional JUST-MARGINS, just set the margins."
+ (unless just-margins
+ (setq darkroom--saved-state
+ (mapcar #'(lambda (sym)
+ (cons sym (buffer-local-value sym (current-buffer))))
+ darkroom--saved-variables))
+ (setq mode-line-format nil
+ header-line-format nil
+ fringes-outside-margins darkroom-fringes-outside-margins)
+ (text-scale-increase darkroom-text-scale-increase))
+ (mapc #'(lambda (w)
+ (with-selected-window w
+ (darkroom--set-margins)))
+ (get-buffer-window-list (current-buffer))))
+
+(defun darkroom--leave ()
+ "Undo the effects of `darkroom--enter'."
+ (mapc #'(lambda (pair)
+ (set (make-local-variable (car pair)) (cdr pair)))
+ darkroom--saved-state)
+ (setq darkroom--saved-state nil)
+ (text-scale-decrease darkroom-text-scale-increase)
+ (mapc #'(lambda (w)
+ (with-selected-window w
+ (darkroom--reset-margins)))
+ (get-buffer-window-list (current-buffer))))
+
+(defun darkroom--enter-or-leave ()
+ "Enter or leave darkroom according to window configuration."
+ (cond ((= (count-windows) 1)
+ (darkroom--enter darkroom--saved-state))
+ (darkroom--saved-state
+ (darkroom--leave))
+ (t
+ ;; for clarity, don't do anything
+ )))
+(declare-function darkroom-tentative-mode "darkroom" t)
+
+;;;###autoload
(define-minor-mode darkroom-mode
"Remove visual distractions and focus on writing. When this
mode is active, everything but the buffer's text is elided from
view. The buffer margins are set so that text is centered on
screen. Text size is increased (display engine allowing) by
`darkroom-text-scale-increase'." nil nil nil
+ (when darkroom-tentative-mode
+ (display-warning
+ 'darkroom
+ (concat "Turning off `darkroom-tentative-mode' first. "
+ "It doesn't go with `darkroom-mode'.")
+ (let ((darkroom-mode nil))
+ (darkroom-tentative-mode -1))))
(cond (darkroom-mode
- (set (make-local-variable 'darkroom--saved-margins) (window-margins))
- (set (make-local-variable 'darkroom--saved-mode-line-format)
- mode-line-format)
- (set (make-local-variable 'darkroom--saved-header-line-format)
- header-line-format)
- (setq mode-line-format nil)
- (setq header-line-format nil)
- (text-scale-increase darkroom-text-scale-increase)
- (darkroom--set-margins (darkroom--compute-margins))
+ (darkroom--enter)
(add-hook 'window-configuration-change-hook 'darkroom--set-margins
- nil t))
+ t t))
(t
- (setq mode-line-format darkroom--saved-mode-line-format
- header-line-format darkroom--saved-header-line-format)
- (text-scale-decrease darkroom-text-scale-increase)
- (let (darkroom--buffer-margins)
- (darkroom--set-margins darkroom--saved-margins))
+ (darkroom--leave)
(remove-hook 'window-configuration-change-hook 'darkroom--set-margins
t))))
-(defun darkroom--maybe-enable ()
- (cond ((and (not darkroom-mode) (= (count-windows) 1))
- (darkroom-mode 1))
- ((and darkroom-mode (> (count-windows) 1))
- (darkroom-mode -1))
- (t
- ;; (message "debug: buffer: %s windows: %s darkroom-mode: %s"
- ;; (current-buffer) (count-windows) darkroom-mode)
- )))
-
-
+;;;###autoload
(define-minor-mode darkroom-tentative-mode
- "Minor mode that enters `darkroom-mode' when all windws are deleted"
- nil "DarkroomT" nil
+ "Enters `darkroom-mode' when all other windows are deleted."
+ nil " Room" darkroom-mode-map
+ ;; always begin by removing the hook
+ ;;
+ (remove-hook 'window-configuration-change-hook
+ 'darkroom--enter-or-leave 'local)
+ (when darkroom-mode
+ (display-warning
+ 'darkroom
+ (concat "Turning off `darkroom-mode' first. "
+ "It doesn't go with `darkroom-tentative-mode'.")
+ (let ((darkroom-tentative-mode nil))
+ (darkroom-mode -1))))
+ ;; turn darkroom on or off according to window state
+ ;;
(cond (darkroom-tentative-mode
+ ;; re-add the hook when we are turning ourselves on
+ ;;
(add-hook 'window-configuration-change-hook
- 'darkroom--maybe-enable nil t)
- (darkroom--maybe-enable))
+ 'darkroom--enter-or-leave 'append 'local)
+ ;; call this right away if we're supposed to turn darkroom on
+ ;; immediately.
+ ;;
+ (darkroom--enter-or-leave))
(t
- (if darkroom-mode (darkroom-mode -1))
- (remove-hook 'window-configuration-change-hook
- 'darkroom--maybe-enable t))))
-
+ (darkroom--leave))))
(provide 'darkroom)