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