blob: 7337f6466877566bae4f5cf81af4565e64b64308 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
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)))
|
