157 lines
5.1 KiB
EmacsLisp
157 lines
5.1 KiB
EmacsLisp
;;; 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
|