about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/writeroom-mode-20170623.1027/writeroom-mode.el
blob: 777b37233ec2306bdce97ccd97acef8ae3b80258 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
;;; writeroom-mode.el --- Minor mode for distraction-free writing  -*- lexical-binding: t -*-

;; Copyright (c) 2012-2017 Joost Kremers

;; Author: Joost Kremers <joostkremers@fastmail.fm>
;; Maintainer: Joost Kremers <joostkremers@fastmail.fm>
;; Created: 11 July 2012
;; Package-Requires: ((emacs "24.1") (visual-fill-column "1.9"))
;; Version: 3.7
;; Keywords: text

;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;; 3. The name of the author may not be used to endorse or promote products
;;    derived from this software without specific prior written permission.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES ; LOSS OF USE,
;; DATA, OR PROFITS ; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

;;; Commentary:

;; writeroom-mode is a minor mode for Emacs that implements a
;; distraction-free writing mode similar to the famous Writeroom editor for
;; OS X. writeroom-mode is meant for GNU Emacs 24 and isn't tested on older
;; versions.
;;
;; See the README or info manual for usage instructions.
;;
;;; Code:

(require 'visual-fill-column)

(defvar writeroom--frame nil
  "The frame in which `writeroom-mode' is activated.
The global effects only apply to this frame.")

(defvar writeroom--buffers nil
  "List of buffers in which `writeroom-mode' is activated.")

(defvar writeroom--local-variables '(mode-line-format
                            header-line-format
                            line-spacing)
  "Local variables whose values need to be saved when `writeroom-mode' is activated.")

(defvar writeroom--saved-data nil
  "Buffer-local data to be stored when `writeroom-mode' is activated.
These settings are restored when `writeroom-mode' is
deactivated.")
(make-variable-buffer-local 'writeroom--saved-data)

(defvar writeroom--saved-visual-fill-column nil
  "Status of `visual-fill-column-mode' before activating `writeroom-mode'.")
(make-variable-buffer-local 'writeroom--saved-visual-fill-column)

(defvar writeroom--saved-window-config nil
  "Window configuration active before `writeroom-mode' is activated.")

(defgroup writeroom nil "Minor mode for distraction-free writing."
  :group 'wp
  :prefix "writeroom-")

(defcustom writeroom-width 80
  "Width of the writeroom writing area.
This can be specified as an absolute width (the number of
characters in a line), or as a fraction of the total window
width, in the latter it should be a number between 0 and 1."
  :group 'writeroom
  :type '(choice (integer :tag "Absolute width:")
                 (float :tag "Relative width:" :value 0.5)))

(defcustom writeroom-mode-line nil
  "The mode line format to use with `writeroom-mode'.
By default, this option is set to nil, which disables the mode
line when `writeroom-mode' is activated.  By setting this option
to t, the standard mode line is retained.  Alternatively, it is
possible to specify a special mode line for `writeroom-mode'
buffers.  If this option is chosen, the default is to only show
the buffer's modification status and the buffer name, but the
format can be customized.  See the documentation for the variable
`mode-line-format' for further information.  Note that if you set
this option, it may be more visually pleasing to set
`writeroom-bottom-divider-width' to 0."
  :group 'writeroom
  :type '(choice (const :tag "Disable the mode line" nil)
                 (const :tag "Use default mode line" t)
                 (sexp :tag "Customize mode line"
                       :value ("   " mode-line-modified "   " mode-line-buffer-identification))))

(defcustom writeroom-mode-line-toggle-position 'header-line-format
  "Position to temporarily show the mode line.
When the mode line is disabled, the function
`writeroom-toggle-mode-line' makes the mode line visible.  This
option determines whether it is shown as the mode line or as the
header line."
  :group 'writeroom
  :type '(choice (const :tag "Use the mode line" 'mode-line-format)
                 (const :tag "Use the header line" 'header-line-format)))

(defcustom writeroom-bottom-divider-width 1
  "Width of the bottom window divider in pixels."
  :group 'writeroom
  :type '(integer :tag "Width"))

(make-obsolete-variable 'writeroom-disable-fringe
                        "The variable `writeroom-disable-fringe' is no longer used."
                        "`writeroom-mode' version 2.9")

(defcustom writeroom-maximize-window t
  "Whether to maximize the current window in its frame.
When set to t, `writeroom-mode' deletes all other windows in
the current frame."
  :group 'writeroom
  :type '(choice (const :tag "Maximize window" t)
                 (const :tag "Do not maximize window" nil)))

(defcustom writeroom-fullscreen-effect 'fullboth
  "Effect applied when enabling fullscreen.
The value can be `fullboth', in which case fullscreen is
activated, or `maximized', in which case the relevant frame is
maximized but window decorations are still available."
  :group 'writeroom
  :type '(choice (const :tag "Fullscreen" fullboth)
                 (const :tag "Maximized" maximized)))

(defcustom writeroom-border-width 30
  "Width in pixels of the border.
To use this option, select the option \"Add border\" in `Global
Effects'. This adds a border around the text area."
  :group 'writeroom
  :type '(integer :tag "Border width"))

(defcustom writeroom-fringes-outside-margins t
  "If set, place the fringes outside the margins."
  :group 'writeroom
  :type '(choice (const :tag "Place fringes outside margins" t)
                 (const :tag "Place fringes inside margins" nil)))

(defcustom writeroom-major-modes '(text-mode)
  "List of major modes in which writeroom-mode is activated.
The command `global-writeroom-mode' activates `writeroom-mode' in
every buffer that has one of the major modes listed in this
option.  Modes can be specified as symbols or as regular
expressions.  If a buffer has one of the specified major modes or
if its major mode name matches one of the regular expressions,
`writeroom-mode' is activated."
  :group 'writeroom
  :type '(repeat (choice (symbol :tag "Major mode")
                         (string :tag "Regular expression"))))

(defcustom writeroom-use-derived-modes t
  "Activate `writeroom-mode' in derived modes as well.'.
If this option is set, the command `global-writeroom-mode'
activates `writeroom-mode' in modes that are derived from those
listed in `writeroom-major-modes'.  Note that this option applies
only to symbols in `writeroom-major-modes'.  Regular expressions
are ignored."
  :group 'writeroom
  :type '(choice (const :tag "Use derived modes" t)
                 (const :tag "Do not use derived modes" nil)))

(defcustom writeroom-major-modes-exceptions nil
  "List of major modes in which `writeroom-mode' should not be activated.
This option lists exceptions to `writeroom-major-modes'.  Modes
can be specified as symbols or as regular expressions."
  :group 'writeroom
  :type '(repeat (choice (symbol :tag "Major mode exception")
                         (string :tag "Regular expression"))))

(defcustom writeroom-restore-window-config nil
  "If set, restore window configuration after disabling `writeroom-mode'.
Setting this option makes sense primarily if `writeroom-mode' is
used in one buffer only.  The window configuration that is stored
is the one that exists when `writeroom-mode' is first called, and
it is restored when `writeroom-mode' is deactivated in the last
buffer."
  :group 'writeroom
  :type '(choice (const :tag "Do not restore window configuration" nil)
                 (const :tag "Restore window configuration" t)))

(defcustom writeroom-extra-line-spacing nil
  "Additional line spacing for `writeroom-mode`."
  :group 'writeroom
  :type '(choice (const :tag "Do not add extra line spacing" :value nil)
                 (integer :tag "Absolute height" :value 5)
                 (float :tag "Relative height" :value 0.8)))

(defcustom writeroom-global-effects '(writeroom-set-fullscreen
                             writeroom-set-alpha
                             writeroom-set-menu-bar-lines
                             writeroom-set-tool-bar-lines
                             writeroom-set-vertical-scroll-bars
                             writeroom-set-bottom-divider-width)
  "List of global effects for `writeroom-mode'.
These effects are enabled when `writeroom-mode' is activated in
the first buffer and disabled when it is deactivated in the last
buffer."
  :group 'writeroom
  :type '(set (const :tag "Fullscreen" writeroom-set-fullscreen)
              (const :tag "Disable transparency" writeroom-set-alpha)
              (const :tag "Disable menu bar" writeroom-set-menu-bar-lines)
              (const :tag "Disable tool bar" writeroom-set-tool-bar-lines)
              (const :tag "Disable scroll bar" writeroom-set-vertical-scroll-bars)
              (const :tag "Enable bottom window divider" writeroom-set-bottom-divider-width)
              (const :tag "Add border" writeroom-set-internal-border-width)
              (const :tag "Display frame on all workspaces" writeroom-set-sticky)
              (repeat :inline t :tag "Custom effects" function)))

(define-obsolete-variable-alias 'writeroom-global-functions 'writeroom-global-effects "`writeroom-mode' version 2.0")

(defmacro define-writeroom-global-effect (fp value)
  "Define a global effect for `writeroom-mode'.
The effect is activated by setting frame parameter FP to VALUE.
FP should be an unquoted symbol, the name of a frame parameter;
VALUE must be quoted (unless it is a string or a number, of
course).  It can also be an unquoted symbol, in which case it
should be the name of a global variable whose value is then
assigned to FP.

This macro defines a function `writeroom-set-<FP>' that takes one
argument and activates the effect if this argument is 1 and
deactivates it if it is -1.  When the effect is activated, the
original value of frame parameter FP is stored in a frame
parameter `writeroom-<FP>', so that it can be restored when the
effect is deactivated."
  (declare (indent defun))
  (let ((wfp (intern (format "writeroom-%s" fp))))
    `(fset (quote ,(intern (format "writeroom-set-%s" fp)))
           (lambda (&optional arg)
             (when (frame-live-p writeroom--frame)
               (cond
                ((= arg 1)         ; activate
                 (set-frame-parameter writeroom--frame (quote ,wfp) (frame-parameter writeroom--frame (quote ,fp)))
                 (set-frame-parameter writeroom--frame (quote ,fp) ,value))
                ((= arg -1)        ; deactivate
                 (set-frame-parameter writeroom--frame (quote ,fp) (frame-parameter writeroom--frame (quote ,wfp)))
                 (set-frame-parameter writeroom--frame (quote ,wfp) nil))))))))

(define-writeroom-global-effect fullscreen writeroom-fullscreen-effect)
(define-writeroom-global-effect alpha '(100 100))
(define-writeroom-global-effect vertical-scroll-bars nil)
(define-writeroom-global-effect menu-bar-lines 0)
(define-writeroom-global-effect tool-bar-lines 0)
(define-writeroom-global-effect internal-border-width writeroom-border-width)
(define-writeroom-global-effect sticky t)
(define-writeroom-global-effect bottom-divider-width writeroom-bottom-divider-width)

(defun turn-on-writeroom-mode ()
  "Turn on `writeroom-mode'.
This function activates `writeroom-mode' in a buffer if that
buffer's major mode matchs against one of `writeroom-major-modes'."
  (unless (writeroom--match-major-mode writeroom-major-modes-exceptions)
    (if (writeroom--match-major-mode writeroom-major-modes writeroom-use-derived-modes)
        (writeroom-mode 1))))

(defun writeroom--match-major-mode (modes &optional derived)
  "Match the current buffer's major mode against MODES.
MODES a list of mode names (symbols) or regular expressions.
Return t if the current major mode matches one of the elements of
MODES, nil otherwise.  Comparison is done with `eq` (for symbols
in MODES) or with `string-match-p' (for strings in MODES).  That
is, if the major mode is e.g., `emacs-lisp-mode', it will not
match the symbol `lisp-mode', but it will match the string
\"lisp-mode\".

If DERIVED is non-nil, also return t if the current buffer's
major mode is a derived mode of one of the major mode symbols in
MODES."
  (catch 'match
    (dolist (elem modes)
      (if (cond ((symbolp elem)
                 (or (eq elem major-mode)
                     (and derived (derived-mode-p elem))))
                ((string-match-p elem (symbol-name major-mode))))
          (throw 'match t)))))

(defvar writeroom-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "s-?") #'writeroom-toggle-mode-line)
    map)
  "Keymap for writeroom-mode.")

;;;###autoload
(define-minor-mode writeroom-mode
  "Minor mode for distraction-free writing."
  :init-value nil :lighter nil :global nil
  (if writeroom-mode
      (writeroom--enable)
    (writeroom--disable)))

;;;###autoload
(define-globalized-minor-mode global-writeroom-mode writeroom-mode turn-on-writeroom-mode
  :require 'writeroom-mode
  :group 'writeroom)

(defun writeroom--kill-buffer-function ()
  "Disable `writeroom-mode' before killing a buffer, if necessary.
This function is for use in `kill-buffer-hook'.  It checks whether
`writeroom-mode' is enabled in the buffer to be killed and
adjusts `writeroom--buffers' and the global effects accordingly."
  (when writeroom-mode
    (setq writeroom--buffers (delq (current-buffer) writeroom--buffers))
    (when (not writeroom--buffers)
      (writeroom--set-global-effects -1)
      (setq writeroom--frame nil))))

(add-hook 'kill-buffer-hook #'writeroom--kill-buffer-function)

(defun writeroom--set-global-effects (arg)
  "Activate or deactivate global effects.
The effects are activated if ARG is 1, deactivated if it is -1."
  (mapc (lambda (fn)
          (funcall fn arg))
        writeroom-global-effects))

(defun writeroom--calculate-width ()
  "Calculate the width of the writing area."
  (if (floatp writeroom-width)
      (truncate (* (window-total-width) writeroom-width))
    writeroom-width))

(defvar writeroom--mode-line-showing nil
  "Flag indicating whether the original mode line is displayed.")
(make-variable-buffer-local 'writeroom--mode-line-showing)

(defvar writeroom--orig-header-line nil
  "Original format of the header line.
When the header line is used to temporarily display the mode
line, its original format is saved here.")
(make-variable-buffer-local 'writeroom--orig-header-line)

(defun writeroom-toggle-mode-line ()
  "Toggle display of the original mode."
  (interactive)
  (unless (eq writeroom-mode-line t) ; This means the original mode-line is displayed already.
    (cond
     ((not writeroom--mode-line-showing)
      (setq writeroom--orig-header-line header-line-format)
      (set writeroom-mode-line-toggle-position (or (cdr (assq 'mode-line-format writeroom--saved-data))
                                          (default-value 'mode-line-format)))
      (setq writeroom--mode-line-showing t))
     (writeroom--mode-line-showing
      (if (eq writeroom-mode-line-toggle-position 'header-line-format)
          (setq header-line-format writeroom--orig-header-line)
        (setq mode-line-format writeroom-mode-line))
      (setq writeroom--mode-line-showing nil)))
    (force-mode-line-update)))

(defun writeroom-adjust-width (amount)
  "Adjust the width of the writing area on the fly by AMOUNT.
A numeric prefix argument can be used to specify the adjustment.
When called without a prefix, this will reset the width to the default value."
  (interactive "P")
  (if amount
      (setq visual-fill-column-width (max 1 (+ visual-fill-column-width amount)))
    (setq visual-fill-column-width (writeroom--calculate-width)))
  (visual-fill-column--adjust-window)
  (message "Writing area is now %d characters wide" visual-fill-column-width))

(defun writeroom-increase-width ()
  "Increase the width of the writing area by 2 characters."
  (interactive)
  (writeroom-adjust-width 2))

(defun writeroom-decrease-width ()
  "Decrease the width of the writing area by 2 characters."
  (interactive)
  (writeroom-adjust-width -2))

(defun writeroom--enable ()
  "Set up writeroom-mode for the current buffer.
Also run the functions in `writeroom-global-effects' if the
current buffer is the first buffer in which `writeroom-mode' is
activated."
  ;; save buffer-local variables, if they have a buffer-local binding
  (setq writeroom--saved-data (mapcar (lambda (sym)
                               (if (local-variable-p sym)
                                   (cons sym (buffer-local-value sym (current-buffer)))
                                 sym))
                             writeroom--local-variables))
  (setq writeroom--saved-visual-fill-column visual-fill-column-mode)

  ;; activate global effects
  (when (not writeroom--buffers)
    (setq writeroom--frame (selected-frame))
    (writeroom--set-global-effects 1)
    (if writeroom-restore-window-config
        (setq writeroom--saved-window-config (current-window-configuration))))

  (push (current-buffer) writeroom--buffers)

  (when writeroom-maximize-window
    (delete-other-windows))

  (when writeroom-extra-line-spacing
    (setq line-spacing writeroom-extra-line-spacing))

  (unless (eq writeroom-mode-line t) ; if t, use standard mode line
    (setq mode-line-format writeroom-mode-line))

  (setq visual-fill-column-width (writeroom--calculate-width)
        visual-fill-column-center-text t
        visual-fill-column-fringes-outside-margins writeroom-fringes-outside-margins)
  (visual-fill-column-mode 1)

  ;; if the current buffer is displayed in some window, the windows'
  ;; margins and fringes must be adjusted.
  (mapc (lambda (w)
          (with-selected-window w
            (visual-fill-column--adjust-window)))
        (get-buffer-window-list (current-buffer) nil)))

(defun writeroom--disable ()
  "Reset the current buffer to its normal appearance.
Also run the functions in `writeroom-global-effects' to undo
their effects if `writeroom-mode' is deactivated in the last
buffer in which it was active."
  ;; disable visual-fill-column-mode
  (visual-fill-column-mode -1)
  (kill-local-variable 'visual-fill-column-width)
  (kill-local-variable 'visual-fill-column-center-text)
  (kill-local-variable 'visual-fill-column-fringes-outside-margins)

  ;; restore global effects if necessary
  (setq writeroom--buffers (delq (current-buffer) writeroom--buffers))
  (when (not writeroom--buffers)
    (writeroom--set-global-effects -1)
    (setq writeroom--frame nil)
    (if writeroom-restore-window-config
        (set-window-configuration writeroom--saved-window-config)))

  ;; restore local variables
  (mapc (lambda (val)
          (if (symbolp val)
              (kill-local-variable val)
            (set (car val) (cdr val))))
        writeroom--saved-data)

  ;; if the current buffer is displayed in some window, the windows'
  ;; margins and fringes must be adjusted.
  (mapc (lambda (w)
          (with-selected-window w
            (set-window-margins (selected-window) 0 0)
            (set-window-fringes (selected-window) nil)))
        (get-buffer-window-list (current-buffer) nil))

  ;; reenable `visual-fill-colummn-mode' with original settings if it was
  ;; active before activating `writeroom-mode'.
  (if writeroom--saved-visual-fill-column
      (visual-fill-column-mode 1)))

(provide 'writeroom-mode)

;;; writeroom-mode.el ends here