code.delx.au - gnu-emacs-elpa/blob - darkroom.el

   1 (defvar darkroom-margins 0.15
   2   "Margins to use in darkroom-mode.
   3
   4 It's value can be:
   5
   6 - a floating point value betweeen 0 and 1, specifies percentage of
   7   window width in columns to use as a margin.
   8
   9 - a cons cell (LEFT RIGHT) specifying the left and right margins
  10   in columns.
  11
  12 - a function that returns a cons cell interpreted like the
  13   previous option.
  14
  15 Value is effective when `darkroom-mode' is toggled, when
  16 changing window or by calling `darkroom-set-margins'")
  17
  18 (defvar darkroom-turns-on-visual-line-mode t
  19   "If non-nil pair `visual-line-mode' with
  20   `darkroom-mode'")
  21 (defvar darkroom-fringes-outside-margins t
  22   "If non-nil use fringes outside margins for `darkroom-mode'")
  23
  24 (defun darkroom-margins ()
  25   (cond ((functionp darkroom-margins)
  26          (funcall darkroom-margins))
  27         ((consp darkroom-margins)
  28          darkroom-margins)
  29         ((and (floatp darkroom-margins)
  30               (< darkroom-margins 1))
  31          (let ((delta (darkroom-float-to-columns darkroom-margins)))
  32            (cons delta delta)))))
  33
  34 (defun darkroom-float-to-columns (f)
  35   (ceiling (* (let ((edges (window-edges)))
  36                 (- (nth 2 edges) (nth 0 edges)))
  37               f)))
  38
  39 (defun darkroom-set-margins (&optional margins)
  40   "Adjust margins to `darkroom-margins' or optional MARGINS."
  41   (let* ((window-configuration-change-hook nil)
  42          (margins (or margins
  43                       (darkroom-margins))))
  44     (walk-windows #'(lambda (w)
  45                       (when (eq (window-buffer w) (current-buffer))
  46                         (setq fringes-outside-margins darkroom-fringes-outside-margins)
  47                         ;; See description of
  48                         ;; `fringes-outside-margins' for the reason
  49                         ;; for this apparent noop
  50                         (set-window-buffer w (current-buffer))
  51                         (set-window-margins w (car margins) (cdr margins))))
  52                   nil
  53                   'all-frames)))
  54
  55 (defun darkroom-increase-margins ()
  56   (interactive)
  57   (when (floatp darkroom-margins)
  58     (setq darkroom-margins (+ 0.05 darkroom-margins))
  59     (darkroom-set-margins)))
  60
  61 (defun darkroom-decrease-margins ()
  62   (interactive)
  63   (when (floatp darkroom-margins)
  64     (setq darkroom-margins (- darkroom-margins 0.05))
  65     (darkroom-set-margins)))
  66
  67 (defun darkroom-fill-paragraph-maybe (really)
  68   (interactive "P")
  69   (cond (visual-line-mode
  70          (if (not really)
  71              (message "not filling paragraph")
  72            (call-interactively 'fill-paragraph)
  73            (message "filled paragraph even in visual-line-mode")))
  74         (t
  75          (call-interactively 'fill-paragraph))))
  76
  77 (defvar darkroom-mode-map (let ((map (make-sparse-keymap)))
  78                                   (define-key map (kbd "C-M-+") 'darkroom-increase-margins)
  79                                   (define-key map (kbd "C-M--") 'darkroom-decrease-margins)
  80                                   (define-key map (kbd "M-q") 'darkroom-fill-paragraph-maybe)
  81                                   map))
  82
  83 (defvar darkroom-saved-mode-line-format nil)
  84 (defvar darkroom-saved-header-line-format nil)
  85 (defvar darkroom-saved-visual-line-mode nil)
  86
  87 (make-variable-buffer-local 'darkroom-saved-mode-line-format)
  88 (make-variable-buffer-local 'darkroom-saved-header-line-format)
  89 (make-variable-buffer-local 'darkroom-saved-visual-line-mode)
  90
  91 (defun darkroom-visual-mode-maybe-enable ()
  92   (when darkroom-turns-on-visual-line-mode
  93     (cond (darkroom-mode
  94            (setq darkroom-saved-visual-mode visual-line-mode)
  95            (visual-line-mode 1))
  96           (t
  97            (unless darkroom-saved-visual-line-mode
  98              (visual-line-mode -1))))))
  99
 100 (define-minor-mode darkroom-mode
 101   "Minor mode emulating the darkroom editor that I never used."
 102   nil nil nil
 103   (cond (darkroom-mode
 104          (setq darkroom-saved-mode-line-format mode-line-format
 105                mode-line-format nil
 106                darkroom-saved-header-line-format header-line-format
 107                header-line-format nil)
 108          (darkroom-set-margins)
 109          (darkroom-visual-mode-maybe-enable)
 110          (text-scale-increase 2)
 111          (add-hook 'window-configuration-change-hook 'darkroom-set-margins nil t))
 112         (t
 113          (setq mode-line-format darkroom-saved-mode-line-format
 114                header-line-format darkroom-saved-header-line-format)
 115          (text-scale-decrease 2)
 116          (darkroom-set-margins '(0 . 0))
 117          (darkroom-visual-mode-maybe-enable)
 118          (remove-hook 'window-configuration-change-hook 'darkroom-set-margins t))))
 119
 120 (defun darkroom-maybe-enable ()
 121   (cond ((and (not darkroom-mode) (= (count-windows) 1))
 122          (darkroom-mode 1))
 123         ((and darkroom-mode (> (count-windows) 1))
 124          (darkroom-mode -1))
 125         (t
 126          (message "Hmm buffer: %s windows: %s darkroom-mode: %s"
 127                   (current-buffer)
 128                   (count-windows)
 129                   darkroom-mode))))
 130
 131
 132 (define-minor-mode darkroom-tentative-mode
 133   "Minor mode that enters `darkroom-mode' when all windws are deleted"
 134   nil "D" nil
 135   (cond (darkroom-tentative-mode
 136          (add-hook 'window-configuration-change-hook 'darkroom-maybe-enable nil t)
 137          (darkroom-maybe-enable))
 138         (t
 139          (darkroom-maybe-enable)
 140          (remove-hook 'window-configuration-change-hook 'darkroom-maybe-enable t))))
 141
 142
 143
 144
 145 (provide 'darkroom)