Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode |
e745364e | 2 | |
ba318903 | 3 | ;; Copyright (C) 1994, 2001-2014 Free Software Foundation, Inc. |
e745364e RS |
4 | |
5 | ;; Author: Kevin Broadey <KevinB@bartley.demon.co.uk> | |
34dc21db | 6 | ;; Maintainer: emacs-devel@gnu.org |
e745364e | 7 | ;; Created: 27 Jan 1994 |
bd78fa1d | 8 | ;; Version: 1.10 |
e548a4f7 | 9 | ;; Keywords: folding, outlines |
e745364e | 10 | |
0b6db30b | 11 | ;; This file is part of GNU Emacs. |
e745364e | 12 | |
eb3fa2cf | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
e745364e | 14 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
e745364e RS |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
eb3fa2cf | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
e745364e RS |
25 | |
26 | ;;; Commentary: | |
27 | ||
28 | ;; This file provides folding editor extensions for outline-mode and | |
29 | ;; outline-minor-mode buffers. What's a "folding editor"? Read on... | |
30 | ;; | |
31 | ;; Imagine you're in an outline-mode buffer and you've hidden all the text and | |
32 | ;; subheadings under your level-1 headings. You now want to look at the stuff | |
33 | ;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry) | |
34 | ;; to expose the body or C-c C-i to expose the child (level-2) headings. | |
35 | ;; | |
36 | ;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body | |
37 | ;; and child subheadings and narrows the buffer so that only the level-1 | |
38 | ;; heading, the body and the level-2 headings are visible. If you now want to | |
39 | ;; look under one of the level-2 headings, position the cursor on it and do C-c | |
40 | ;; C-z again. This exposes the level-2 body and its level-3 child subheadings | |
41 | ;; and narrows the buffer again. You can keep on zooming in on successive | |
37269466 | 42 | ;; subheadings as much as you like. A string in the mode line tells you how |
e745364e RS |
43 | ;; deep you've gone. |
44 | ;; | |
45 | ;; When zooming in on a heading you might only want to see the child | |
46 | ;; subheadings. You do this by specifying a numeric argument: C-u C-c C-z. | |
47 | ;; You can specify the number of levels of children too (c.f. show-children): | |
48 | ;; e.g. M-2 C-c C-z exposes two levels of child subheadings. Alternatively, | |
49 | ;; you might only be interested in the body. You do this by specifying a | |
50 | ;; negative argument: M-- C-c C-z. You can also cause the whole subtree to be | |
51 | ;; expanded, similar to C-c C-s (show-subtree), by specifying a zero argument: | |
52 | ;; M-0 C-c C-z. | |
53 | ;; | |
54 | ;; While you're zoomed in you can still use outline-mode's exposure and hiding | |
55 | ;; functions. It won't upset foldout at all. Also, since the buffer is | |
56 | ;; narrowed, "global" editing actions will only affect the stuff under the | |
57 | ;; zoomed-in heading. This is useful for restricting changes to a particular | |
58 | ;; chapter or section of your document. | |
59 | ;; | |
60 | ;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides | |
61 | ;; all the text and subheadings under the top-level heading and returns you to | |
62 | ;; the previous view of the buffer. Specifying a numeric argument exits that | |
63 | ;; many folds. Specifying a zero argument exits *all* folds. | |
64 | ;; | |
65 | ;; You might want to exit a fold *without* hiding the text and subheadings. | |
66 | ;; You do this by specifying a negative argument. For example, M--2 C-c C-x | |
67 | ;; exits two folds and leaves the text and subheadings exposed. | |
68 | ;; | |
69 | ;; Foldout also provides mouse bindings for entering and exiting folds and for | |
70 | ;; showing and hiding text. Hold down Meta and Control, then click a mouse | |
71 | ;; button as follows:- | |
72 | ;; | |
73 | ;; mouse-1 (foldout-mouse-zoom) zooms in on the heading clicked on:- | |
74 | ;; | |
75 | ;; single click expose body | |
76 | ;; double click expose subheadings | |
77 | ;; triple click expose body and subheadings | |
78 | ;; quad click expose entire subtree | |
79 | ;; | |
80 | ;; mouse-2 (foldout-mouse-show) exposes text under the heading clicked on:- | |
81 | ;; | |
82 | ;; single click expose body | |
83 | ;; double click expose subheadings | |
84 | ;; triple click expose body and subheadings | |
85 | ;; quad click expose entire subtree | |
86 | ;; | |
87 | ;; mouse-3 (foldout-mouse-hide-or-exit) hides text under the heading clicked | |
88 | ;; on or exits the fold:- | |
89 | ;; | |
90 | ;; single click hide subtree | |
91 | ;; double click exit fold and hide text | |
92 | ;; triple click exit fold without hiding text | |
93 | ;; quad click exit all folds and hide text | |
94 | ;; | |
95 | ;; You can change the modifier keys used by setting `foldout-mouse-modifiers'. | |
96 | ||
97 | ;;; Installation: | |
98 | ||
99 | ;; To use foldout, put this in your .emacs:- | |
100 | ;; | |
101 | ;; (require 'foldout) | |
102 | ;; | |
103 | ;; If you don't want it loaded until you need it, try this instead:- | |
104 | ;; | |
105 | ;; (eval-after-load "outline" '(require 'foldout)) | |
106 | ||
107 | ;;; Advertisements: | |
108 | ||
109 | ;; Get out-xtra.el by Per Abrahamsen <abraham@iesd.auc.dk> for more | |
110 | ;; outline-mode goodies. In particular, `outline-hide-sublevels' makes | |
111 | ;; setup a lot easier. | |
112 | ;; | |
113 | ;; folding.el by Jamie Lokier <u90jl@ecs.ox.ac.uk> supports folding by | |
e1dbe924 | 114 | ;; recognizing special marker text in you file. |
e745364e | 115 | ;; |
e1dbe924 | 116 | ;; c-outline.el (by me) provides outline-mode support to recognize `C' |
e745364e RS |
117 | ;; statements as outline headings, so with foldout you can have a folding `C' |
118 | ;; code editor without having to put in start- and end-of-fold markers. This | |
119 | ;; is a real winner! | |
120 | ||
121 | ;;; ChangeLog: | |
122 | ||
a144b9e9 RS |
123 | ;; 1.10 21-Mar-94 |
124 | ;; foldout.el is now part of the GNU Emacs distribution!! | |
125 | ;; Put in changes made by RMS to version 1.8 to keep the diffs to a minimum. | |
126 | ;; bugfix: numeric arg to foldout-exit-fold wasn't working - looks like I don't | |
127 | ;; know how to use the Common LISP `loop' macro after all, so use `while' | |
128 | ;; instead. | |
129 | ||
7dbba89a RS |
130 | ;; 1.9 15-Mar-94 |
131 | ;; Didn't test that very well, did I? The change to foldout-zoom-subtree | |
132 | ;; affected foldout-mouse-zoom: if the heading under the `level n' one clicked | |
133 | ;; on was at `level n+2' then it didn't get exposed. Sorry about that! | |
134 | ||
135 | ;; 1.8 15-Mar-94 | |
e745364e RS |
136 | ;; Changed meaning of prefix arg to foldout-zoom-subtree. arg > 0 now means |
137 | ;; "expose that many children" instead of just "expose children" so it is more | |
138 | ;; like `show-children' (C-c C-i). Arg of C-u on its own only shows one level | |
139 | ;; of children, though, so you can still zoom by doing C-u C-c C-z. | |
140 | ;; | |
141 | ;; I can't think of a good meaning for the value of a negative prefix. Any | |
142 | ;; suggestions? | |
143 | ;; | |
144 | ;; Added advertisement for my c-outline.el package. Now you can have a folding | |
145 | ;; editor for c-mode without any effort! | |
146 | ||
147 | ;; 1.7 7-Mar-94 | |
148 | ;; I got fed up trying to work out how many blank lines there were outside the | |
149 | ;; narrowed region when inside a fold. Now *all* newlines before the following | |
150 | ;; heading are *in* the narrowed region. Thus, if the cursor is at point-max, | |
151 | ;; the number of blank lines above it is the number you'll get above the next | |
152 | ;; heading. | |
153 | ;; | |
154 | ;; Since all newlines are now inside the narrowed region, when exiting a fold | |
155 | ;; add a newline at the end of the region if there isn't one so that the | |
156 | ;; following heading doesn't accidentally get joined to the body text. | |
157 | ;; | |
158 | ;; Bugfix: `foldout-mouse-modifiers' should be `defvar', not `defconst'. | |
159 | ;; | |
160 | ;; Use "cond" instead of "case" so that lemacs-19.9 users can use the mouse. | |
161 | ;; | |
162 | ;; Improve "Commentary" entry on using the mouse. | |
163 | ;; | |
164 | ;; Add "Installation" keyword. | |
165 | ||
166 | ;; 1.6 3-Mar-94 | |
167 | ;; Add mouse support functions foldout-mouse-zoom, foldout-mouse-show, | |
168 | ;; foldout-mouse-hide-or-exit. | |
169 | ||
170 | ;; 1.5 11-Feb-94 | |
171 | ;; Rename `foldout-enter-subtree' to `foldout-zoom-subtree' and change | |
172 | ;; keystroke from C-g to C-z. This is more mnemonic and leaves C-g alone, as | |
173 | ;; users expect this to cancel the current key sequence. | |
174 | ;; | |
175 | ;; Added better commentary at the request of RMS. Added stuff to comply with | |
176 | ;; the lisp-mnt.el conventions. Added instructions on how best to load the | |
177 | ;; package. | |
178 | ||
179 | ;; 1.4 2-Feb-94 | |
180 | ;; Bugfix: end-of-fold marking was wrong:- | |
181 | ;; | |
182 | ;; End of narrowed region should be one character on from | |
183 | ;; (outline-end-of-subtree) so it includes the end-of-line at the end of the | |
184 | ;; last line of the subtree. | |
185 | ;; | |
186 | ;; End-of-fold marker should be outside the narrowed region so text inserted | |
187 | ;; at the end of the region goes before the marker. Need to make a special | |
188 | ;; case for end-of-buffer because it is impossible to set a marker that will | |
189 | ;; follow eob. Bummer. | |
190 | ||
191 | ;; 1.3 28-Jan-94 | |
192 | ;; Changed `foldout-zoom-subtree'. A zero arg now makes it expose the entire | |
193 | ;; subtree on entering the fold. As before, < 0 shows only the body and > 0 | |
194 | ;; shows only the subheadings. | |
195 | ||
196 | ;; 1.2 28-Jan-94 | |
37269466 | 197 | ;; Fixed a dumb bug - didn't make `foldout-mode-line-string' buffer-local :-( |
e745364e RS |
198 | ;; |
199 | ;; Changed `foldout-exit-fold' to use prefix arg to say how many folds to exit. | |
200 | ;; Negative arg means exit but don't hide text. Zero arg means exit all folds. | |
201 | ;; | |
202 | ;; Added `foldout-inhibit-key-bindings' to inhibit key bindings. | |
203 | ||
204 | ;; 1.1 27-Jan-94 | |
205 | ;; Released to the net. Inspired by a question in gnu.emacs.help from | |
206 | ;; Jason D Lohn <jlohn@eng.umd.edu>. | |
207 | ||
208 | ;;; Code: | |
209 | ||
210 | (require 'outline) | |
211 | ||
212 | ;; something has gone very wrong if outline-minor-mode isn't bound now. | |
213 | (if (not (boundp 'outline-minor-mode)) | |
214 | (error "Can't find outline-minor-mode")) | |
215 | ||
d544d2ca | 216 | (defvar foldout-fold-list nil |
e745364e | 217 | "List of start and end markers for the folds currently entered. |
0ff9b955 | 218 | An end marker of nil means the fold ends after (point-max).") |
e745364e RS |
219 | (make-variable-buffer-local 'foldout-fold-list) |
220 | ||
37269466 CY |
221 | (defvar foldout-mode-line-string nil |
222 | "Mode line string announcing that we are in an outline fold.") | |
223 | (make-variable-buffer-local 'foldout-mode-line-string) | |
e745364e RS |
224 | |
225 | ;; put our minor mode string immediately following outline-minor-mode's | |
37269466 | 226 | (or (assq 'foldout-mode-line-string minor-mode-alist) |
e745364e RS |
227 | (let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist) |
228 | minor-mode-alist)) | |
37269466 | 229 | (foldout-entry '((foldout-mode-line-string foldout-mode-line-string)))) |
e745364e RS |
230 | |
231 | ;; something's wrong with outline if we can't find it | |
232 | (if (null outl-entry) | |
233 | (error "Can't find outline-minor-mode in minor-mode-alist")) | |
234 | ||
235 | ;; slip our fold announcement into the list | |
236 | (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))) | |
237 | )) | |
4fcb3ccf RS |
238 | |
239 | ;; outline-flag-region has different `flag' values in outline.el and | |
240 | ;; noutline.el for hiding and showing text. | |
241 | ||
242 | (defconst foldout-hide-flag | |
243 | (if (featurep 'noutline) t ?\^M)) | |
244 | ||
245 | (defconst foldout-show-flag | |
246 | (if (featurep 'noutline) nil ?\n)) | |
e745364e RS |
247 | \f |
248 | ||
249 | (defun foldout-zoom-subtree (&optional exposure) | |
250 | "Open the subtree under the current heading and narrow to it. | |
251 | ||
252 | Normally the body and the immediate subheadings are exposed, but | |
253 | optional arg EXPOSURE \(interactively with prefix arg\) changes this:- | |
254 | ||
255 | EXPOSURE > 0 exposes n levels of subheadings (c.f. show-children) | |
256 | EXPOSURE < 0 exposes only the body | |
257 | EXPOSURE = 0 exposes the entire subtree" | |
258 | (interactive "P") | |
259 | (save-excursion | |
260 | (widen) | |
261 | (outline-back-to-heading) | |
262 | (let* ((exposure-value (prefix-numeric-value exposure)) | |
263 | (start (point)) | |
264 | (start-marker (point-marker)) | |
265 | (end (progn (outline-end-of-subtree) | |
266 | (skip-chars-forward "\n\^M") | |
267 | (point))) | |
268 | ;; I need a marker that will follow the end of the region even when | |
269 | ;; text is inserted right at the end. Text gets inserted *after* | |
270 | ;; markers, so I need it at end+1. Unfortunately I can't set a | |
0ff9b955 | 271 | ;; marker at (point-max)+1, so I use nil to mean the region ends at |
e745364e RS |
272 | ;; (point-max). |
273 | (end-marker (if (eobp) nil (set-marker (make-marker) (1+ end)))) | |
274 | ) | |
275 | ||
276 | ;; narrow to this subtree | |
277 | (narrow-to-region start end) | |
278 | ||
279 | ;; show the body and/or subheadings for this heading | |
280 | (goto-char start) | |
281 | (cond | |
282 | ((null exposure) | |
283 | (show-entry) | |
284 | (show-children)) | |
285 | ((< exposure-value 0) | |
286 | (show-entry)) | |
287 | ((consp exposure) | |
288 | (show-children)) | |
289 | ((> exposure-value 0) | |
290 | (show-children exposure-value)) | |
291 | (t | |
292 | (show-subtree)) | |
293 | ) | |
294 | ||
295 | ;; save the location of the fold we are entering | |
296 | (setq foldout-fold-list (cons (cons start-marker end-marker) | |
297 | foldout-fold-list)) | |
298 | ||
37269466 CY |
299 | ;; update the mode line |
300 | (foldout-update-mode-line) | |
e745364e RS |
301 | ))) |
302 | \f | |
303 | ||
304 | (defun foldout-exit-fold (&optional num-folds) | |
305 | "Return to the ARG'th enclosing fold view. With ARG = 0 exit all folds. | |
306 | ||
307 | Normally causes exited folds to be hidden, but with ARG < 0, -ARG folds are | |
308 | exited and text is left visible." | |
309 | (interactive "p") | |
b0562527 CY |
310 | (let ((hide-fold t) start-marker end-marker |
311 | beginning-of-heading end-of-subtree) | |
e745364e RS |
312 | |
313 | ;; check there are some folds to leave | |
314 | (if (null foldout-fold-list) | |
315 | (error "Not in a fold!")) | |
316 | ||
317 | (cond | |
318 | ;; catch a request to leave all folds | |
319 | ((zerop num-folds) | |
320 | (setq num-folds (length foldout-fold-list))) | |
71296446 | 321 | |
e745364e RS |
322 | ;; have we been told not to hide the fold? |
323 | ((< num-folds 0) | |
324 | (setq hide-fold nil | |
325 | num-folds (- num-folds))) | |
326 | ) | |
327 | ||
328 | ;; limit the number of folds if we've been told to exit too many | |
329 | (setq num-folds (min num-folds (length foldout-fold-list))) | |
330 | ||
331 | ;; exit the folds | |
332 | (widen) | |
a144b9e9 RS |
333 | (while (not (zerop num-folds)) |
334 | ;; get the fold at the top of the stack | |
335 | (setq start-marker (car (car foldout-fold-list)) | |
336 | end-marker (cdr (car foldout-fold-list)) | |
337 | foldout-fold-list (cdr foldout-fold-list) | |
338 | num-folds (1- num-folds)) | |
339 | ||
340 | ;; Make sure there is a newline at the end of this fold, | |
341 | ;; otherwise the following heading will get joined to the body | |
342 | ;; text. | |
343 | (if end-marker | |
344 | (progn | |
345 | (goto-char end-marker) | |
346 | (forward-char -1) | |
347 | (or (memq (preceding-char) '(?\n ?\^M)) | |
348 | (insert ?\n)))) | |
349 | ||
350 | ;; If this is the last fold to exit, hide the text unless we've | |
351 | ;; been told not to. Note that at the moment point is at the | |
352 | ;; beginning of the following heading if there is one. | |
353 | ||
354 | ;; Also, make sure that the newline before the following heading | |
355 | ;; is \n otherwise it will be hidden. If there is a newline | |
356 | ;; before this one, make it visible too so we do the same as | |
357 | ;; outline.el and leave a blank line before the heading. | |
b0562527 CY |
358 | (when (zerop num-folds) |
359 | (if end-marker | |
360 | (setq beginning-of-heading (point) | |
361 | end-of-subtree (progn (forward-char -1) | |
362 | (if (memq (preceding-char) | |
363 | '(?\n ?\^M)) | |
364 | (forward-char -1)) | |
365 | (point)))) | |
366 | ;; hide the subtree | |
367 | (when hide-fold | |
368 | (goto-char start-marker) | |
369 | (hide-subtree)) | |
370 | ||
371 | ;; make sure the next heading is exposed | |
372 | (if end-marker | |
373 | (outline-flag-region end-of-subtree beginning-of-heading | |
374 | foldout-show-flag))) | |
a144b9e9 RS |
375 | |
376 | ;; zap the markers so they don't slow down editing | |
377 | (set-marker start-marker nil) | |
37269466 | 378 | (if end-marker (set-marker end-marker nil))) |
e745364e RS |
379 | |
380 | ;; narrow to the enclosing fold if there is one | |
381 | (if foldout-fold-list | |
382 | (progn | |
383 | (setq start-marker (car (car foldout-fold-list)) | |
384 | end-marker (cdr (car foldout-fold-list))) | |
385 | (narrow-to-region start-marker | |
386 | (if end-marker | |
387 | (1- (marker-position end-marker)) | |
37269466 | 388 | (point-max))))) |
e745364e RS |
389 | (recenter) |
390 | ||
37269466 CY |
391 | ;; update the mode line |
392 | (foldout-update-mode-line))) | |
e745364e RS |
393 | \f |
394 | ||
37269466 CY |
395 | (defun foldout-update-mode-line () |
396 | "Set the mode line to indicate our fold depth." | |
e745364e | 397 | (let ((depth (length foldout-fold-list))) |
37269466 | 398 | (setq foldout-mode-line-string |
e745364e RS |
399 | (cond |
400 | ;; if we're not in a fold, keep quiet | |
401 | ((zerop depth) | |
402 | nil) | |
37269466 | 403 | ;; in outline-minor-mode we're after "Outl:xx" in the mode line |
e745364e RS |
404 | (outline-minor-mode |
405 | (format ":%d" depth)) | |
406 | ;; otherwise just announce the depth (I guess we're in outline-mode) | |
407 | ((= depth 1) | |
408 | " Inside 1 fold") | |
409 | (t | |
37269466 | 410 | (format " Inside %d folds" depth)))))) |
e745364e RS |
411 | \f |
412 | ||
413 | (defun foldout-mouse-zoom (event) | |
414 | "Zoom in on the heading clicked on. | |
415 | ||
416 | How much is exposed by the zoom depends on the number of mouse clicks:- | |
417 | ||
418 | 1 expose body | |
419 | 2 expose subheadings | |
420 | 3 expose body and subheadings | |
421 | 4 expose entire subtree" | |
422 | (interactive "@e") | |
423 | ||
424 | ;; swallow intervening mouse events so we only get the final click-count. | |
425 | (setq event (foldout-mouse-swallow-events event)) | |
426 | ||
427 | ;; go to the heading clicked on | |
428 | (foldout-mouse-goto-heading event) | |
429 | ||
430 | ;; zoom away | |
431 | (foldout-zoom-subtree | |
432 | (let ((nclicks (event-click-count event))) | |
433 | (cond | |
434 | ((= nclicks 1) -1) ; body only | |
7dbba89a | 435 | ((= nclicks 2) '(1)) ; subheadings only |
e745364e RS |
436 | ((= nclicks 3) nil) ; body and subheadings |
437 | (t 0))))) ; entire subtree | |
438 | ||
439 | (defun foldout-mouse-show (event) | |
440 | "Show what is hidden under the heading clicked on. | |
441 | ||
442 | What gets exposed depends on the number of mouse clicks:- | |
443 | ||
444 | 1 expose body | |
445 | 2 expose subheadings | |
446 | 3 expose body and subheadings | |
447 | 4 expose entire subtree" | |
448 | (interactive "@e") | |
449 | ||
450 | ;; swallow intervening mouse events so we only get the final click-count. | |
451 | (setq event (foldout-mouse-swallow-events event)) | |
452 | ||
453 | ;; expose the text | |
454 | (foldout-mouse-goto-heading event) | |
455 | (let ((nclicks (event-click-count event))) | |
456 | (cond | |
457 | ((= nclicks 1) (show-entry)) | |
458 | ((= nclicks 2) (show-children)) | |
459 | ((= nclicks 3) (show-entry) (show-children)) | |
460 | (t (show-subtree))))) | |
461 | ||
462 | (defun foldout-mouse-hide-or-exit (event) | |
463 | "Hide the subtree under the heading clicked on, or exit a fold. | |
464 | ||
465 | What happens depends on the number of mouse clicks:- | |
466 | ||
467 | 1 hide subtree | |
468 | 2 exit fold and hide text | |
469 | 3 exit fold without hiding text | |
470 | 4 exit all folds and hide text" | |
471 | (interactive "@e") | |
472 | ||
473 | ;; swallow intervening mouse events so we only get the final click-count. | |
474 | (setq event (foldout-mouse-swallow-events event)) | |
475 | ||
476 | ;; hide or exit | |
477 | (let ((nclicks (event-click-count event))) | |
478 | (if (= nclicks 1) | |
479 | (progn | |
480 | (foldout-mouse-goto-heading event) | |
481 | (hide-subtree)) | |
482 | (foldout-exit-fold | |
483 | (cond | |
484 | ((= nclicks 2) 1) ; exit and hide | |
485 | ((= nclicks 3) -1) ; exit don't hide | |
486 | (t 0)))))) ; exit all | |
487 | \f | |
488 | ||
489 | (defun foldout-mouse-swallow-events (event) | |
490 | "Swallow intervening mouse events so we only get the final click-count. | |
491 | Signal an error if the final event isn't the same type as the first one." | |
492 | (let ((initial-event-type (event-basic-type event))) | |
3ee0b477 | 493 | (while (null (sit-for (/ double-click-time 1000.0) 'nodisplay)) |
e745364e RS |
494 | (setq event (read-event))) |
495 | (or (eq initial-event-type (event-basic-type event)) | |
496 | (error ""))) | |
497 | event) | |
498 | ||
499 | (defun foldout-mouse-goto-heading (event) | |
500 | "Go to the heading where the mouse event started. Signal an error | |
501 | if the event didn't occur on a heading." | |
502 | (goto-char (posn-point (event-start event))) | |
503 | (or (outline-on-heading-p) | |
504 | ;; outline.el sometimes treats beginning-of-buffer as a heading | |
505 | ;; even though outline-on-heading returns nil. | |
506 | (save-excursion (beginning-of-line) (bobp)) | |
507 | (error "Not a heading line"))) | |
508 | \f | |
509 | ||
510 | ;;; Keymaps: | |
511 | ||
512 | (defvar foldout-inhibit-key-bindings nil | |
0ff9b955 | 513 | "Set non-nil before loading foldout to inhibit key bindings.") |
e745364e RS |
514 | |
515 | (defvar foldout-mouse-modifiers '(meta control) | |
516 | "List of modifier keys to apply to foldout's mouse events. | |
517 | ||
518 | The default (meta control) makes foldout bind its functions to | |
519 | M-C-down-mouse-{1,2,3}. | |
520 | ||
521 | Valid modifiers are shift, control, meta, alt, hyper and super.") | |
522 | ||
523 | (if foldout-inhibit-key-bindings | |
524 | () | |
525 | (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree) | |
526 | (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold) | |
f9e07628 RS |
527 | (let ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix))) |
528 | (unless map | |
529 | (setq map (make-sparse-keymap)) | |
530 | (define-key outline-minor-mode-map outline-minor-mode-prefix map)) | |
531 | (define-key map "\C-z" 'foldout-zoom-subtree) | |
532 | (define-key map "\C-x" 'foldout-exit-fold)) | |
e745364e RS |
533 | (let* ((modifiers (apply 'concat |
534 | (mapcar (function | |
535 | (lambda (modifier) | |
536 | (vector | |
537 | (cond | |
538 | ((eq modifier 'shift) ?S) | |
539 | ((eq modifier 'control) ?C) | |
540 | ((eq modifier 'meta) ?M) | |
541 | ((eq modifier 'alt) ?A) | |
542 | ((eq modifier 'hyper) ?H) | |
543 | ((eq modifier 'super) ?s) | |
544 | (t (error "invalid mouse modifier %s" | |
545 | modifier))) | |
546 | ?-))) | |
547 | foldout-mouse-modifiers))) | |
548 | (mouse-1 (vector (intern (concat modifiers "down-mouse-1")))) | |
549 | (mouse-2 (vector (intern (concat modifiers "down-mouse-2")))) | |
550 | (mouse-3 (vector (intern (concat modifiers "down-mouse-3"))))) | |
551 | ||
552 | (define-key outline-mode-map mouse-1 'foldout-mouse-zoom) | |
553 | (define-key outline-mode-map mouse-2 'foldout-mouse-show) | |
554 | (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit) | |
555 | ||
556 | (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom) | |
557 | (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show) | |
558 | (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit) | |
559 | )) | |
560 | ||
561 | (provide 'foldout) | |
562 | ||
563 | ;;; foldout.el ends here |