1 ;;; foldit.el --- Helpers for folding
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: 2009-08-10 Mon
11 ;; Features that might be required by this library:
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19 ;; Defines `foldit-mode' which puts visual clues on hidden regions.
20 ;; Does not do any folding itself but works with `outline-minor-mode'
21 ;; and `hs-minor-mode'.
23 ;; Fix-me: reveal-mode does not work with this and I have no idea why
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33 ;; This program is free software; you can redistribute it and/or
34 ;; modify it under the terms of the GNU General Public License as
35 ;; published by the Free Software Foundation; either version 3, or
36 ;; (at your option) any later version.
38 ;; This program is distributed in the hope that it will be useful,
39 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
40 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
41 ;; General Public License for more details.
43 ;; You should have received a copy of the GNU General Public License
44 ;; along with this program; see the file COPYING. If not, write to
45 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
46 ;; Floor, Boston, MA 02110-1301, USA.
48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
52 ;; Fix-me: start-tag-beg/start-tag-end are workarounds for smaller
53 ;; bugs in hs-minor-mode and outline-minor-mode. Maybe try to fix
54 ;; them... - but there are a whole bunch of other invisibilty related
55 ;; bugs that ought to be fixed first since otherwise it is impossible
56 ;; to know where point goes after hiding/unhiding.
58 (eval-when-compile (require 'cl))
59 (eval-when-compile (require 'hideshow))
60 (eval-when-compile (require 'mumamo nil t))
61 (eval-when-compile (require 'outline))
63 (defsubst foldit-overlay-priority ()
64 (1+ (or (and (boundp 'mlinks-link-overlay-priority)
65 mlinks-link-overlay-priority)
70 "Customization group for foldit folding helpers."
73 (defvar foldit-temp-at-point-ovl nil)
74 (make-variable-buffer-local 'foldit-temp-at-point-ovl)
77 (define-minor-mode foldit-mode
78 "Minor mode providing visual aids for folding.
79 Shows some hints about what you have hidden and how to reveal it.
81 Supports `hs-minor-mode', `outline-minor-mode' and major modes
82 derived from `outline-mode'."
87 (add-hook 'outline-view-change-hook 'foldit-outline-change nil t)
89 (when (or (and (boundp 'outline-minor-mode) outline-minor-mode)
91 (derived-mode-p 'outline-mode)) (foldit-outline-change))
93 (unless (local-variable-p 'hs-set-up-overlay)
94 (set (make-local-variable 'hs-set-up-overlay) 'foldit-hs-set-up-overlay))
96 (when (or (and (boundp 'hs-minor-mode) hs-minor-mode))
100 (dolist (ovl (overlays-in (point-min) (point-max)))
101 (when (eq (overlay-get ovl 'invisible) 'hs)
102 (funcall hs-set-up-overlay ovl)))))))
104 (remove-hook 'outline-view-change-hook 'foldit-outline-change t)
106 (when (and (local-variable-p 'hs-set-up-overlay)
107 (eq hs-set-up-overlay 'foldit-hs-set-up-overlay))
108 (kill-local-variable 'hs-set-up-overlay))
109 ;; Remove our overlays
113 (dolist (ovl (overlays-in (point-min) (point-max)))
114 (when (setq prop (overlay-get ovl 'foldit))
116 ;;('display (overlay-put ovl 'display nil))
117 ('foldit (delete-overlay ovl))
118 (t (delete-overlay ovl))
121 (defcustom foldit-avoid '(org-mode)
122 "List of major modes to avoid."
126 (define-globalized-minor-mode foldit-global-mode foldit-mode
127 (lambda () (foldit-mode 1))
130 (defun foldit-hidden-line-str (hidden-lines type)
131 "String to display for hidden lines.
132 HIDDEN-LINES are the number of lines and TYPE is a string
133 indicating how they were hidden."
134 (propertize (format " ...(%d %slines)" hidden-lines type)
137 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
140 (defvar foldit-outline-keymap
141 (let ((map (make-sparse-keymap)))
142 (define-key map "\r" 'foldit-outline-show-entry)
143 (define-key map [down-mouse-1] 'foldit-outline-show-entry)
144 (define-key map [S-tab] 'mlinks-backward-link)
145 (define-key map [tab] 'mlinks-forward-link)
146 (define-key map "\t" 'mlinks-forward-link)
149 (defun foldit-outline-change ()
150 "Check outline overlays.
151 Run this in `outline-view-change-hook'."
152 ;; We get the variables FROM and TO here from `outline-flag-region'
153 ;; so let us use them. But O is hidden...
160 ((and (boundp 'start)
167 (setq from (point-min))
168 (setq to (point-max))))
169 (dolist (ovl (overlays-in from to))
170 (when (eq (overlay-get ovl 'invisible) 'outline)
171 (setq num-lines (count-lines (overlay-start ovl) (overlay-end ovl)))
172 (overlay-put ovl 'display (concat
173 (propertize "+" 'face 'mode-line)
175 tag (foldit-hidden-line-str num-lines "")))
176 (overlay-put ovl 'foldit 'display) ;; Should be a list...
177 (overlay-put ovl 'keymap foldit-outline-keymap)
178 (overlay-put ovl 'face 'lazy-highlight)
179 (overlay-put ovl 'mouse-face 'highlight)
180 (overlay-put ovl 'help-echo "Press RET to show hidden part")
181 (overlay-put ovl 'mlinks-link t)
182 (overlay-put ovl 'priority (foldit-overlay-priority))
183 (mumamo-with-buffer-prepared-for-jit-lock
184 (let* ((start-tag-beg (overlay-start ovl))
185 (start-tag-end start-tag-beg))
186 (put-text-property start-tag-beg (+ start-tag-beg 1)
187 'foldit-tag-end (copy-marker start-tag-end))))
190 (defvar foldit-outline-hide-again-keymap
191 (let ((map (make-sparse-keymap)))
192 (define-key map "\r" 'foldit-outline-hide-again)
193 (define-key map [down-mouse-1] 'foldit-outline-hide-again)
194 (define-key map [S-tab] 'mlinks-backward-link)
195 (define-key map [tab] 'mlinks-forward-link)
196 (define-key map "\t" 'mlinks-forward-link)
199 (defun foldit-outline-show-entry ()
202 (let ((tag-end (get-text-property (point) 'foldit-tag-end)))
204 (mumamo-with-buffer-prepared-for-jit-lock
205 (set-text-properties (point) (+ (point) 2) 'foldit-tag-end))
206 (when tag-end (goto-char tag-end))
207 (foldit-add-temp-at-point-overlay "-"
208 foldit-outline-hide-again-keymap
209 "Press RET to hide again")))
211 (defun foldit-outline-hide-again ()
214 (when (overlayp foldit-temp-at-point-ovl)
215 (delete-overlay foldit-temp-at-point-ovl))
219 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
222 (defvar foldit-hs-start-tag-end-func 'foldit-hs-default-start-tag-end)
223 (make-variable-buffer-local 'foldit-hs-start-tag-end-func)
224 (put 'foldit-hs-start-tag-end-func 'permanent-local t)
226 (defun foldit-hs-default-start-tag-end (beg)
227 "Find end of hide/show tag beginning at BEG."
231 (line-end-position))))
233 (defvar foldit-hs-keymap
234 (let ((map (make-sparse-keymap)))
235 (define-key map "\r" 'foldit-hs-show-block)
236 (define-key map [down-mouse-1] 'foldit-hs-show-block)
237 (define-key map [S-tab] 'mlinks-backward-link)
238 (define-key map [tab] 'mlinks-forward-link)
239 (define-key map "\t" 'mlinks-forward-link)
242 (defvar foldit-hs-hide-again-keymap
243 (let ((map (make-sparse-keymap)))
244 (define-key map "\r" 'foldit-hs-hide-again)
245 (define-key map [down-mouse-1] 'foldit-hs-hide-again)
246 (define-key map [S-tab] 'mlinks-backward-link)
247 (define-key map [tab] 'mlinks-forward-link)
248 (define-key map "\t" 'mlinks-forward-link)
251 (defun foldit-hs-set-up-overlay (ovl)
252 "Set up overlay OVL for hide/show."
253 (let* ((num-lines (count-lines (overlay-start ovl) (overlay-end ovl)))
255 (start-tag-beg (overlay-start ovl))
256 (start-tag-end (funcall foldit-hs-start-tag-end-func start-tag-beg))
257 (tag (buffer-substring start-tag-beg start-tag-end)))
259 ;;(overlay-put ovl 'isearch-open-invisible t)
260 (overlay-put ovl 'display (concat
261 (propertize "+" 'face 'mode-line)
263 tag (foldit-hidden-line-str num-lines "h")))
264 (overlay-put ovl 'foldit 'display)
265 (overlay-put ovl 'keymap foldit-hs-keymap)
266 (overlay-put ovl 'face 'next-error)
267 (overlay-put ovl 'face 'lazy-highlight)
268 (overlay-put ovl 'mouse-face 'highlight)
269 (overlay-put ovl 'help-echo "Press RET to show hidden part")
270 (overlay-put ovl 'mlinks-link t)
271 (overlay-put ovl 'priority (foldit-overlay-priority))
272 (mumamo-with-buffer-prepared-for-jit-lock
273 (put-text-property start-tag-beg (+ start-tag-beg 1)
274 'foldit-tag-end (copy-marker start-tag-end)))))
276 (defun foldit-hs-show-block ()
279 (let ((tag-end (get-text-property (point) 'foldit-tag-end)))
281 (mumamo-with-buffer-prepared-for-jit-lock
282 (set-text-properties (point) (+ (point) 2) 'foldit-tag-end))
283 (when tag-end (goto-char tag-end))
284 (foldit-add-temp-at-point-overlay "-"
285 foldit-hs-hide-again-keymap
286 "Press RET to hide again")))
288 (defun foldit-hs-hide-again ()
289 "Hide hide/show block again."
291 (when (overlayp foldit-temp-at-point-ovl)
292 (delete-overlay foldit-temp-at-point-ovl))
296 ;;; Fix-me: break out this
297 ;; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
298 (defun foldit-add-temp-at-point-overlay (marker keymap msg)
299 "Add a temporary overlay with a marker MARKER and a keymap KEYMAP.
300 The overlay is also given the help echo MSG.
302 This overlay is removed as soon as point moves from current point."
303 (let ((ovl (make-overlay (point) (1+ (point))))
304 (real (buffer-substring (point) (1+ (point)))))
305 (overlay-put ovl 'isearch-open-invisible t)
306 (overlay-put ovl 'display (concat
307 (propertize marker 'face 'mode-line)
311 (overlay-put ovl 'foldit 'foldit)
312 (overlay-put ovl 'keymap keymap)
313 (overlay-put ovl 'face 'lazy-highlight)
314 (overlay-put ovl 'mouse-face 'highlight)
315 (overlay-put ovl 'help-echo msg)
316 (overlay-put ovl 'mlinks-link t)
317 (overlay-put ovl 'priority (foldit-overlay-priority))
318 (setq foldit-temp-at-point-ovl ovl)
319 (add-hook 'post-command-hook
320 'foldit-remove-temp-at-point-overlay
323 (defun foldit-remove-temp-at-point-overlay ()
324 "Remove overlay made by `foldit-add-temp-at-point-overlay'."
326 (unless (and foldit-temp-at-point-ovl
327 (overlay-buffer foldit-temp-at-point-ovl)
328 (= (overlay-start foldit-temp-at-point-ovl)
330 (delete-overlay foldit-temp-at-point-ovl)
331 (setq foldit-temp-at-point-ovl nil)
332 (remove-hook 'post-command-hook 'foldit-remove-temp-at-point-overlay t)
334 (error (message "foldit-remove-temp-at-point-overlay: %s"
335 (propertize (error-message-string err))))))
336 ;; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
340 ;; (defun put-before-on-invis ()
343 ;; (dolist (o (overlays-at (1+ (point))))
344 ;; (when (overlay-get o 'invisible)
346 ;; (str (propertize "IOSTRING"
347 ;; 'face 'secondary-selection
349 ;; (overlay-put io 'before-string str)
350 ;; ;;(overlay-put io 'display "display")
351 ;; (overlay-put io 'display nil)
352 ;; ;;(overlay-put io 'after-string "AFTER")
356 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
357 ;;; foldit.el ends here