ryuslash/fldel
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Initial commit

Browse source
This commit is contained in:
Tom Willemsen 2012-09-14 01:31:37 +02:00
commit a536bc7404
1 changed files with 67 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

67
fld.el Normal file
View file

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