;;; 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 ()
  ""
  (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 persistent-outline-storage-directory
          (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 persistent-outline-storage)
                           (perso-record-outline))))

(defun persistent-outline-load ()
  (interactive)
  (save-excursion
    (perso-apply-outline
     (perso-load-from-storage
      (make-instance persistent-outline-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