Initial commit

persistent-outline.el

@@ -0,0 +1,140 @@
+;;; 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.
+
+;;; Code:
+
+(require 'eieio)
+
+(defclass perso-file-local-storage () ())
+(defclass perso-filesystem-storage () ())
+
+(defvar perso-storage 'perso-filesystem-storage)
+(defvar perso-outline)
+
+(defun perso-outline-state ()
+  ""
+  (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 ()
+  ""
+  (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)
+  (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)
+  (concat "~/.emacs.d/perso/"
+          (subst-char-in-string
+           ?/ ?! (replace-regexp-in-string "!" "!!" buffer-file-name))))
+
+(defun perso--ensure-directory (file)
+  (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)
+  (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)
+  (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))
+  (when (boundp (make-local-variable 'perso-outline))
+    (symbol-value 'perso-outline)))
+
+(defmethod perso-load-from-storage ((storage perso-filesystem-storage))
+  (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 ()
+  (interactive)
+  (save-excursion
+    (perso-save-to-storage (make-instance perso-storage)
+                           (perso-record-outline))))
+
+(defun persistent-outline-load ()
+  (interactive)
+  (save-excursion
+    (perso-apply-outline
+     (perso-load-from-storage (make-instance perso-storage)))))
+
+;;;###autoload
+(define-minor-mode persistent-outline-mode
+  ""
+  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