;;; fld.el --- Lots of folding

;; Copyright (C) 2012  Tom Willemsen

;; Author: Tom Willemsen <ryuslash@ninthfloor.org>
;; Keywords: convenience, extensions, outlines
(defvar fld-folds '())
(make-variable-buffer-local 'fld-folds)

(defun fld-fold-region (start end)
  (interactive "r")
  (if (> end start)
      (let* ((starting-point (save-excursion
                               (goto-char start)
                               (line-beginning-position)))
             (fold-start (save-excursion
                           (goto-char start)
                           (line-end-position)))
             (fold-end (save-excursion
                         (goto-char end)
                         (line-end-position)))
             (overlay (make-overlay fold-start (1- fold-end))))
        (overlay-put overlay 'invisible t)
        (overlay-put overlay 'before-string "...")
        (setq buffer-folds
              (append
               (list
                (cons starting-point
                      (list (cons 'heading (buffer-substring-no-properties
                                            starting-point fold-start))
                            (cons 'start fold-start)
                            (cons 'end fold-end))))
               buffer-folds)))
    (error "Cannot fold inverse region.")))

(defun fld-unfold-region (start end)
  (interactive "r")
  (if (> end start)
      (let ((overlays (overlays-in start end)))
        (mapc 'delete-overlay overlays)
        (setq buffer-folds (assq-delete-all start buffer-folds)))
    (error "Cannot unfold inverse region.")))

(defun fold-sexp ()
  (interactive)
  (let ((start (point)))
    (save-excursion
      (forward-sexp)
      (fld-fold-region start (point)))))

(defun unfold-sexp ()
  (interactive)
  (let ((start (point)))
    (save-excursion
      (forward-sexp)
      (fld-unfold-region start (point)))))

(defun fld-sexp-folded-p ()
  (save-excursion
    (end-of-line)
    (not (eq (overlays-at (point)) nil))))

(defun fld-fold-sexp-toggle ()
  (interactive)
  (if (sexp-folded-p)
      (unfold-sexp)
    (fold-sexp)))