Initial commitHEADmaster

1 files changed, 67 insertions, 0 deletions

diff --git a/fld.el b/fld.el
new file mode 100644
index 0000000..7337f64
--- /dev/null
+++ b/fld.el
@@ -0,0 +1,67 @@
+;;; 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)))