;;; 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
;;; Code:
+(require 'cl-lib)
+
(defgroup darkroom nil
"Remove visual distractions and focus on writing"
:prefix "darkroom-"
:type 'float
:group 'darkroom)
-(defun darkroom--real-window-width ()
- "Horrible hack to get the window width in characters.
-`window-width' ignores text scaling."
- (let ((inhibit-read-only t)
- (buffer-undo-list t)
- (truncate-lines nil)
- (truncate-partial-width-windows nil)
- (word-wrap t)
- (line-move-visual t))
- (save-excursion
- (with-silent-modifications
- (let ((begin (point)))
- (unwind-protect
- (progn
- (insert (make-string 10000 ?!))
- (save-excursion
- (goto-char begin)
- (next-line)
- (backward-char)
- (let ((margins (window-margins)))
- (+ (or (car margins) 0)
- (or (cdr margins) 0)
- (current-column)))))
- (delete-region begin (point))))))))
+(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,
-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, margins of 0.15 percent are
-used. 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 visual-line-mode
+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 (if (integerp window)
- window
- (with-selected-window window
- ;; (let ((edges (window-edges)))
- ;; (- (nth 2 edges) (nth 0 edges)))
- (darkroom--real-window-width))))
+ (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 = (- (point) start 1)
- unless (zerop width)
- collect width)))
+ (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
(message "Long lines detected. Consider turning on `visual-line-mode'")
darkroom-margins-if-failed-guess)
((> top-quartile-avg (* 0.9 fill-column))
- (let ((margin (truncate (/ (- 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
darkroom-margins-if-failed-guess)))))
(- (nth 2 edges) (nth 0 edges)))
f)))
+(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)
;; `fringes-outside-margins' for the reason
;; for this apparent noop
(set-window-buffer window (current-buffer))
- (set-window-margins window (car margins) (cdr margins))))
+ (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."
- (let* ((window (selected-window))
- (margins (window-parameter window 'darkroom--saved-margins)))
- (set-window-margins window (or (car margins) 0) (or (cdr margins) 0))))
+ (set-window-margins (selected-window) 0 0))
(defun darkroom-increase-margins (increment)
"Increase darkroom margins by INCREMENT."
(interactive (list darkroom-margin-increment))
- (error "Not implemented yet"))
+ (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."
;; (defvar darkroom--saved-text-scale-mode-amount nil
;; "Text scale before `darkroom-mode' is turned on.")
-(defun darkroom--turn-on ()
- "Turns darkroom on for the current buffer"
- (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)
+(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
- (set-window-parameter w 'darkroom--saved-margins (window-margins))
(darkroom--set-margins)))
- (get-buffer-window-list (current-buffer)))
- (add-hook 'window-configuration-change-hook 'darkroom--set-margins
- t t))
+ (get-buffer-window-list (current-buffer))))
-(defun darkroom--turn-off ()
+(defun darkroom--leave ()
+ "Undo the effects of `darkroom--enter'."
(mapc #'(lambda (pair)
(set (make-local-variable (car pair)) (cdr pair)))
darkroom--saved-state)
(mapc #'(lambda (w)
(with-selected-window w
(darkroom--reset-margins)))
- (get-buffer-window-list (current-buffer)))
- (remove-hook 'window-configuration-change-hook 'darkroom--set-margins
- t))
+ (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
- (error
- "Don't mix `darkroom-mode' and `darkroom-tentative-mode'"))
- ;; FIXME: unfortunately, signalling an error doesn't prevent the
- ;; mode from turning itself off. How do I do that?
+ (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
- (darkroom--turn-on))
+ (darkroom--enter)
+ (add-hook 'window-configuration-change-hook 'darkroom--set-margins
+ t t))
(t
- (darkroom--turn-off))))
-
-(defun darkroom--maybe-enable ()
- (let ((darkroom--tentative-mode-driving t))
- (cond ((and (not darkroom--saved-state) (= (count-windows) 1))
- (darkroom--turn-on))
- ((and darkroom--saved-state (> (count-windows) 1))
- (darkroom--turn-off))
- (t
- ;; Some debug code could go here.
- ))))
+ (darkroom--leave)
+ (remove-hook 'window-configuration-change-hook 'darkroom--set-margins
+ t))))
+;;;###autoload
(define-minor-mode darkroom-tentative-mode
"Enters `darkroom-mode' when all other windows are deleted."
- nil " Room" nil
+ 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
- (error
- "Don't mix `darkroom-mode' and `darkroom-tentative-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
- (darkroom--turn-off)
- (remove-hook 'window-configuration-change-hook
- 'darkroom--maybe-enable t))))
-
+ (darkroom--leave))))
(provide 'darkroom)