blob: ebc6c8ef62ad7fa62adf3819a144ae52545cb941 (
about) (
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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
(require 'outline)
;;; Finding Positions in the Buffer
(defun org-fc-overlay--point-at-end-of-previous ()
"Value of point at the end of the previous line.
Returns nil if there is no previous line."
(save-excursion
(beginning-of-line)
(if (bobp)
nil
(progn (backward-char)
(point)))))
(defun org-fc-overlay--point-after-title ()
"Value of point at the first line after the title keyword.
Returns nil if there is no title keyword."
(save-excursion
(goto-char (point-min))
(when (re-search-forward (rx bol "#+TITLE:") nil t)
(forward-line 1)
(beginning-of-line)
(point))))
;;; Showing / Hiding Regions
(defun org-fc-show-all ()
"Remove all org-fc overlays in the current buffer."
(interactive)
(remove-overlays (point-min) (point-max) 'category 'org-fc-hidden)
(remove-overlays (point-min) (point-max) 'category 'org-fc-visible))
;; Based on `outline-flag-region'
(defun org-fc-hide-region (from to &optional text)
"Hide region, optionally replacing it with TEXT."
;; (remove-overlays from to 'category 'org-fc-hidden)
(let ((o (make-overlay from to nil 'front-advance)))
(overlay-put o 'display-original (overlay-get o 'display))
(overlay-put o 'category 'org-fc-hidden)
(overlay-put o 'evaporate t)
(if (stringp text)
(progn
(overlay-put o 'invisible nil)
(overlay-put o 'face 'default)
(overlay-put o 'display text))
(overlay-put o 'invisible t))
o))
(defun org-fc-overlay-region (from to)
"Wrap region in an overlay for later hiding"
;; (remove-overlays from to 'category 'org-fc-hidden)
(let ((o (make-overlay from to)))
(overlay-put o 'evaporate t)
(overlay-put o 'invisible nil)
(overlay-put o 'category 'org-fc-visible)
o))
(defun org-fc-hide-overlay (o)
"Hide the overlay O."
(overlay-put o 'category 'org-fc-hidden)
(overlay-put o 'invisible t)
(overlay-put o 'display ""))
(defun org-fc-show-overlay (o &optional face)
"Show the overlay O using an optional font FACE."
(overlay-put o 'category 'org-fc-hidden)
(overlay-put o 'invisible nil)
(if face
(overlay-put o 'face face)))
;;;; Hiding Drawers
(defun org-fc-hide-drawers ()
"Hide all drawers after point."
(save-excursion
(while (re-search-forward org-drawer-regexp nil t)
(let ((start (1- (match-beginning 0)))
(end))
(if (re-search-forward ":END:" nil t)
(setq end (point))
(error "No :END: found for drawer"))
(org-fc-hide-region start end)))))
;;;; Hiding Headings
(defun org-fc-hide-subheadings-if (test)
"TEST is a function taking no arguments. TEST will be called for each
of the immediate subheadings of the current headline, with the point
on the relevant subheading. TEST should return nil if the subheading is
to be revealed, non-nil if it is to be hidden.
Returns a list containing the position of each immediate subheading of
the current topic."
(let ((entry-level (org-current-level))
(sections nil))
(org-show-subtree)
(save-excursion
(org-map-entries
(lambda ()
(when (and (not (outline-invisible-p))
(> (org-current-level) entry-level))
(when (or (/= (org-current-level) (1+ entry-level))
(funcall test))
(outline-hide-subtree))
(push (point) sections)))
t 'tree))
(reverse sections)))
(defun org-fc-hide-subheading (name)
"Hide all subheadings matching NAME."
(org-fc-hide-subheadings-if
(lambda () (string= (org-get-heading t) name))))
(defun org-fc-hide-all-subheadings-except (heading-list)
"Hide all subheadings except HEADING-LIST."
(org-fc-hide-subheadings-if
(lambda () (not (member (org-get-heading t) heading-list)))))
;;;; Hiding Headline Contents
(defun org-fc-hide-content (&optional text)
"Hide the main text of a heading *before* the first subheading."
(let (start end)
(save-excursion
(org-back-to-heading)
(forward-line)
(setq start (point)))
(save-excursion
(outline-next-heading)
(setq end (point)))
(org-fc-hide-region start end text)))
(defun org-fc-hide-heading (&optional text)
"Hide the title of the headline at point"
(save-excursion
(beginning-of-line)
(if (looking-at org-complex-heading-regexp)
(org-fc-hide-region (match-beginning 4) (match-end 4) (or text "..."))
(error "Point is not on a heading"))))
;;;; Narrowing Outline Trees
(defun org-fc-narrow-tree ()
(interactive)
(save-excursion
(org-fc-goto-entry-heading)
(let* ((end (org-fc-overlay--point-at-end-of-previous))
(tags (org-get-tags nil t))
(notitle (member "notitle" tags))
(noheading (member "noheading" tags))
(el (org-element-at-point))
(current-end (org-element-property :contents-end el)))
(if noheading
(org-fc-hide-heading))
(while (org-up-heading-safe)
(let ((start (point-at-eol))
(end_ (org-fc-overlay--point-at-end-of-previous)))
(if (< start end)
(org-fc-hide-region end start))
(setq end end_)))
(let ((at (org-fc-overlay--point-after-title))
(eop (org-fc-overlay--point-at-end-of-previous)))
;; Don't hide anything if the heading is at the beginning of the buffer
(if eop
(if (and at (not notitle))
(org-fc-hide-region at (org-fc-overlay--point-at-end-of-previous))
(org-fc-hide-region (point-min) (org-fc-overlay--point-at-end-of-previous)))))
(org-fc-hide-region current-end (point-max)))))
;;; Exports
(provide 'org-fc-overlay)
|
