/bdw/emacs/nxhtml/util/foldit.el
Emacs Lisp | 357 lines | 231 code | 33 blank | 93 comment | 4 complexity | 43e94253a01d9d6e2b7ad02becc10474 MD5 | raw file
1;;; foldit.el --- Helpers for folding
2;;
3;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4;; Created: 2009-08-10 Mon
5;; Version:
6;; Last-Updated:
7;; URL:
8;; Keywords:
9;; Compatibility:
10;;
11;; Features that might be required by this library:
12;;
13;; None
14;;
15;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16;;
17;;; Commentary:
18;;
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'.
22;;
23;; Fix-me: reveal-mode does not work with this and I have no idea why
24;; ...
25;;
26;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27;;
28;;; Change log:
29;;
30;;
31;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32;;
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.
37;;
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.
42;;
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.
47;;
48;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
49;;
50;;; Code:
51
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.
57
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))
62
63(defsubst foldit-overlay-priority ()
64 (1+ (or (and (boundp 'mlinks-link-overlay-priority)
65 mlinks-link-overlay-priority)
66 100)))
67
68;;;###autoload
69(defgroup foldit nil
70 "Customization group for foldit folding helpers."
71 :group 'nxhtml)
72
73(defvar foldit-temp-at-point-ovl nil)
74(make-variable-buffer-local 'foldit-temp-at-point-ovl)
75
76;;;###autoload
77(define-minor-mode foldit-mode
78 "Minor mode providing visual aids for folding.
79Shows some hints about what you have hidden and how to reveal it.
80
81Supports `hs-minor-mode', `outline-minor-mode' and major modes
82derived from `outline-mode'."
83 :lighter nil
84 (if foldit-mode
85 (progn
86 ;; Outline
87 (add-hook 'outline-view-change-hook 'foldit-outline-change nil t)
88 ;; Add our overlays
89 (when (or (and (boundp 'outline-minor-mode) outline-minor-mode)
90 ;; Fix-me: mumamo
91 (derived-mode-p 'outline-mode)) (foldit-outline-change))
92 ;; hs
93 (unless (local-variable-p 'hs-set-up-overlay)
94 (set (make-local-variable 'hs-set-up-overlay) 'foldit-hs-set-up-overlay))
95 ;; Add our overlays
96 (when (or (and (boundp 'hs-minor-mode) hs-minor-mode))
97 (save-restriction
98 (widen)
99 (let (ovl)
100 (dolist (ovl (overlays-in (point-min) (point-max)))
101 (when (eq (overlay-get ovl 'invisible) 'hs)
102 (funcall hs-set-up-overlay ovl)))))))
103 ;; Outline
104 (remove-hook 'outline-view-change-hook 'foldit-outline-change t)
105 ;; hs
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
110 (save-restriction
111 (widen)
112 (let (ovl prop)
113 (dolist (ovl (overlays-in (point-min) (point-max)))
114 (when (setq prop (overlay-get ovl 'foldit))
115 (case prop
116 ;;('display (overlay-put ovl 'display nil))
117 ('foldit (delete-overlay ovl))
118 (t (delete-overlay ovl))
119 )))))))
120
121(defcustom foldit-avoid '(org-mode)
122 "List of major modes to avoid."
123 :group 'foldit)
124
125;;;###autoload
126(define-globalized-minor-mode foldit-global-mode foldit-mode
127 (lambda () (foldit-mode 1))
128 :group 'foldit)
129
130(defun foldit-hidden-line-str (hidden-lines type)
131 "String to display for hidden lines.
132HIDDEN-LINES are the number of lines and TYPE is a string
133indicating how they were hidden."
134 (propertize (format " ...(%d %slines)" hidden-lines type)
135 'face 'shadow))
136
137;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
138;;; Outline
139
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)
147 map))
148
149(defun foldit-outline-change ()
150 "Check outline overlays.
151Run 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...
154 (let* (from
155 to
156 num-lines
157 ovl
158 (tag ""))
159 (cond
160 ((and (boundp 'start)
161 start
162 (boundp 'end)
163 end)
164 (setq from start)
165 (setq to end))
166 (t
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)
174 ""
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))))
188 ))))
189
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)
197 map))
198
199(defun foldit-outline-show-entry ()
200 "Show hidden entry."
201 (interactive)
202 (let ((tag-end (get-text-property (point) 'foldit-tag-end)))
203 (show-entry)
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")))
210
211(defun foldit-outline-hide-again ()
212 "Hide entry again."
213 (interactive)
214 (when (overlayp foldit-temp-at-point-ovl)
215 (delete-overlay foldit-temp-at-point-ovl))
216 (hide-entry))
217
218
219;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
220;;; Hide/Show
221
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)
225
226(defun foldit-hs-default-start-tag-end (beg)
227 "Find end of hide/show tag beginning at BEG."
228 (min (+ beg 65)
229 (save-excursion
230 (goto-char beg)
231 (line-end-position))))
232
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)
240 map))
241
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)
249 map))
250
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)))
254 (here (point))
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)))
258 (goto-char here)
259 ;;(overlay-put ovl 'isearch-open-invisible t)
260 (overlay-put ovl 'display (concat
261 (propertize "+" 'face 'mode-line)
262 " "
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)))))
275
276(defun foldit-hs-show-block ()
277 "Show hidden block."
278 (interactive)
279 (let ((tag-end (get-text-property (point) 'foldit-tag-end)))
280 (hs-show-block)
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")))
287
288(defun foldit-hs-hide-again ()
289 "Hide hide/show block again."
290 (interactive)
291 (when (overlayp foldit-temp-at-point-ovl)
292 (delete-overlay foldit-temp-at-point-ovl))
293 (hs-hide-block))
294
295
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.
300The overlay is also given the help echo MSG.
301
302This 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)
308 " "
309 msg
310 real))
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
321 nil t)))
322
323(defun foldit-remove-temp-at-point-overlay ()
324 "Remove overlay made by `foldit-add-temp-at-point-overlay'."
325 (condition-case err
326 (unless (and foldit-temp-at-point-ovl
327 (overlay-buffer foldit-temp-at-point-ovl)
328 (= (overlay-start foldit-temp-at-point-ovl)
329 (point)))
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)
333 )
334 (error (message "foldit-remove-temp-at-point-overlay: %s"
335 (propertize (error-message-string err))))))
336;; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
337
338
339
340;; (defun put-before-on-invis ()
341;; (let* (o
342;; (io (catch 'io
343;; (dolist (o (overlays-at (1+ (point))))
344;; (when (overlay-get o 'invisible)
345;; (throw 'io o)))))
346;; (str (propertize "IOSTRING"
347;; 'face 'secondary-selection
348;; )))
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")
353;; ))
354
355(provide 'foldit)
356;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
357;;; foldit.el ends here