summaryrefslogtreecommitdiffstats
path: root/persistent-outline.el
blob: 9e5d05201bcd6aa565ccc73aa2b1bcd9706b7c60 (plain)
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
;;; persistent-outline.el --- Save outline visibility

;; Copyright (C) 2013  Tom Willemse

;; Author: Tom Willemse <tom@ryuslash.org>
;; Keywords: convenience, outlines

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Save outline visibility between sessions.  Currently this module
;; supports saving to a file-local variable and a dedicated file.  It
;; is intended to use the dedicated file, but supporting multiple
;; storage back-ends seemed like a fun hack and not all that hard to
;; do.

;;; Code:

(require 'eieio)

(defgroup persistent-outline nil
  "Customization settings for persistent-outline."
  :group 'outlines)

(defcustom persistent-outline-storage 'perso-filesystem-storage
  "How to store outlines."
  :group 'persistent-outline
  :type '(radio
          (const :tag "In separate file" perso-filesystem-storage)
          (const :tag "In a file-local variable" perso-file-local-storage)))

(defcustom persistent-outline-storage-directory
  (concat user-emacs-directory "perso/")
  "Directory where `perso-filesystem-storage' will save its files."
  :group 'persistent-outline
  :type 'directory)

(defclass perso-file-local-storage () ())
(defclass perso-filesystem-storage () ())

(defvar perso-outline)

(defun perso-outline-state ()
  "Determine the state of the headline at point.

The state is determined by looking at the current headline and
the next.

- If the current heading has been collapsed and the next is
  completely invisible the current heading is considered to have
  its complete sub-tree hidden and the symbol `subtree-hidden' is
  returned.

- If the current heading has been collapsed, the next is visible
  and its level is lower (higher value, being a child) than the
  current heading, the current heading is considered to only have
  its entry text hidden and the symbol `entry-hidden' is
  returned.

- If the current heading has been collapsed, the next is visible
  and its level is higher or equal (lower or equal value, being
  parent or sibling) to the current heading, the current heading
  is again considered to have its complete sub-tree hidden and
  the symbol `subtree-hidden' is returned.

In any other case the entry is considered to be fully visible and
the symbol `entry-visible' is returned.  The entry's leaves may
still be hidden, but those should be handled separately."
  (when (outline-on-heading-p)
    (let* ((current-level (outline-level))
           (current-invisible (outline-invisible-p (line-end-position)))
           (next-heading (save-excursion (outline-next-heading)))
           (next-level (outline-level))
           (next-invisible (outline-invisible-p next-heading)))
      (cond
       ((and current-invisible next-invisible) 'subtree-hidden)
       ((and current-invisible (not next-invisible)
             (> next-level current-level)) 'entry-hidden)
       ((and current-invisible (not next-invisible)
             (<= next-level current-level)) 'subtree-hidden)
       (t 'entry-visible)))))

(defun perso-record-outline ()
  "Get a list of all the visible outline states in the buffer."
  (save-excursion
    (goto-char (point-min))
    (let ((states (when (outline-on-heading-p)
                    (list (list (point) (perso-outline-state))))))

      (while (> (point-max) (point))
        (outline-next-visible-heading 1)
        (when (outline-on-heading-p)
          (setq states
                (cons (list (point) (perso-outline-state)) states))))
      (reverse states))))

(defun perso-apply-outline (outlines)
  "Apply the outline states in OUTLINES to the current buffer."
  (mapc (lambda (outline)
          (case (cadr outline)
            (entry-visible nil)
            (entry-hidden
             (goto-char (car outline))
             (hide-entry))
            (subtree-hidden
             (goto-char (car outline))
             (hide-subtree))))
        outlines))

(defun perso--get-filename (file)
  "Get a filename for FILE to store some information in.

The way the filename is created has been inspired by the
functions for creating backup and autosave filenames."
  (concat persistent-outline-storage-directory
          (subst-char-in-string
           ?/ ?! (replace-regexp-in-string "!" "!!" buffer-file-name))))

(defun perso--ensure-directory (file)
  "Make sure that the directory for FILE exists."
  (let ((directory (file-name-directory file)))
    (unless (file-exists-p directory)
      (make-directory directory :parents))))

(defmethod perso-save-to-storage ((storage perso-file-local-storage)
                                  outline)
  "Save the current states to a file-local variable."
  (let ((modifiedp (buffer-modified-p)))
    (add-file-local-variable 'perso-outline outline)
    (set (make-local-variable 'perso-outline) outline)))

(defmethod perso-save-to-storage ((storage perso-filesystem-storage)
                                  outline)
  "Save the current state to a dedicated file somewhere."
  (let ((filename (perso--get-filename buffer-file-name)))
    (perso--ensure-directory filename)
    (with-temp-buffer
      (print outline (current-buffer))
      (write-file filename))))

(defmethod perso-load-from-storage ((storage perso-file-local-storage))
  "Load saved states from a file-local variable."
  (when (boundp (make-local-variable 'perso-outline))
    (symbol-value 'perso-outline)))

(defmethod perso-load-from-storage ((storage perso-filesystem-storage))
  "Load saved states from a dedicated file somewhere."
  (let ((filename (perso--get-filename buffer-file-name)))
    (when (file-exists-p filename)
      (with-temp-buffer
        (insert-file-contents filename)
        (read (current-buffer))))))

;;;###autoload
(put 'perso-outline 'safe-local-variable 'listp)

(defun persistent-outline-save ()
  "Save the current outline state.

The way the outline is saved depends on the value of the
`persistent-outline-storage' user-option."
  (interactive)
  (save-excursion
    (perso-save-to-storage (make-instance persistent-outline-storage)
                           (perso-record-outline))))

(defun persistent-outline-load ()
  "Load a saved outline state.

The way the outline is loaded depends on the value of the
`persistent-outline-storage' user-option."
  (interactive)
  (save-excursion
    (perso-apply-outline
     (perso-load-from-storage
      (make-instance persistent-outline-storage)))))

;;;###autoload
(define-minor-mode persistent-outline-mode
  "This minor mode adds a function to the `before-save-hook' hook.

This function saves the current outline state each time the
buffer is saved. The saved state is also loaded when this minor
mode is enabled.

Be sure to save the state of the outlines before disabling this
minor mode as it is not saved automatically in this case."
  nil "P" nil
  :group 'outlines
  (if persistent-outline-mode
      (progn
        (persistent-outline-load)
        (add-hook 'before-save-hook #'persistent-outline-save
                  nil :local))
    (remove-hook 'before-save-hook #'persistent-outline-save :local)))

(provide 'persistent-outline)
;;; persistent-outline.el ends here