persistent-outline/persistent-outline.el

;;; 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)

(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