1 | ;; @(#) folding.el -- A folding-editor-like minor mode 1.7 |
---|
2 | |
---|
3 | ;; Copyright (C) 1992, 1993, Jamie Lokier. All rights reserved. |
---|
4 | |
---|
5 | ;; This file is intended to be used with GNU Emacs. |
---|
6 | |
---|
7 | ;; This program is free software; you can redistribute it and/or modify |
---|
8 | ;; it under the terms of the GNU General Public License as published by |
---|
9 | ;; the Free Software Foundation; either version 2, or (at your option) |
---|
10 | ;; any later version. |
---|
11 | |
---|
12 | ;; This program is distributed in the hope that it will be useful, |
---|
13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
15 | ;; GNU General Public License for more details. |
---|
16 | |
---|
17 | ;; You should have received a copy of the GNU General Public License |
---|
18 | ;; along with GNU Emacs; see the file COPYING. If not, write to |
---|
19 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
---|
20 | |
---|
21 | ;; --------------------------------------------------------------------- |
---|
22 | |
---|
23 | ;; This is version 1.7 of Folding mode, under development. |
---|
24 | |
---|
25 | ;; This file has been edited with a folding editor (itself! :-). |
---|
26 | |
---|
27 | ;; Send suggestions and/or bug fixes to "u90jl@ecs.ox.ac.uk". |
---|
28 | |
---|
29 | ;; If you can, please check the most recent version of Folding mode |
---|
30 | ;; before reporting bugs. If you can't, don't be afraid of reporting |
---|
31 | ;; bugs anyway. |
---|
32 | |
---|
33 | ;;{{{ Information |
---|
34 | |
---|
35 | ;; ----------------------- Archive information -------------------------- |
---|
36 | |
---|
37 | ;; LCD Archive Entry: |
---|
38 | ;; folding|Jamie Lokier|u90jl@ecs.ox.ac.uk| |
---|
39 | ;; A folding-editor-like minor mode| |
---|
40 | ;; 06-Jul-1993|1.7|~/modes/folding.el.Z| |
---|
41 | |
---|
42 | ;; -------------------------- Installation ------------------------------ |
---|
43 | |
---|
44 | ;; To install Folding mode, put this file (folding.el) on you Emacs-Lisp |
---|
45 | ;; load path, and put the following in your .emacs: |
---|
46 | ;; |
---|
47 | ;; (autoload 'folding-mode "folding" |
---|
48 | ;; "Minor mode that simulates a folding editor" t) |
---|
49 | ;; |
---|
50 | ;; To have Folding mode start automatically when opening folded files, |
---|
51 | ;; add the following to your .emacs as well: |
---|
52 | ;; |
---|
53 | ;; (defun folding-mode-find-file-hook () |
---|
54 | ;; "One of the hooks called whenever a `find-file' is successful." |
---|
55 | ;; (and (assq 'folded-file (buffer-local-variables)) |
---|
56 | ;; folded-file |
---|
57 | ;; (folding-mode 1) |
---|
58 | ;; (kill-local-variable 'folded-file))) |
---|
59 | ;; |
---|
60 | ;; (or (memq 'folding-mode-find-file-hook find-file-hooks) |
---|
61 | ;; (setq find-file-hooks (append find-file-hooks |
---|
62 | ;; '(folding-mode-find-file-hook)))) |
---|
63 | ;; |
---|
64 | ;; If you load folding.el all the time during startup, none of the above |
---|
65 | ;; is necessary; it can be replaced with this after loading folding.el: |
---|
66 | ;; |
---|
67 | ;; (folding-mode-add-find-file-hook) |
---|
68 | ;; |
---|
69 | ;; Brief documentation for Folding mode (what it is, how you use it) is |
---|
70 | ;; provided with the definition of the function `folding-mode'. |
---|
71 | ;; |
---|
72 | ;; The best way to learn how to use Folding mode after installing it is |
---|
73 | ;; to find-file the source, M-x eval-current-buffer, M-x folding-mode, |
---|
74 | ;; and move in and out of the folds. Keys are documented under the |
---|
75 | ;; function `folding-mode', though you might want to customize them. |
---|
76 | ;; Keys in folding mode are bound in the keymap `folding-mode-map'. |
---|
77 | |
---|
78 | ;; --------------------------- And the rest ----------------------------- |
---|
79 | |
---|
80 | ;; There are is no real documentation yet; I haven't had time. I intend |
---|
81 | ;; to write some one day, but I will refrain from predicting when. Read |
---|
82 | ;; the documentation for the function `folding-mode' for the most useful |
---|
83 | ;; tips. |
---|
84 | |
---|
85 | ;; Emacs 18: |
---|
86 | ;; Folding mode has been tested with versions 18.55 and 18.58 of Emacs. |
---|
87 | |
---|
88 | ;; Epoch: |
---|
89 | ;; Folding mode has been tested on Epoch 4.0p2. |
---|
90 | |
---|
91 | ;; Lucid Emacs: |
---|
92 | ;; There is code in here to handle some aspects of Lucid Emacs. |
---|
93 | ;; However, up to version 19.6, there appears to be no way to display |
---|
94 | ;; folds. Selective-display does not work, and neither do invisible |
---|
95 | ;; extents, so Folding mode has no chance of working. This is likely to |
---|
96 | ;; change in future versions of Lucid Emacs. |
---|
97 | |
---|
98 | ;; Emacs 19: |
---|
99 | ;; Tested on version 19.8, appears to be fine. |
---|
100 | ;; Minor bug: display the buffer in several different frames, then move |
---|
101 | ;; in and out of folds in the buffer. The frames are automatically |
---|
102 | ;; moved to the top of the stacking order. |
---|
103 | |
---|
104 | ;; Some of the code is quite horrible, generally in order to avoid some |
---|
105 | ;; Emacs display "features". Some of it is specific to certain versions |
---|
106 | ;; of Emacs. By the time Emacs 19 is around and everyone is using it, |
---|
107 | ;; hopefully most of it won't be necessary. |
---|
108 | |
---|
109 | ;; ------------------------ More known bugs ----------------------------- |
---|
110 | |
---|
111 | ;; *** Needs fold-fold-region to be more intelligent about |
---|
112 | ;; finding a good region. Check folding a whole current fold. |
---|
113 | |
---|
114 | ;; *** Now works with 19! But check out what happens when you exit a |
---|
115 | ;; fold with the file displayed in two frames. Both windows get |
---|
116 | ;; fronted. Better fix that sometime. |
---|
117 | |
---|
118 | ;; ------------------------- Future features ---------------------------- |
---|
119 | |
---|
120 | ;; *** I will add a `fold-next-error' sometime. It will only work with |
---|
121 | ;; Emacs versions later than 18.58, because compile.el in earlier |
---|
122 | ;; versions does not count line-numbers in the right way, when selective |
---|
123 | ;; display is active. |
---|
124 | |
---|
125 | ;; *** Fold titles should be optionally allowed on the closing fold |
---|
126 | ;; marks, and `fold-tidy-inside' should check that the opening title |
---|
127 | ;; matches the closing title. |
---|
128 | |
---|
129 | ;; *** `folded-file' set in the local variables at the end of a file |
---|
130 | ;; could encode the type of fold marks used in that file, and other |
---|
131 | ;; things, like the margins inside folds. |
---|
132 | |
---|
133 | ;; *** I can see a lot of use for the newer features of Emacs 19: |
---|
134 | ;; |
---|
135 | ;; Using invisible text-properties (I hope they are intended to |
---|
136 | ;; make text invisible; it isn't implemented like that yet), it |
---|
137 | ;; will be possible to hide folded text without affecting the |
---|
138 | ;; text of the buffer. At the moment, Folding mode uses |
---|
139 | ;; selective display to hide text, which involves substituting |
---|
140 | ;; carriage-returns for line-feeds in the buffer. This isn't |
---|
141 | ;; such a good way. It may also be possible to display |
---|
142 | ;; different folds in different windows in Emacs 19. |
---|
143 | ;; |
---|
144 | ;; Using even more text-properties, it may be possible to track |
---|
145 | ;; pointer movements in and out of folds, and have Folding mode |
---|
146 | ;; automatically enter or exit folds as necessary to maintain a |
---|
147 | ;; sensible display. Because the text itself is not modified |
---|
148 | ;; (if overlays are used to hide text), this is quite safe. It |
---|
149 | ;; would make it unnecessary to provide functions like |
---|
150 | ;; `fold-forward-char', `fold-goto-line' or `fold-next-error', |
---|
151 | ;; and things like I-search would automatically move in and out |
---|
152 | ;; of folds as necessary. |
---|
153 | ;; |
---|
154 | ;; Yet more text-properties/overlays might make it possible to |
---|
155 | ;; avoid using narrowing. This might allow some major modes to |
---|
156 | ;; indent text properly, e.g., C++ mode. |
---|
157 | |
---|
158 | |
---|
159 | ;; ------------------------- History ------------------------------------ |
---|
160 | ;; Dec 1 1994 Jari Aalto , <jaalto@tre.tele.nokia.fi> |
---|
161 | ;; - Only minor change. Made the folding mode string user configurable. |
---|
162 | ;; Added these variables: |
---|
163 | ;; o folding-mode-v-str , fold-v-inside-in-str,fold-v-inside-in-fold-str |
---|
164 | ;; - Changed revision number from 1.6.2 to 1.7 , so that people know |
---|
165 | ;; this el has changed. |
---|
166 | ;; - Advertise: I made couple of extra functions for this module, please |
---|
167 | ;; look at the goodies in tinyfold.el. |
---|
168 | |
---|
169 | ;;}}} |
---|
170 | ;;{{{ Declare `folding' as a feature |
---|
171 | |
---|
172 | (provide 'folding) |
---|
173 | |
---|
174 | ;;}}} |
---|
175 | ;;{{{ Check Emacs version and set some constants. |
---|
176 | |
---|
177 | ;; Sets `fold-emacs-version' to `epoch, `lucid, or the numbers 18 or 19, |
---|
178 | ;; as appropriate, and sets a few related variables. |
---|
179 | |
---|
180 | (setq fold-epoch-screens-p nil |
---|
181 | fold-lucid-screens-p nil |
---|
182 | fold-lucid-keymaps-p nil |
---|
183 | fold-emacs-frames-p nil) |
---|
184 | |
---|
185 | (let ((case-fold-search t)) |
---|
186 | (cond ((boundp 'epoch::version) ;; Epoch |
---|
187 | (setq fold-epoch-screens-p t)) |
---|
188 | ((string-match "lucid" emacs-version) ;; Lucid Emacs |
---|
189 | (setq fold-lucid-screens-p t |
---|
190 | fold-lucid-keymaps-p t)) |
---|
191 | ((string< emacs-version "19")) ;; Emacs 18.x (or less) |
---|
192 | (t ;; Emacs 19+ |
---|
193 | (setq fold-emacs-frames-p t)))) |
---|
194 | |
---|
195 | ;;}}} |
---|
196 | |
---|
197 | ;;{{{ Start Folding mode, and related items. Documentation is here |
---|
198 | |
---|
199 | ;;{{{ folding-mode the variable |
---|
200 | |
---|
201 | (defvar folding-mode nil |
---|
202 | "Non-nil means Folding mode is active in the current buffer.") |
---|
203 | |
---|
204 | (make-variable-buffer-local 'folding-mode) |
---|
205 | (set-default 'folding-mode nil) |
---|
206 | |
---|
207 | (defvar folding-mode-v-str "Fld" |
---|
208 | "*The minor mode string displayed when it's on.") |
---|
209 | |
---|
210 | ;;}}} |
---|
211 | ;;{{{ folding-mode the function |
---|
212 | |
---|
213 | (defun folding-mode (&optional arg inter) |
---|
214 | "Turns Folding mode (a minor mode) on and off. |
---|
215 | |
---|
216 | These are the basic commands that Folding mode provides: |
---|
217 | \\<folding-mode-map> |
---|
218 | fold-enter: `\\[fold-enter]' |
---|
219 | Enters the fold that the point is on. |
---|
220 | |
---|
221 | fold-exit: `\\[fold-exit]' |
---|
222 | Exits the current fold. |
---|
223 | |
---|
224 | fold-fold-region: `\\[fold-fold-region]' |
---|
225 | Surrounds the region with a new fold. |
---|
226 | |
---|
227 | fold-top-level: `\\[fold-top-level]' |
---|
228 | Exits all folds. |
---|
229 | |
---|
230 | fold-show: `\\[fold-show]' |
---|
231 | Opens the fold that the point is on, but does not enter it. |
---|
232 | |
---|
233 | fold-hide: `\\[fold-hide]' |
---|
234 | Closes the fold that the point is in, exiting it if necessary. |
---|
235 | |
---|
236 | fold-whole-buffer: `\\[fold-whole-buffer]' |
---|
237 | Folds the whole buffer. |
---|
238 | |
---|
239 | fold-open-buffer: `\\[fold-open-buffer]' |
---|
240 | Unfolds the whole buffer; good to do just before a search. |
---|
241 | |
---|
242 | fold-remove-folds: `\\[fold-remove-folds]' |
---|
243 | Makes a ready-to-print, formatted, unfolded copy in another buffer. |
---|
244 | |
---|
245 | Read the documentation for the above functions for more information. |
---|
246 | |
---|
247 | Folds are a way of hierarchically organising the text in a file, so that |
---|
248 | the text can be viewed and edited at different levels. It is similar to |
---|
249 | Outline mode in that parts of the text can be hidden from view. A fold |
---|
250 | is a region of text, surrounded by special \"fold marks\", which act |
---|
251 | like brackets, grouping the text. Fold mark pairs can be nested, and |
---|
252 | they can have titles. When a fold is folded, the text is hidden from |
---|
253 | view, except for the first line, which acts like a title for the fold. |
---|
254 | |
---|
255 | Folding mode is a minor mode, designed to cooperate with many other |
---|
256 | major modes, so that many types of text can be folded while they are |
---|
257 | being edited (eg., plain text, program source code, Texinfo, etc.). |
---|
258 | |
---|
259 | For most types of folded file, lines representing folds have \"{{{\" |
---|
260 | near the beginning. To enter a fold, move the point to the folded line |
---|
261 | and type `\\[fold-enter]'. You should no longer be able to see the rest |
---|
262 | of the file, just the contents of the fold, which you couldn't see |
---|
263 | before. You can use `\\[fold-exit]' to leave a fold, and you can enter |
---|
264 | and exit folds to move around the structure of the file. |
---|
265 | |
---|
266 | All of the text is present in a folded file all of the time. It is just |
---|
267 | hidden. Folded text shows up as a line (the top fold mark) with \"...\" |
---|
268 | at the end. If you are in a fold, the mode line displays \"inside n |
---|
269 | folds Narrow\", and because the buffer is narrowed you can't see outside |
---|
270 | of the current fold's text. |
---|
271 | |
---|
272 | By arranging sections of a large file in folds, and maybe subsections in |
---|
273 | sub-folds, you can move around a file quickly and easily, and only have |
---|
274 | to scroll through a couple of pages at a time. If you pick the titles |
---|
275 | for the folds carefully, they can be a useful form of documentation, and |
---|
276 | make moving though the file a lot easier. In general, searching through |
---|
277 | a folded file for a particular item is much easier than without folds. |
---|
278 | |
---|
279 | To make a new fold, set the mark at one end of the text you want in the |
---|
280 | new fold, and move the point to the other end. Then type |
---|
281 | `\\[fold-fold-region]'. The text you selected will be made into a fold, |
---|
282 | and the fold will be entered. If you just want a new, empty fold, set |
---|
283 | the mark where you want the fold, and then create a new fold there |
---|
284 | without moving the point. Don't worry if the point is in the middle of |
---|
285 | a line of text, `fold-fold-region' will not break text in the middle of |
---|
286 | a line. After making a fold, the fold is entered and the point is |
---|
287 | positioned ready to enter a title for the fold. Do not delete the fold |
---|
288 | marks, which are usually something like \"{{{\" and \"}}}\". There may |
---|
289 | also be a bit of fold mark which goes after the fold title. |
---|
290 | |
---|
291 | If the fold markers get messed up, or you just want to see the whole |
---|
292 | unfolded file, use `\\[fold-open-buffer]' to unfolded the whole file, so |
---|
293 | you can see all the text and all the marks. This is useful for |
---|
294 | checking/correcting unbalanced fold markers, and for searching for |
---|
295 | things. Use `\\[fold-whole-file]' to fold the buffer again. |
---|
296 | |
---|
297 | `fold-exit' will attempt to tidy the current fold just before exiting |
---|
298 | it. It will remove any extra blank lines at the top and bottom, |
---|
299 | \(outside the fold marks). It will then ensure that fold marks exists, |
---|
300 | and if they are not, will add them (after asking). Finally, the number |
---|
301 | of blank lines between the fold marks and the contents of the fold is |
---|
302 | set to 1 (by default). |
---|
303 | |
---|
304 | You can make folded files start Folding mode automatically when they are |
---|
305 | visited by setting `folded-file' to t in the file's local variables. |
---|
306 | For example, having the following at the end of an Emacs-Lisp file |
---|
307 | causes it to be folded when visited: |
---|
308 | |
---|
309 | ;; Local variables: |
---|
310 | ;; folded-file: t |
---|
311 | ;; end: |
---|
312 | |
---|
313 | This only works if you have the appropriate hook set up. Look up the |
---|
314 | function `folding-mode-add-find-file-hook' for details. |
---|
315 | |
---|
316 | If the fold marks are not set on entry to Folding mode, they are set to |
---|
317 | a default for current major mode, as defined by `fold-mode-marks-alist' |
---|
318 | or to \"{{{ \" and \"}}}\" if none are specified. |
---|
319 | |
---|
320 | To bind different commands to keys in Folding mode, set the bindings in |
---|
321 | the keymap `folding-mode-map'. |
---|
322 | |
---|
323 | The hooks `folding-mode-hook' and `<major-mode-name>-folding-hook' are |
---|
324 | called before folding the buffer and applying the key bindings in |
---|
325 | `folding-mode-map'. This is a good hook to set extra or different key |
---|
326 | bindings in `folding-mode-map'. Note that key bindings in |
---|
327 | `folding-mode-map' are only examined just after calling these hooks; new |
---|
328 | bindings in those maps only take effect when Folding mode is being |
---|
329 | started. |
---|
330 | |
---|
331 | If Folding mode is not called interactively (`(interactive-p)' is nil), |
---|
332 | and it is called with two or less arguments, all of which are nil, then |
---|
333 | the point will not be altered if `fold-fold-on-startup' is set and |
---|
334 | `fold-whole-buffer' is called. This is generally not a good thing, as |
---|
335 | it can leave the point inside a hidden region of a fold, but it is |
---|
336 | required if the local variables set \"mode: folding\" when the file is |
---|
337 | first read (see `hack-local-variables'). |
---|
338 | |
---|
339 | Not that you should ever want to, but to call Folding mode from a |
---|
340 | program with the default behaviour (toggling the mode), call it with |
---|
341 | something like `(folding-mode nil t)'. |
---|
342 | |
---|
343 | Here is the full list of keys bound in Folding mode: |
---|
344 | \\{folding-mode-map}" |
---|
345 | (interactive) |
---|
346 | (let ((new-folding-mode |
---|
347 | (if (not arg) (not folding-mode) |
---|
348 | (> (prefix-numeric-value arg) 0)))) |
---|
349 | (or (eq new-folding-mode |
---|
350 | folding-mode) |
---|
351 | (if folding-mode |
---|
352 | (progn |
---|
353 | (setq selective-display nil) |
---|
354 | (fold-clear-stack) |
---|
355 | (widen) |
---|
356 | (fold-subst-regions (list 1 (point-max)) ?\r ?\n) |
---|
357 | (and (boundp 'fold-saved-local-keymap) |
---|
358 | (progn |
---|
359 | (use-local-map fold-saved-local-keymap) |
---|
360 | (kill-local-variable 'fold-saved-local-keymap) |
---|
361 | (makunbound 'fold-saved-local-keymap)))) |
---|
362 | (make-local-variable 'fold-saved-local-keymap) |
---|
363 | (setq fold-saved-local-keymap (current-local-map)) |
---|
364 | (setq selective-display t) |
---|
365 | (setq selective-display-ellipses t) |
---|
366 | (widen) |
---|
367 | (set (make-local-variable 'fold-stack) nil) |
---|
368 | (make-local-variable 'fold-top-mark) |
---|
369 | (make-local-variable 'fold-secondary-top-mark) |
---|
370 | (make-local-variable 'fold-top-regexp) |
---|
371 | (make-local-variable 'fold-bottom-mark) |
---|
372 | (make-local-variable 'fold-bottom-regexp) |
---|
373 | (make-local-variable 'fold-regexp) |
---|
374 | (or (and (boundp 'fold-top-regexp) |
---|
375 | fold-top-regexp |
---|
376 | (boundp 'fold-bottom-regexp) |
---|
377 | fold-bottom-regexp) |
---|
378 | (let ((fold-marks (assq major-mode |
---|
379 | fold-mode-marks-alist))) |
---|
380 | (if fold-marks |
---|
381 | (setq fold-marks (cdr fold-marks)) |
---|
382 | (setq fold-marks '("{{{ " "}}}"))) |
---|
383 | (apply 'fold-set-marks fold-marks))) |
---|
384 | (unwind-protect |
---|
385 | (let ((hook-symbol (intern-soft |
---|
386 | (concat |
---|
387 | (symbol-name major-mode) |
---|
388 | "-folding-hook")))) |
---|
389 | (run-hooks 'folding-mode-hook) |
---|
390 | (and hook-symbol |
---|
391 | (run-hooks hook-symbol))) |
---|
392 | (fold-set-mode-line) |
---|
393 | (use-local-map |
---|
394 | (fold-merge-keymaps (current-local-map) folding-mode-map))) |
---|
395 | (and fold-fold-on-startup |
---|
396 | (if (or (interactive-p) |
---|
397 | arg |
---|
398 | inter) |
---|
399 | (fold-whole-buffer) |
---|
400 | (save-excursion |
---|
401 | (fold-whole-buffer)))) |
---|
402 | (fold-narrow-to-region nil nil t))) |
---|
403 | (setq folding-mode new-folding-mode))) |
---|
404 | |
---|
405 | ;;}}} |
---|
406 | ;;{{{ keys: folding-mode-map |
---|
407 | |
---|
408 | (defvar folding-mode-map nil |
---|
409 | "Keymap used in Folding mode (a minor mode).") |
---|
410 | |
---|
411 | (and fold-lucid-keymaps-p |
---|
412 | (set-keymap-name folding-mode-map 'folding-mode-map)) |
---|
413 | |
---|
414 | (if folding-mode-map |
---|
415 | nil |
---|
416 | (setq folding-mode-map (make-sparse-keymap)) |
---|
417 | (define-key folding-mode-map "\M-g" 'fold-goto-line) |
---|
418 | (define-key folding-mode-map "\C-c>" 'fold-enter) |
---|
419 | (define-key folding-mode-map "\C-c<" 'fold-exit) |
---|
420 | (define-key folding-mode-map "\C-c\C-t" 'fold-top-level) |
---|
421 | (define-key folding-mode-map "\C-c\C-f" 'fold-fold-region) |
---|
422 | (define-key folding-mode-map "\C-c\C-s" 'fold-show) |
---|
423 | (define-key folding-mode-map "\C-c\C-x" 'fold-hide) |
---|
424 | (define-key folding-mode-map "\C-c\C-o" 'fold-open-buffer) |
---|
425 | (define-key folding-mode-map "\C-c\C-w" 'fold-whole-buffer) |
---|
426 | (define-key folding-mode-map "\C-c\C-r" 'fold-remove-folds) |
---|
427 | (define-key folding-mode-map "\C-f" 'fold-forward-char) |
---|
428 | (define-key folding-mode-map "\C-b" 'fold-backward-char) |
---|
429 | (define-key folding-mode-map "\C-e" 'fold-end-of-line)) |
---|
430 | |
---|
431 | ;;}}} |
---|
432 | ;;{{{ fold-stack |
---|
433 | |
---|
434 | ;; This is a list of structures which keep track of folds being entered |
---|
435 | ;; and exited. It is a list of (MARKER . MARKER) pairs, followed by the |
---|
436 | ;; symbol `folded'. The first of these represents the fold containing |
---|
437 | ;; the current one. If the view is currently outside all folds, this |
---|
438 | ;; variable has value nil. |
---|
439 | |
---|
440 | (defvar fold-stack nil |
---|
441 | "A list of marker pairs representing folds entered so far.") |
---|
442 | |
---|
443 | ;;}}} |
---|
444 | ;;{{{ fold-clear-stack |
---|
445 | |
---|
446 | ;; Clear the fold stack, and release all the markers it refers to. |
---|
447 | |
---|
448 | (defun fold-clear-stack () |
---|
449 | (let ((stack fold-stack)) |
---|
450 | (setq fold-stack nil) |
---|
451 | (while (and stack (not (eq 'folded (car stack)))) |
---|
452 | (set-marker (car (car stack)) nil) |
---|
453 | (set-marker (cdr (car stack)) nil) |
---|
454 | (setq stack (cdr stack))))) |
---|
455 | |
---|
456 | ;;}}} |
---|
457 | ;;{{{ fold-mode-string |
---|
458 | |
---|
459 | (defvar fold-mode-string nil |
---|
460 | "Buffer-local variable that holds the fold depth description.") |
---|
461 | |
---|
462 | (set-default 'fold-mode-string " Fld") ; to save space... |
---|
463 | |
---|
464 | ;;}}} |
---|
465 | ;;{{{ fold-set-mode-line |
---|
466 | |
---|
467 | ;; Sets `fold-mode-string' appropriately. This allows the Folding mode |
---|
468 | ;; description in the mode line to reflect the current fold depth." |
---|
469 | |
---|
470 | (defconst fold-v-inside-in-str " " ; normally ' inside ', but save space.. |
---|
471 | "*Mode line addition to show 'inside' levels of fold.") |
---|
472 | |
---|
473 | (defconst fold-v-inside-in-fold-str "Fld" ; normally 'fold', but save space.. |
---|
474 | "*Mode line addition to show inside levels of 'fold' .") |
---|
475 | |
---|
476 | (defun fold-set-mode-line () |
---|
477 | (if (null fold-stack) |
---|
478 | (kill-local-variable 'fold-mode-string) |
---|
479 | (make-local-variable 'fold-mode-string) |
---|
480 | (setq fold-mode-string |
---|
481 | (if (eq 'folded (car fold-stack)) |
---|
482 | (concat |
---|
483 | fold-v-inside-in-str "1" fold-v-inside-in-fold-str) |
---|
484 | (concat |
---|
485 | fold-v-inside-in-str |
---|
486 | (length fold-stack) |
---|
487 | fold-v-inside-in-fold-str) |
---|
488 | )))) |
---|
489 | |
---|
490 | ;;}}} |
---|
491 | ;;{{{ Update minor-mode-alist |
---|
492 | |
---|
493 | (or (assq 'folding-mode minor-mode-alist) |
---|
494 | (setq minor-mode-alist |
---|
495 | (cons '(folding-mode fold-mode-string) |
---|
496 | minor-mode-alist))) |
---|
497 | |
---|
498 | ;;}}} |
---|
499 | |
---|
500 | ;;}}} |
---|
501 | ;;{{{ Hooks and variables |
---|
502 | |
---|
503 | ;;{{{ folding-mode-hook |
---|
504 | |
---|
505 | (defvar folding-mode-hook nil |
---|
506 | "Hook called when Folding mode is entered. |
---|
507 | |
---|
508 | A hook named `<major-mode>-folding-hook' is also called, if it |
---|
509 | exists. Eg., `c-mode-folding-hook' is called whenever Folding mode is |
---|
510 | started in C mode.") |
---|
511 | |
---|
512 | ;;}}} |
---|
513 | ;;{{{ fold-fold-on-startup |
---|
514 | |
---|
515 | (defvar fold-fold-on-startup t |
---|
516 | "*If non-nil, buffers are folded when starting Folding mode.") |
---|
517 | |
---|
518 | ;;}}} |
---|
519 | ;;{{{ fold-internal-margins |
---|
520 | |
---|
521 | (defvar fold-internal-margins 1 |
---|
522 | "*Number of blank lines left next to fold marks when tidying folds. |
---|
523 | |
---|
524 | This variable is local to each buffer. To set the default value for all |
---|
525 | buffers, use `set-default'. |
---|
526 | |
---|
527 | When exiting a fold, and at other times, `fold-tidy-inside' is invoked |
---|
528 | to ensure that the fold is in the correct form before leaving it. This |
---|
529 | variable specifies the number of blank lines to leave between the |
---|
530 | enclosing fold marks and the enclosed text. |
---|
531 | |
---|
532 | If this value is nil or negative, no blank lines are added or removed |
---|
533 | inside the fold marks. A value of 0 (zero) is valid, meaning leave no |
---|
534 | blank lines. |
---|
535 | |
---|
536 | See also `fold-tidy-inside'.") |
---|
537 | |
---|
538 | (make-variable-buffer-local 'fold-internal-margins) |
---|
539 | |
---|
540 | ;;}}} |
---|
541 | ;;{{{ fold-mode-marks-alist |
---|
542 | |
---|
543 | (defvar fold-mode-marks-alist nil |
---|
544 | "List of (major-mode . fold marks) default combinations to use. |
---|
545 | When Folding mode is started, the major mode is checked, and if there |
---|
546 | are fold marks for that major mode stored in `fold-mode-marks-alist', |
---|
547 | those marks are used by default. If none are found, the default values |
---|
548 | of \"{{{ \" and \"}}}\" are used.") |
---|
549 | |
---|
550 | ;;}}} |
---|
551 | |
---|
552 | ;;}}} |
---|
553 | ;;{{{ Regular expressions for matching fold marks |
---|
554 | |
---|
555 | ;;{{{ fold-set-marks |
---|
556 | |
---|
557 | ;; You think those "\\(\\)" pairs are peculiar? Me too. Emacs regexp |
---|
558 | ;; stuff has a bug; sometimes "\\(.*\\)" fails when ".*" succeeds, but |
---|
559 | ;; only in a folded file! Strange bug! Must check it out sometime. |
---|
560 | |
---|
561 | (defun fold-set-marks (top bottom &optional secondary) |
---|
562 | "Sets the folding top and bottom marks for the current buffer. |
---|
563 | |
---|
564 | The fold top mark is set to TOP, and the fold bottom mark is set to |
---|
565 | BOTTOM. And optional SECONDARY top mark can also be specified -- this |
---|
566 | is inserted by `fold-fold-region' after the fold top mark, and is |
---|
567 | presumed to be put after the title of the fold. This is not necessary |
---|
568 | with the bottom mark because it has no title. |
---|
569 | |
---|
570 | Various regular expressions are set with this function, so don't set the |
---|
571 | mark variables directly." |
---|
572 | (set (make-local-variable 'fold-top-mark) |
---|
573 | top) |
---|
574 | (set (make-local-variable 'fold-bottom-mark) |
---|
575 | bottom) |
---|
576 | (set (make-local-variable 'fold-secondary-top-mark) |
---|
577 | secondary) |
---|
578 | (set (make-local-variable 'fold-top-regexp) |
---|
579 | (concat "\\(^\\|\r+\\)[ \t]*" |
---|
580 | (regexp-quote fold-top-mark))) |
---|
581 | (set (make-local-variable 'fold-bottom-regexp) |
---|
582 | (concat "\\(^\\|\r+\\)[ \t]*" |
---|
583 | (regexp-quote fold-bottom-mark))) |
---|
584 | (set (make-local-variable 'fold-regexp) |
---|
585 | (concat "\\(^\\|\r\\)\\([ \t]*\\)\\(\\(" |
---|
586 | (regexp-quote fold-top-mark) |
---|
587 | "\\)\\|\\(" |
---|
588 | (regexp-quote fold-bottom-mark) |
---|
589 | "[ \t]*\\(\\)\\($\\|\r\\)\\)\\)"))) |
---|
590 | |
---|
591 | ;;}}} |
---|
592 | |
---|
593 | ;;}}} |
---|
594 | ;;{{{ Cursor movement that skips folded regions |
---|
595 | |
---|
596 | ;;{{{ fold-forward-char |
---|
597 | |
---|
598 | (defun fold-forward-char (&optional arg) |
---|
599 | "Move point right ARG characters, skipping hidden folded regions. |
---|
600 | Moves left if ARG is negative. On reaching end of buffer, stop and |
---|
601 | signal error." |
---|
602 | (interactive "p") |
---|
603 | (if (eq arg 1) |
---|
604 | ;; Do it a faster way for arg = 1. |
---|
605 | (if (eq (following-char) ?\r) |
---|
606 | (let ((saved (point)) |
---|
607 | (inhibit-quit t)) |
---|
608 | (end-of-line) |
---|
609 | (if (not (eobp)) |
---|
610 | (forward-char) |
---|
611 | (goto-char saved) |
---|
612 | (error "End of buffer"))) |
---|
613 | ;; `forward-char' here will do its own error if (eobp). |
---|
614 | (forward-char)) |
---|
615 | (if (> 0 (or arg (setq arg 1))) |
---|
616 | (fold-backward-char (- arg)) |
---|
617 | (let (goal saved) |
---|
618 | (while (< 0 arg) |
---|
619 | (skip-chars-forward "^\r" (setq goal (+ (point) arg))) |
---|
620 | (if (eq goal (point)) |
---|
621 | (setq arg 0) |
---|
622 | (if (eobp) |
---|
623 | (error "End of buffer") |
---|
624 | (setq arg (- goal 1 (point)) |
---|
625 | saved (point)) |
---|
626 | (let ((inhibit-quit t)) |
---|
627 | (end-of-line) |
---|
628 | (if (not (eobp)) |
---|
629 | (forward-char) |
---|
630 | (goto-char saved) |
---|
631 | (error "End of buffer")))))))))) |
---|
632 | |
---|
633 | ;;}}} |
---|
634 | ;;{{{ fold-backward-char |
---|
635 | |
---|
636 | (defun fold-backward-char (&optional arg) |
---|
637 | "Move point left ARG characters, skipping hidden folded regions. |
---|
638 | Moves right if ARG is negative. On reaching beginning of buffer, stop |
---|
639 | and signal error." |
---|
640 | (interactive "p") |
---|
641 | (if (eq arg 1) |
---|
642 | ;; Do it a faster way for arg = 1. |
---|
643 | ;; Catch the case where we are in a hidden region, and bump into a \r. |
---|
644 | (if (or (eq (preceding-char) ?\n) |
---|
645 | (eq (preceding-char) ?\r)) |
---|
646 | (let ((pos (1- (point))) |
---|
647 | (inhibit-quit t)) |
---|
648 | (forward-char -1) |
---|
649 | (beginning-of-line) |
---|
650 | (skip-chars-forward "^\r" pos)) |
---|
651 | (forward-char -1)) |
---|
652 | (if (> 0 (or arg (setq arg 1))) |
---|
653 | (fold-forward-char (- arg)) |
---|
654 | (let (goal) |
---|
655 | (while (< 0 arg) |
---|
656 | (skip-chars-backward "^\r\n" (max (point-min) |
---|
657 | (setq goal (- (point) arg)))) |
---|
658 | (if (eq goal (point)) |
---|
659 | (setq arg 0) |
---|
660 | (if (bobp) |
---|
661 | (error "Beginning of buffer") |
---|
662 | (setq arg (- (point) 1 goal) |
---|
663 | goal (point)) |
---|
664 | (let ((inhibit-quit t)) |
---|
665 | (forward-char -1) |
---|
666 | (beginning-of-line) |
---|
667 | (skip-chars-forward "^\r" goal))))))))) |
---|
668 | |
---|
669 | ;;}}} |
---|
670 | ;;{{{ fold-end-of-line |
---|
671 | |
---|
672 | (defun fold-end-of-line (&optional arg) |
---|
673 | "Move point to end of current line, but before hidden folded region. |
---|
674 | |
---|
675 | Has the same behavior as `end-of-line', except that if the current line |
---|
676 | ends with some hidden folded text (represented by an ellipsis), the |
---|
677 | point is positioned just before it. This prevents the point from being |
---|
678 | placed inside the folded text, which is not normally useful." |
---|
679 | (interactive "p") |
---|
680 | (if (or (eq arg 1) |
---|
681 | (not arg)) |
---|
682 | (beginning-of-line) |
---|
683 | ;; `forward-line' also moves point to beginning of line. |
---|
684 | (forward-line (1- arg))) |
---|
685 | (skip-chars-forward "^\r\n")) |
---|
686 | |
---|
687 | ;;}}} |
---|
688 | ;;{{{ fold-skip-ellipsis-backward |
---|
689 | |
---|
690 | (defun fold-skip-ellipsis-backward () |
---|
691 | "Moves the point backwards out of folded text. |
---|
692 | |
---|
693 | If the point is inside a folded region, the cursor is displayed at the |
---|
694 | end of the ellipsis representing the folded part. This function checks |
---|
695 | to see if this is the case, and if so, moves the point backwards until |
---|
696 | it is just outside the hidden region, and just before the ellipsis. |
---|
697 | |
---|
698 | Returns t if the point was moved, nil otherwise." |
---|
699 | (interactive) |
---|
700 | (let ((pos (point)) |
---|
701 | result) |
---|
702 | (save-excursion |
---|
703 | (beginning-of-line) |
---|
704 | (skip-chars-forward "^\r" pos) |
---|
705 | (or (eq pos (point)) |
---|
706 | (setq pos (point) |
---|
707 | result t))) |
---|
708 | (goto-char pos) |
---|
709 | result)) |
---|
710 | |
---|
711 | ;;}}} |
---|
712 | |
---|
713 | ;;}}} |
---|
714 | |
---|
715 | ;;{{{ Moving in and out of folds |
---|
716 | |
---|
717 | ;;{{{ fold-enter |
---|
718 | |
---|
719 | (defun fold-enter (&optional noerror) |
---|
720 | "Open and enter the fold at or around the point. |
---|
721 | |
---|
722 | Enters the fold that the point is inside, wherever the point is inside |
---|
723 | the fold, provided it is a valid fold with balanced top and bottom |
---|
724 | marks. Returns nil if the fold entered contains no sub-folds, t |
---|
725 | otherwise. If an optional argument NOERROR is non-nil, returns nil if |
---|
726 | there are no folds to enter, instead of causing an error. |
---|
727 | |
---|
728 | If the point is inside a folded, hidden region (as represented by an |
---|
729 | ellipsis), the position of the point in the buffer is preserved, and as |
---|
730 | many folds as necessary are entered to make the surrounding text |
---|
731 | visible. This is useful after some commands eg., search commands." |
---|
732 | (interactive) |
---|
733 | (let ((goal (point))) |
---|
734 | (if (fold-skip-ellipsis-backward) |
---|
735 | (while (prog2 (beginning-of-line) |
---|
736 | (fold-enter t) |
---|
737 | (goto-char goal))) |
---|
738 | (let ((data (fold-show noerror t))) |
---|
739 | (and data |
---|
740 | (progn |
---|
741 | (setq fold-stack |
---|
742 | (if fold-stack |
---|
743 | (cons (cons (point-min-marker) (point-max-marker)) |
---|
744 | fold-stack) |
---|
745 | '(folded))) |
---|
746 | (fold-set-mode-line) |
---|
747 | (fold-narrow-to-region (car data) (nth 1 data)) |
---|
748 | (nth 2 data))))))) |
---|
749 | |
---|
750 | ;;}}} |
---|
751 | ;;{{{ fold-exit |
---|
752 | |
---|
753 | (defun fold-exit () |
---|
754 | "Exits the current fold." |
---|
755 | (interactive) |
---|
756 | (if fold-stack |
---|
757 | (progn |
---|
758 | (fold-tidy-inside) |
---|
759 | (fold-subst-regions (list (point-min) (point-max)) ?\n ?\r) |
---|
760 | (goto-char (point-min)) ;; So point is correct in other windows. |
---|
761 | (if (eq (car fold-stack) 'folded) |
---|
762 | (fold-narrow-to-region nil nil t) |
---|
763 | (fold-narrow-to-region (marker-position (car (car fold-stack))) |
---|
764 | (marker-position (cdr (car fold-stack))) t)) |
---|
765 | (and (consp (car fold-stack)) |
---|
766 | (set-marker (car (car fold-stack)) nil) |
---|
767 | (set-marker (cdr (car fold-stack)) nil)) |
---|
768 | (setq fold-stack (cdr fold-stack))) |
---|
769 | (error "Outside all folds")) |
---|
770 | (fold-set-mode-line)) |
---|
771 | |
---|
772 | ;;}}} |
---|
773 | ;;{{{ fold-show |
---|
774 | |
---|
775 | (defun fold-show (&optional noerror noskip) |
---|
776 | "Opens the fold that the point is on, but does not enter it. |
---|
777 | Optional arg NOERROR means don't signal an error if there is no fold, |
---|
778 | just return nil. NOSKIP means don't jump out of a hidden region first. |
---|
779 | |
---|
780 | Returns ((START END SUBFOLDS-P). START and END indicate the extents of |
---|
781 | the fold that was shown. If SUBFOLDS-P is non-nil, the fold contains |
---|
782 | subfolds." |
---|
783 | (interactive "p") |
---|
784 | (or noskip |
---|
785 | (fold-skip-ellipsis-backward)) |
---|
786 | (let ((point (point)) |
---|
787 | backward forward start end subfolds-not-p) |
---|
788 | (unwind-protect |
---|
789 | (or (and (integerp (car-safe (setq backward (fold-skip-folds t)))) |
---|
790 | (integerp (car-safe (setq forward (fold-skip-folds nil)))) |
---|
791 | (progn |
---|
792 | (goto-char (car forward)) |
---|
793 | (skip-chars-forward "^\r\n") |
---|
794 | (setq end (point)) |
---|
795 | (skip-chars-forward "\r\n") |
---|
796 | (not (and fold-stack (eobp)))) |
---|
797 | (progn |
---|
798 | (goto-char (car backward)) |
---|
799 | (skip-chars-backward "^\r\n") |
---|
800 | (setq start (point)) |
---|
801 | (skip-chars-backward "\r\n") |
---|
802 | (not (and fold-stack (bobp)))) |
---|
803 | (progn |
---|
804 | (setq point start) |
---|
805 | (setq subfolds-not-p ; Avoid holding the list through a GC. |
---|
806 | (not (or (cdr backward) (cdr forward)))) |
---|
807 | (fold-subst-regions (append backward (nreverse forward)) |
---|
808 | ?\r ?\n) |
---|
809 | (list start end (not subfolds-not-p)))) |
---|
810 | (if noerror |
---|
811 | nil |
---|
812 | (error "Not on a fold"))) |
---|
813 | (goto-char point)))) |
---|
814 | |
---|
815 | ;;}}} |
---|
816 | ;;{{{ fold-hide |
---|
817 | |
---|
818 | (defun fold-hide () |
---|
819 | "Close the fold around the point, undoes effect of `fold-show'." |
---|
820 | (interactive) |
---|
821 | (fold-skip-ellipsis-backward) |
---|
822 | (if (and (integerp (setq start (car-safe (fold-skip-folds t)))) |
---|
823 | (integerp (setq end (car-safe (fold-skip-folds nil))))) |
---|
824 | (if (and fold-stack |
---|
825 | (or (eq start (point-min)) |
---|
826 | (eq end (point-max)))) |
---|
827 | (error "Cannot hide current fold") |
---|
828 | (goto-char start) |
---|
829 | (skip-chars-backward "^\r\n") |
---|
830 | (fold-subst-regions (list start end) ?\n ?\r)) |
---|
831 | (error "Not on a fold"))) |
---|
832 | |
---|
833 | ;;}}} |
---|
834 | ;;{{{ fold-top-level |
---|
835 | |
---|
836 | (defun fold-top-level () |
---|
837 | "Exits all folds, to the top level." |
---|
838 | (interactive) |
---|
839 | (while fold-stack |
---|
840 | (fold-exit))) |
---|
841 | |
---|
842 | ;;}}} |
---|
843 | ;;{{{ fold-goto-line |
---|
844 | |
---|
845 | (defun fold-goto-line (line) |
---|
846 | "Go to line ARG, entering as many folds as possible." |
---|
847 | (interactive "nGoto line: ") |
---|
848 | (fold-top-level) |
---|
849 | (goto-char 1) |
---|
850 | (and (< 1 line) |
---|
851 | (re-search-forward "[\n\C-m]" nil 0 (1- line))) |
---|
852 | (let ((goal (point))) |
---|
853 | (while (prog2 (beginning-of-line) |
---|
854 | (fold-enter t) |
---|
855 | (goto-char goal)))) |
---|
856 | (fold-narrow-to-region (point-min) (point-max) t)) |
---|
857 | |
---|
858 | ;;}}} |
---|
859 | |
---|
860 | ;;}}} |
---|
861 | ;;{{{ Searching for fold boundaries |
---|
862 | |
---|
863 | ;;{{{ fold-skip-folds |
---|
864 | |
---|
865 | ;; Skips forward through the buffer (backward if BACKWARD is non-nil) |
---|
866 | ;; until it finds a closing fold mark or the end of the buffer. The |
---|
867 | ;; point is not moved. Jumps over balanced fold-mark pairs on the way. |
---|
868 | ;; Returns t if the end of buffer was found in an unmatched fold-mark |
---|
869 | ;; pair, otherwise a list. |
---|
870 | |
---|
871 | ;; If the point is actually on an fold start mark, the mark is ignored; |
---|
872 | ;; if it is on an end mark, the mark is noted. This decision is |
---|
873 | ;; reversed if BACKWARD is non-nil. If optional OUTSIDE is non-nil and |
---|
874 | ;; BACKWARD is nil, either mark is noted. |
---|
875 | |
---|
876 | ;; The first element of the list is a position in the end of the closing |
---|
877 | ;; fold mark if one was found, or nil. It is followed by (END START) |
---|
878 | ;; pairs (flattened, not a list of pairs). The pairs indicating the |
---|
879 | ;; positions of folds skipped over; they are positions in the fold |
---|
880 | ;; marks, not necessarily at the ends of the fold marks. They are in |
---|
881 | ;; the opposite order to that in which they were skipped. The point is |
---|
882 | ;; left in a meaningless place. If going backwards, the pairs are |
---|
883 | ;; (START END) pairs, as the fold marks are scanned in the opposite |
---|
884 | ;; order. |
---|
885 | |
---|
886 | ;; Works by maintaining the position of the top and bottom marks found |
---|
887 | ;; so far. They are found separately using a normal string search for |
---|
888 | ;; the fixed part of a fold mark (because it is faster than a regexp |
---|
889 | ;; search if the string does not occur often outside of fold marks), |
---|
890 | ;; checking that it really is a proper fold mark, then considering the |
---|
891 | ;; earliest one found. The position of the other (if found) is |
---|
892 | ;; maintained to avoid an unnecessary search at the next iteration. |
---|
893 | |
---|
894 | (defun fold-skip-folds (backward &optional outside) |
---|
895 | (save-excursion |
---|
896 | (let ((depth 0) pairs point temp start first last |
---|
897 | (first-mark (if backward fold-bottom-mark fold-top-mark)) |
---|
898 | (last-mark (if backward fold-top-mark fold-bottom-mark)) |
---|
899 | (search (if backward 'search-backward 'search-forward))) |
---|
900 | (skip-chars-backward "^\r\n") |
---|
901 | (if outside |
---|
902 | nil |
---|
903 | (and (eq (preceding-char) ?\r) |
---|
904 | (forward-char -1)) |
---|
905 | (if (looking-at fold-top-regexp) |
---|
906 | (if backward |
---|
907 | (setq last (match-end 1)) |
---|
908 | (skip-chars-forward "^\r\n")))) |
---|
909 | (while (progn |
---|
910 | ;; Find last first, prevents unnecessary searching for first. |
---|
911 | (setq point (point)) |
---|
912 | (or last |
---|
913 | (while (and (funcall search last-mark first t) |
---|
914 | (progn |
---|
915 | (setq temp (point)) |
---|
916 | (goto-char (match-beginning 0)) |
---|
917 | (skip-chars-backward " \t") |
---|
918 | (and (not (setq last |
---|
919 | (if (eq (preceding-char) ?\r) |
---|
920 | temp |
---|
921 | (and (bolp) temp)))) |
---|
922 | (goto-char temp))))) |
---|
923 | (goto-char point)) |
---|
924 | (or first |
---|
925 | (while (and (funcall search first-mark last t) |
---|
926 | (progn |
---|
927 | (setq temp (point)) |
---|
928 | (goto-char (match-beginning 0)) |
---|
929 | (skip-chars-backward " \t") |
---|
930 | (and (not (setq first |
---|
931 | (if (eq (preceding-char) ?\r) |
---|
932 | temp |
---|
933 | (and (bolp) temp)))) |
---|
934 | (goto-char temp)))))) |
---|
935 | ;; Return value of conditional says whether to iterate again. |
---|
936 | (if (not last) |
---|
937 | ;; Return from this with the result. |
---|
938 | (not (setq pairs (if first t (cons nil pairs)))) |
---|
939 | (if (and first (if backward (> first last) (< first last))) |
---|
940 | (progn |
---|
941 | (goto-char first) |
---|
942 | (if (eq 0 depth) |
---|
943 | (setq start first |
---|
944 | first nil |
---|
945 | depth 1) ;; non-nil value, loop again. |
---|
946 | (setq first nil |
---|
947 | depth (1+ depth)))) ;; non-nil value, loop again |
---|
948 | (goto-char last) |
---|
949 | (if (eq 0 depth) |
---|
950 | (not (setq pairs (cons last pairs))) |
---|
951 | (or (< 0 (setq depth (1- depth))) |
---|
952 | (setq pairs (cons last (cons start pairs)))) |
---|
953 | (setq last nil) |
---|
954 | t))))) |
---|
955 | pairs))) |
---|
956 | |
---|
957 | ;;}}} |
---|
958 | |
---|
959 | ;;}}} |
---|
960 | ;;{{{ Functions that actually modify the buffer |
---|
961 | |
---|
962 | ;;{{{ fold-fold-region |
---|
963 | |
---|
964 | (defun fold-fold-region (start end) |
---|
965 | "Places fold marks at the beginning and end of a specified region. |
---|
966 | The region is specified by two arguments START and END. The point is |
---|
967 | left at a suitable place ready to insert the title of the fold." |
---|
968 | (interactive "r") |
---|
969 | (and (< end start) |
---|
970 | (setq start (prog1 end |
---|
971 | (setq end start)))) |
---|
972 | (setq end (set-marker (make-marker) end)) |
---|
973 | (goto-char start) |
---|
974 | (beginning-of-line) |
---|
975 | (setq start (point)) |
---|
976 | (insert-before-markers fold-top-mark) |
---|
977 | (let ((saved-point (point))) |
---|
978 | (and fold-secondary-top-mark |
---|
979 | (insert-before-markers fold-secondary-top-mark)) |
---|
980 | (insert-before-markers ?\n) |
---|
981 | (goto-char (marker-position end)) |
---|
982 | (set-marker end nil) |
---|
983 | (and (not (bolp)) |
---|
984 | (eq 0 (forward-line)) |
---|
985 | (eobp) |
---|
986 | (insert ?\n)) |
---|
987 | (insert fold-bottom-mark) |
---|
988 | (insert ?\n) |
---|
989 | (setq fold-stack (if fold-stack |
---|
990 | (cons (cons (point-min-marker) |
---|
991 | (point-max-marker)) |
---|
992 | fold-stack) |
---|
993 | '(folded))) |
---|
994 | (fold-narrow-to-region start (1- (point))) |
---|
995 | (goto-char saved-point) |
---|
996 | (fold-set-mode-line)) |
---|
997 | (save-excursion (fold-tidy-inside))) |
---|
998 | |
---|
999 | ;;}}} |
---|
1000 | ;;{{{ fold-tidy-inside |
---|
1001 | |
---|
1002 | ;; Note to self: The long looking code for checking and modifying those |
---|
1003 | ;; blank lines is to make sure the text isn't modified unnecessarily. |
---|
1004 | ;; Don't remove it again! |
---|
1005 | |
---|
1006 | (defun fold-tidy-inside () |
---|
1007 | "Adds or removes blank lines at the top and bottom of the current fold. |
---|
1008 | Also adds fold marks at the top and bottom (after asking), if they are not |
---|
1009 | there already. The amount of space left depends on the variable |
---|
1010 | `fold-internal-margins', which is one by default." |
---|
1011 | (interactive) |
---|
1012 | (if buffer-read-only nil |
---|
1013 | (goto-char (point-min)) |
---|
1014 | (and (eolp) |
---|
1015 | (progn (skip-chars-forward "\n\t ") |
---|
1016 | (delete-region (point-min) (point)))) |
---|
1017 | (and (if (looking-at fold-top-regexp) |
---|
1018 | (progn (forward-line 1) |
---|
1019 | (and (eobp) (insert ?\n)) |
---|
1020 | t) |
---|
1021 | (and (y-or-n-p "Insert missing fold-top-mark? ") |
---|
1022 | (progn (insert (concat fold-top-mark |
---|
1023 | "<Replaced missing fold top mark>" |
---|
1024 | (or fold-secondary-top-mark "") |
---|
1025 | "\n")) |
---|
1026 | t))) |
---|
1027 | fold-internal-margins |
---|
1028 | (<= 0 fold-internal-margins) |
---|
1029 | (let* ((p1 (point)) |
---|
1030 | (p2 (progn (skip-chars-forward "\n") (point))) |
---|
1031 | (p3 (progn (skip-chars-forward "\n\t ") |
---|
1032 | (skip-chars-backward "\t " p2) (point)))) |
---|
1033 | (if (eq p2 p3) |
---|
1034 | (or (eq p2 (setq p3 (+ p1 fold-internal-margins))) |
---|
1035 | (if (< p2 p3) |
---|
1036 | (newline (- p3 p2)) |
---|
1037 | (delete-region p3 p2))) |
---|
1038 | (delete-region p1 p3) |
---|
1039 | (or (eq 0 fold-internal-margins) |
---|
1040 | (newline fold-internal-margins))))) |
---|
1041 | (goto-char (point-max)) |
---|
1042 | (and (bolp) |
---|
1043 | (progn (skip-chars-backward "\n") |
---|
1044 | (delete-region (point) (point-max)))) |
---|
1045 | (beginning-of-line) |
---|
1046 | (and (or (looking-at fold-bottom-regexp) |
---|
1047 | (progn (goto-char (point-max)) nil) |
---|
1048 | (and (y-or-n-p "Insert missing fold-bottom-mark? ") |
---|
1049 | (progn |
---|
1050 | (insert (concat "\n" fold-bottom-mark)) |
---|
1051 | (beginning-of-line) |
---|
1052 | t))) |
---|
1053 | fold-internal-margins |
---|
1054 | (<= 0 fold-internal-margins) |
---|
1055 | (let* ((p1 (point)) |
---|
1056 | (p2 (progn (skip-chars-backward "\n") (point))) |
---|
1057 | (p3 (progn (skip-chars-backward "\n\t ") |
---|
1058 | (skip-chars-forward "\t " p2) (point)))) |
---|
1059 | (if (eq p2 p3) |
---|
1060 | (or (eq p2 (setq p3 (- p1 1 fold-internal-margins))) |
---|
1061 | (if (> p2 p3) |
---|
1062 | (newline (- p2 p3)) |
---|
1063 | (delete-region p2 p3))) |
---|
1064 | (delete-region p3 p1) |
---|
1065 | (newline (1+ fold-internal-margins))))))) |
---|
1066 | |
---|
1067 | ;;}}} |
---|
1068 | |
---|
1069 | ;;}}} |
---|
1070 | ;;{{{ Operations on the whole buffer |
---|
1071 | |
---|
1072 | ;;{{{ fold-whole-buffer |
---|
1073 | |
---|
1074 | (defun fold-whole-buffer () |
---|
1075 | "Folds every fold in the current buffer. |
---|
1076 | Fails if the fold markers are not balanced correctly. |
---|
1077 | |
---|
1078 | If the buffer is being viewed in a fold, folds are repeatedly exited to |
---|
1079 | get to the top level first (this allows the folds to be tidied on the |
---|
1080 | way out). The buffer modification flag is not affected, and this |
---|
1081 | function will work on read-only buffers." |
---|
1082 | |
---|
1083 | (interactive) |
---|
1084 | (message "Folding buffer...") |
---|
1085 | (let ((narrow-min (point-min)) |
---|
1086 | (narrow-max (point-max)) |
---|
1087 | fold-list fold) |
---|
1088 | (save-excursion |
---|
1089 | (widen) |
---|
1090 | (goto-char 1) |
---|
1091 | (setq fold-list (fold-skip-folds nil t)) |
---|
1092 | (narrow-to-region narrow-min narrow-max) |
---|
1093 | (and (eq t fold-list) |
---|
1094 | (error "Cannot fold whole buffer -- unmatched begin-fold mark")) |
---|
1095 | (and (integerp (car fold-list)) |
---|
1096 | (error "Cannot fold whole buffer -- extraneous end-fold mark")) |
---|
1097 | (fold-top-level) |
---|
1098 | (widen) |
---|
1099 | (goto-char 1) |
---|
1100 | ;; Do the modifications forwards. |
---|
1101 | (fold-subst-regions (nreverse (cdr fold-list)) ?\n ?\r)) |
---|
1102 | (beginning-of-line) |
---|
1103 | (fold-narrow-to-region nil nil t) |
---|
1104 | (message "Folding buffer... done"))) |
---|
1105 | |
---|
1106 | ;;}}} |
---|
1107 | ;;{{{ fold-open-buffer |
---|
1108 | |
---|
1109 | (defun fold-open-buffer () |
---|
1110 | "Unfolds the entire buffer, leaving the point where it is. |
---|
1111 | Does not affect the buffer-modified flag, and can be used on read-only |
---|
1112 | buffers." |
---|
1113 | (interactive) |
---|
1114 | (message "Unfolding buffer...") |
---|
1115 | (fold-clear-stack) |
---|
1116 | (fold-set-mode-line) |
---|
1117 | (unwind-protect |
---|
1118 | (progn |
---|
1119 | (widen) |
---|
1120 | (fold-subst-regions (list 1 (point-max)) ?\r ?\n)) |
---|
1121 | (fold-narrow-to-region nil nil t)) |
---|
1122 | (message "Unfolding buffer... done")) |
---|
1123 | |
---|
1124 | ;;}}} |
---|
1125 | ;;{{{ fold-remove-folds |
---|
1126 | |
---|
1127 | (defun fold-remove-folds (&optional buffer pre-title post-title pad) |
---|
1128 | "Removes folds from a buffer, for printing. |
---|
1129 | |
---|
1130 | It copies the contents of the (hopefully) folded buffer BUFFER into a |
---|
1131 | buffer called `*Unfolded: <Original-name>*', removing all of the fold |
---|
1132 | marks. It keeps the titles of the folds, however, and numbers them. |
---|
1133 | Subfolds are numbered in the form 5.1, 5.2, 5.3 etc., and the titles are |
---|
1134 | indented to eleven characters. |
---|
1135 | |
---|
1136 | It accepts four arguments. BUFFER is the name of the buffer to be |
---|
1137 | operated on, or a buffer. nil means use the current buffer. PRE-TITLE |
---|
1138 | is the text to go before the replacement fold titles, POST-TITLE is the |
---|
1139 | text to go afterwards. Finally, if PAD is non-nil, the titles are all |
---|
1140 | indented to the same column, which is eleven plus the length of |
---|
1141 | PRE-TITLE. Otherwise just one space is placed between the number and |
---|
1142 | the title." |
---|
1143 | (interactive (list (read-buffer "Remove folds from buffer: " |
---|
1144 | (buffer-name) |
---|
1145 | t) |
---|
1146 | (read-string "String to go before enumerated titles: ") |
---|
1147 | (read-string "String to go after enumerated titles: ") |
---|
1148 | (y-or-n-p "Pad section numbers with spaces? "))) |
---|
1149 | (set-buffer (setq buffer (get-buffer buffer))) |
---|
1150 | (setq pre-title (or pre-title "") |
---|
1151 | post-title (or post-title "")) |
---|
1152 | (or folding-mode |
---|
1153 | (error "Must be in Folding mode before removing folds")) |
---|
1154 | (let ((new-buffer (get-buffer-create (concat "*Unfolded: " |
---|
1155 | (buffer-name buffer) |
---|
1156 | "*"))) |
---|
1157 | (section-list '(1)) |
---|
1158 | (section-prefix-list '("")) |
---|
1159 | title |
---|
1160 | (secondary-mark-length (length fold-secondary-top-mark)) |
---|
1161 | (regexp fold-regexp) |
---|
1162 | (secondary-mark fold-secondary-top-mark) |
---|
1163 | prefix |
---|
1164 | (mode major-mode)) |
---|
1165 | (buffer-flush-undo new-buffer) |
---|
1166 | (save-excursion |
---|
1167 | (set-buffer new-buffer) |
---|
1168 | (delete-region (point-min) |
---|
1169 | (point-max))) |
---|
1170 | (save-restriction |
---|
1171 | (widen) |
---|
1172 | (copy-to-buffer new-buffer (point-min) (point-max))) |
---|
1173 | (display-buffer new-buffer t) |
---|
1174 | (set-buffer new-buffer) |
---|
1175 | (subst-char-in-region (point-min) (point-max) ?\r ?\n) |
---|
1176 | (funcall mode) |
---|
1177 | (while (re-search-forward regexp nil t) |
---|
1178 | (if (match-beginning 4) |
---|
1179 | (progn |
---|
1180 | (goto-char (match-end 4)) |
---|
1181 | (setq title |
---|
1182 | (buffer-substring (point) |
---|
1183 | (progn (end-of-line) |
---|
1184 | (point)))) |
---|
1185 | (delete-region (save-excursion |
---|
1186 | (goto-char (match-beginning 4)) |
---|
1187 | (skip-chars-backward "\n\r") |
---|
1188 | (point)) |
---|
1189 | (progn |
---|
1190 | (skip-chars-forward "\n\r") |
---|
1191 | (point))) |
---|
1192 | (and (<= secondary-mark-length |
---|
1193 | (length title)) |
---|
1194 | (string-equal secondary-mark |
---|
1195 | (substring title |
---|
1196 | (- secondary-mark-length))) |
---|
1197 | (setq title (substring title |
---|
1198 | 0 |
---|
1199 | (- secondary-mark-length)))) |
---|
1200 | (setq section-prefix-list |
---|
1201 | (cons (setq prefix (concat (car section-prefix-list) |
---|
1202 | (int-to-string (car section-list)) |
---|
1203 | ".")) |
---|
1204 | section-prefix-list)) |
---|
1205 | (or (cdr section-list) |
---|
1206 | (insert ?\n)) |
---|
1207 | (setq section-list |
---|
1208 | (cons 1 |
---|
1209 | (cons (1+ (car section-list)) |
---|
1210 | (cdr section-list)))) |
---|
1211 | (setq title (concat prefix |
---|
1212 | (if pad |
---|
1213 | (make-string |
---|
1214 | (max 2 (- 8 (length prefix))) ? ) |
---|
1215 | " ") |
---|
1216 | title)) |
---|
1217 | (message "Reformatting: %s%s%s" |
---|
1218 | pre-title |
---|
1219 | title |
---|
1220 | post-title) |
---|
1221 | (insert "\n\n" |
---|
1222 | pre-title |
---|
1223 | title |
---|
1224 | post-title |
---|
1225 | "\n\n")) |
---|
1226 | (goto-char (match-beginning 5)) |
---|
1227 | (or (setq section-list (cdr section-list)) |
---|
1228 | (error "Too many bottom-of-fold marks")) |
---|
1229 | (setq section-prefix-list (cdr section-prefix-list)) |
---|
1230 | (delete-region (point) |
---|
1231 | (progn |
---|
1232 | (forward-line 1) |
---|
1233 | (point))))) |
---|
1234 | (and (cdr section-list) |
---|
1235 | (error |
---|
1236 | "Too many top-of-fold marks -- reached end of file prematurely")) |
---|
1237 | (goto-char (point-min)) |
---|
1238 | (buffer-enable-undo) |
---|
1239 | (set-buffer-modified-p nil) |
---|
1240 | (message "All folds reformatted."))) |
---|
1241 | |
---|
1242 | ;;}}} |
---|
1243 | ;;}}} |
---|
1244 | |
---|
1245 | ;;{{{ Standard fold marks for various major modes |
---|
1246 | |
---|
1247 | ;;{{{ A function to set default marks, `fold-add-to-marks-list' |
---|
1248 | |
---|
1249 | (defun fold-add-to-marks-list (mode top bottom |
---|
1250 | &optional secondary noforce message) |
---|
1251 | "Add/set fold marks for a particular major mode. |
---|
1252 | When called interactively, asks for a major-mode name, and for |
---|
1253 | fold marks to be used in that mode. It adds the new set to |
---|
1254 | `fold-mode-marks-alist', and if the mode name is the same as the current |
---|
1255 | major mode for the current buffer, the marks in use are also changed. |
---|
1256 | |
---|
1257 | If called non-interactively, arguments are MODE, TOP, BOTTOM and |
---|
1258 | SECONDARY. MODE is the symbol for the major mode for which marks are |
---|
1259 | being set. TOP, BOTTOM and SECONDARY are strings, the three fold marks |
---|
1260 | to be used. SECONDARY may be nil (as opposed to the empty string), but |
---|
1261 | the other two must be non-empty strings, and is an optional argument. |
---|
1262 | |
---|
1263 | Two other optional arguments are NOFORCE, meaning do not change the |
---|
1264 | marks if marks are already set for the specified mode if non-nil, and |
---|
1265 | MESSAGE, which causes a message to be displayed if it is non-nil. This |
---|
1266 | is also the message displayed if the function is called interactively. |
---|
1267 | |
---|
1268 | To set default fold marks for a particular mode, put something like the |
---|
1269 | following in your .emacs: |
---|
1270 | |
---|
1271 | \(fold-add-to-marks-list 'major-mode \"(** {{{ \" \"(** }}} **)\" \" **)\") |
---|
1272 | |
---|
1273 | Look at the variable `fold-mode-marks-alist' to see what default settings |
---|
1274 | already apply. |
---|
1275 | |
---|
1276 | `fold-set-marks' can be used to set the fold marks in use in the current |
---|
1277 | buffer without affecting the default value for a particular mode." |
---|
1278 | (interactive |
---|
1279 | (let* ((mode (completing-read |
---|
1280 | (concat "Add fold marks for major mode (" |
---|
1281 | (symbol-name major-mode) |
---|
1282 | "): ") |
---|
1283 | obarray |
---|
1284 | (function |
---|
1285 | (lambda (arg) |
---|
1286 | (and (commandp arg) |
---|
1287 | (string-match "-mode\\'" |
---|
1288 | (symbol-name arg))))) |
---|
1289 | t)) |
---|
1290 | (mode (if (equal mode "") |
---|
1291 | major-mode |
---|
1292 | (intern mode))) |
---|
1293 | (object (assq mode fold-mode-marks-alist)) |
---|
1294 | (old-top (and object |
---|
1295 | (nth 1 object))) |
---|
1296 | top |
---|
1297 | (old-bottom (and object |
---|
1298 | (nth 2 object))) |
---|
1299 | bottom |
---|
1300 | (secondary (and object |
---|
1301 | (nth 3 object))) |
---|
1302 | (prompt "Top fold marker: ")) |
---|
1303 | (and (equal secondary "") |
---|
1304 | (setq secondary nil)) |
---|
1305 | (while (not top) |
---|
1306 | (setq top (read-string prompt (or old-top "{{{ "))) |
---|
1307 | (and (equal top "") |
---|
1308 | (setq top nil))) |
---|
1309 | (setq prompt (concat prompt |
---|
1310 | top |
---|
1311 | ", Bottom marker: ")) |
---|
1312 | (while (not bottom) |
---|
1313 | (setq bottom (read-string prompt (or old-bottom "}}}"))) |
---|
1314 | (and (equal bottom "") |
---|
1315 | (setq bottom nil))) |
---|
1316 | (setq prompt (concat prompt |
---|
1317 | bottom |
---|
1318 | (if secondary |
---|
1319 | ", Secondary marker: " |
---|
1320 | ", Secondary marker (none): ")) |
---|
1321 | secondary (read-string prompt secondary)) |
---|
1322 | (and (equal secondary "") |
---|
1323 | (setq secondary nil)) |
---|
1324 | (list mode top bottom secondary nil t))) |
---|
1325 | (let ((object (assq mode fold-mode-marks-alist))) |
---|
1326 | (if (and object |
---|
1327 | noforce |
---|
1328 | message) |
---|
1329 | (message "Fold markers for `%s' are already set." |
---|
1330 | (symbol-name mode)) |
---|
1331 | (if object |
---|
1332 | (or noforce |
---|
1333 | (setcdr object (if secondary |
---|
1334 | (list top bottom secondary) |
---|
1335 | (list top bottom)))) |
---|
1336 | (setq fold-mode-marks-alist |
---|
1337 | (cons (if secondary |
---|
1338 | (list mode top bottom secondary) |
---|
1339 | (list mode top bottom)) |
---|
1340 | fold-mode-marks-alist))) |
---|
1341 | (and message |
---|
1342 | (message "Set fold marks for `%s' to \"%s\" and \"%s\"." |
---|
1343 | (symbol-name mode) |
---|
1344 | (if secondary |
---|
1345 | (concat top "name" secondary) |
---|
1346 | (concat top "name")) |
---|
1347 | bottom) |
---|
1348 | (and (eq major-mode mode) |
---|
1349 | (fold-set-marks top bottom secondary)))))) |
---|
1350 | |
---|
1351 | ;;}}} |
---|
1352 | ;;{{{ Set some useful default fold marks |
---|
1353 | |
---|
1354 | (fold-add-to-marks-list 'c-mode "/* {{{ " "/* }}} */" " */" t) |
---|
1355 | (fold-add-to-marks-list 'emacs-lisp-mode ";;{{{ " ";;}}}" nil t) |
---|
1356 | (fold-add-to-marks-list 'lisp-interaction-mode ";;{{{ " ";;}}}" nil t) |
---|
1357 | (fold-add-to-marks-list 'plain-tex-mode "%{{{ " "%}}}" nil t) |
---|
1358 | (fold-add-to-marks-list 'plain-TeX-mode "%{{{ " "%}}}" nil t) |
---|
1359 | (fold-add-to-marks-list 'latex-mode "%{{{ " "%}}}" nil t) |
---|
1360 | (fold-add-to-marks-list 'LaTeX-mode "%{{{ " "%}}}" nil t) |
---|
1361 | (fold-add-to-marks-list 'orwell-mode "{{{ " "}}}" nil t) |
---|
1362 | (fold-add-to-marks-list 'modula-2-mode "(* {{{ " "(* }}} *)" " *)" t) |
---|
1363 | (fold-add-to-marks-list 'shellscript-mode "# {{{ " "# }}}" nil t) |
---|
1364 | (fold-add-to-marks-list 'perl-mode "# {{{ " "# }}}" nil t) |
---|
1365 | (fold-add-to-marks-list 'texinfo-mode "@c {{{ " "@c {{{endfold}}}" " }}}" t) |
---|
1366 | (fold-add-to-marks-list 'occam-mode "-- {{{ " "-- }}}" nil t) |
---|
1367 | (fold-add-to-marks-list 'lisp-mode ";;{{{ " ";;}}}" nil t) |
---|
1368 | (fold-add-to-marks-list 'tex-mode "%{{{ " "%}}}" nil t) |
---|
1369 | (fold-add-to-marks-list 'TeX-mode "%{{{ " "%}}}" nil t) |
---|
1370 | (fold-add-to-marks-list 'c++-mode "// {{{ " "// }}}" nil t) |
---|
1371 | (fold-add-to-marks-list 'bison-mode "/* {{{ " "/* }}} */" " */" t) |
---|
1372 | (fold-add-to-marks-list 'Bison-mode "/* {{{ " "/* }}} */" " */" t) |
---|
1373 | (fold-add-to-marks-list 'gofer-mode "-- {{{ " "-- }}}" nil t) |
---|
1374 | (fold-add-to-marks-list 'ml-mode "(* {{{ " "(* }}} *)" " *)" t) |
---|
1375 | (fold-add-to-marks-list 'sml-mode "(* {{{ " "(* }}} *)" " *)" t) |
---|
1376 | |
---|
1377 | ;;; my changes (Jari Aalto ssjaaa@uta.fi) |
---|
1378 | ;;; heavy shell-perl-awk programmer need # prefix... |
---|
1379 | (fold-add-to-marks-list 'fundamental-mode "# {{{ " "# }}}" nil t) |
---|
1380 | (fold-add-to-marks-list 'text-mode "{{{ " "}}}" nil t) |
---|
1381 | |
---|
1382 | |
---|
1383 | ;;}}} |
---|
1384 | |
---|
1385 | ;;}}} |
---|
1386 | ;;{{{ Start Folding mode automatically for folded files |
---|
1387 | |
---|
1388 | ;;{{{ folding-mode-find-file-hook |
---|
1389 | |
---|
1390 | (defun folding-mode-find-file-hook () |
---|
1391 | "One of the hooks called whenever a `find-file' is successful. |
---|
1392 | It checks to see if `folded-file' has been set as a buffer-local |
---|
1393 | variable, and automatically starts Folding mode if it has. |
---|
1394 | |
---|
1395 | This allows folded files to be automatically folded when opened. |
---|
1396 | |
---|
1397 | To make this hook effective, the symbol `folding-mode-find-file-hook' |
---|
1398 | should be placed at the end of `find-file-hooks'. If you have |
---|
1399 | some other hook in the list, for example a hook to automatically |
---|
1400 | uncompress or decrypt a buffer, it should go earlier on in the list. |
---|
1401 | |
---|
1402 | See also `folding-mode-add-find-file-hook'." |
---|
1403 | (and (assq 'folded-file (buffer-local-variables)) |
---|
1404 | folded-file |
---|
1405 | (folding-mode 1) |
---|
1406 | (kill-local-variable 'folded-file))) |
---|
1407 | |
---|
1408 | ;;}}} |
---|
1409 | ;;{{{ folding-mode-add-find-file-hook |
---|
1410 | |
---|
1411 | (defun folding-mode-add-find-file-hook () |
---|
1412 | "Appends `folding-mode-find-file-hook' to the list `find-file-hooks'. |
---|
1413 | |
---|
1414 | This has the effect that afterwards, when a folded file is visited, if |
---|
1415 | appropriate Emacs local variable entries are recognised at the end of |
---|
1416 | the file, Folding mode is started automatically. |
---|
1417 | |
---|
1418 | If `inhibit-local-variables' is non-nil, this will not happen regardless |
---|
1419 | of the setting of `find-file-hooks'. |
---|
1420 | |
---|
1421 | To declare a file to be folded, put `folded-file: t' in the file's |
---|
1422 | local variables. eg., at the end of a C source file, put: |
---|
1423 | |
---|
1424 | /* |
---|
1425 | Local variables: |
---|
1426 | folded-file: t |
---|
1427 | */ |
---|
1428 | |
---|
1429 | The local variables can be inside a fold." |
---|
1430 | (interactive) |
---|
1431 | (or (memq 'folding-mode-find-file-hook find-file-hooks) |
---|
1432 | (setq find-file-hooks (append find-file-hooks |
---|
1433 | '(folding-mode-find-file-hook))))) |
---|
1434 | |
---|
1435 | ;;}}} |
---|
1436 | |
---|
1437 | ;;}}} |
---|
1438 | ;;{{{ Gross, crufty hacks that seem necessary |
---|
1439 | |
---|
1440 | ;; The functions here have been tested with Emacs 18.55, Emacs 18.58, |
---|
1441 | ;; Epoch 4.0p2 (based on Emacs 18.58) and Lucid Emacs 19.6. |
---|
1442 | |
---|
1443 | ;; Note that Lucid Emacs 19.6 can't do selective-display, and its |
---|
1444 | ;; "invisible extents" don't work either, so Folding mode just won't |
---|
1445 | ;; work with that version. |
---|
1446 | |
---|
1447 | ;; They shouldn't do the wrong thing with later versions of Emacs, but |
---|
1448 | ;; they might not have the special effects either. They may appear to |
---|
1449 | ;; be excessive; that is not the case. All of the peculiar things these |
---|
1450 | ;; functions do is done to avoid some side-effect of Emacs' internal |
---|
1451 | ;; logic that I have met. Some of them work around bugs or unfortunate |
---|
1452 | ;; (lack of) features in Emacs. In most cases, it would be better to |
---|
1453 | ;; move this into the Emacs C code. |
---|
1454 | |
---|
1455 | ;; Folding mode is designed to be simple to cooperate with as many |
---|
1456 | ;; things as possible. These functions go against that principle at the |
---|
1457 | ;; coding level, but make life for the user bearable. |
---|
1458 | |
---|
1459 | ;;{{{ fold-merge-keymaps |
---|
1460 | |
---|
1461 | ;; Merge keymaps, because miner-mode keymaps aren't available in Emacs |
---|
1462 | ;; 18. In Lucid Emacs, keymaps can have parent keymaps, so that |
---|
1463 | ;; mechanism is used instead and MAP isn't copied. |
---|
1464 | |
---|
1465 | ;; Takes two keymaps, MAP and EXTRA. Merges each binding in EXTRA into |
---|
1466 | ;; a copy of MAP, and returns the new keymap (bindings in EXTRA override |
---|
1467 | ;; those in MAP). MAP or EXTRA may be nil, indicating an empty keymap. |
---|
1468 | ;; If they are both nil, nil is returned. Sub-keymaps and even cons |
---|
1469 | ;; cells containing bindings are not copied unnecessarily (well, |
---|
1470 | ;; sometimes they are). This means that if you modify the local map |
---|
1471 | ;; when Folding mode is active, the effects are unpredictable: you may |
---|
1472 | ;; also affect the keymap that was active before Folding mdoe was |
---|
1473 | ;; started, and you may affect folding-mode-map. |
---|
1474 | |
---|
1475 | (defun fold-merge-keymaps (map extra) |
---|
1476 | (or map (setq map extra extra nil)) |
---|
1477 | (if (null extra) |
---|
1478 | (and map (copy-keymap map)) |
---|
1479 | (if fold-lucid-keymaps-p |
---|
1480 | (let ((new (copy-keymap extra))) |
---|
1481 | (set-keymap-parent new map) |
---|
1482 | new) |
---|
1483 | (or (keymapp extra) |
---|
1484 | (signal 'wrong-type-argument (list 'keymapp extra))) |
---|
1485 | (or (keymapp map) |
---|
1486 | (signal 'wrong-type-argument (list 'keymapp map))) |
---|
1487 | (and (vectorp extra) |
---|
1488 | (let ((key (length extra)) |
---|
1489 | (oldextra extra)) |
---|
1490 | (setq extra nil) |
---|
1491 | (while (<= 0 (setq key (1- key))) |
---|
1492 | (and (aref oldextra key) |
---|
1493 | (setq extra (cons (cons key (aref oldextra key)) extra)))) |
---|
1494 | (setq extra (cons 'keymap extra)))) |
---|
1495 | (and (cdr extra) |
---|
1496 | (let (key keycode cons-binding realdef def submap) |
---|
1497 | |
---|
1498 | ;; Note that this copy-sequence will copy the spine of the |
---|
1499 | ;; sparse keymap, but it will not copy the cons cell used |
---|
1500 | ;; for each binding. This is important; define-key does a |
---|
1501 | ;; setcdr to rebind a key, if that key was bound already, |
---|
1502 | ;; so define-key can't be used to change a binding. Using |
---|
1503 | ;; copy-keymap instead would be excessive and slow, because |
---|
1504 | ;; it would be repeatedly invoked, as this function is |
---|
1505 | ;; called recursively. |
---|
1506 | |
---|
1507 | (setq map (copy-sequence map)) |
---|
1508 | (while (setq extra (cdr extra)) |
---|
1509 | (setq keycode (car (car extra)) |
---|
1510 | key (char-to-string keycode) |
---|
1511 | def (cdr (car extra)) |
---|
1512 | realdef def) |
---|
1513 | (while (and def (if (symbolp def) |
---|
1514 | (setq def (symbol-function def)) |
---|
1515 | (and (consp def) |
---|
1516 | (integerp (cdr def)) |
---|
1517 | (keymapp (car def)) |
---|
1518 | (setq def (lookup-key (car def) |
---|
1519 | (char-to-string |
---|
1520 | (cdr def)))))))) |
---|
1521 | (if (and (keymapp def) |
---|
1522 | (setq submap (lookup-key map key))) |
---|
1523 | (progn |
---|
1524 | (while (and submap |
---|
1525 | (if (symbolp submap) |
---|
1526 | (setq submap (symbol-function submap)) |
---|
1527 | (and (consp submap) |
---|
1528 | (integerp (cdr submap)) |
---|
1529 | (keymapp (car submap)) |
---|
1530 | (setq submap (lookup-key |
---|
1531 | (car submap) |
---|
1532 | (char-to-string |
---|
1533 | (cdr submap)))))))) |
---|
1534 | (if (keymapp submap) |
---|
1535 | (if (vectorp map) |
---|
1536 | (aset map keycode |
---|
1537 | (fold-merge-keymaps submap def)) |
---|
1538 | (setcdr (setq map (delq (assq keycode map) map)) |
---|
1539 | (cons (cons keycode |
---|
1540 | (fold-merge-keymaps submap def)) |
---|
1541 | (cdr map)))) |
---|
1542 | (if (vectorp map) |
---|
1543 | (aset map keycode realdef) |
---|
1544 | (setcdr (setq map (delq (assq keycode map) map)) |
---|
1545 | (cons (cons keycode realdef) (cdr map)))))) |
---|
1546 | (and def |
---|
1547 | (if (vectorp map) |
---|
1548 | (aset map keycode realdef) |
---|
1549 | (and (setq cons-binding (assq keycode map)) |
---|
1550 | (setq map (delq cons-binding map))) |
---|
1551 | (setcdr map (cons (cons keycode realdef) |
---|
1552 | (cdr map))))))))) |
---|
1553 | map))) |
---|
1554 | |
---|
1555 | ;;}}} |
---|
1556 | ;;{{{ fold-subst-regions |
---|
1557 | |
---|
1558 | ;; Substitute newlines for carriage returns or vice versa. |
---|
1559 | ;; Avoid excessive file locking. |
---|
1560 | |
---|
1561 | ;; Substitutes characters in the buffer, even in a read-only buffer. |
---|
1562 | ;; Takes LIST, a list of regions specified as sequence in the form |
---|
1563 | ;; (START1 END1 START2 END2 ...). In every region specified by each |
---|
1564 | ;; pair, substitutes each occurence of character FIND by REPLACE. |
---|
1565 | |
---|
1566 | ;; The buffer-modified flag is not affected, undo information is not |
---|
1567 | ;; kept for the change, and the function works on read-only files. This |
---|
1568 | ;; function is much more efficient called with a long sequence than |
---|
1569 | ;; called for each region in the sequence. |
---|
1570 | |
---|
1571 | ;; If the buffer is not modified when the function is called, the |
---|
1572 | ;; modified-flag is set before performing all the substitutions, and |
---|
1573 | ;; locking is temporarily disabled. This prevents Emacs from trying to |
---|
1574 | ;; make then delete a lock file for *every* substitution, which slows |
---|
1575 | ;; folding considerably, especially on a slow networked filesystem. |
---|
1576 | ;; Without this, on my system, folding files on startup (and reading |
---|
1577 | ;; other peoples' folded files) takes about five times longer. Emacs |
---|
1578 | ;; still locks the file once for this call under those circumstances; I |
---|
1579 | ;; can't think of a way around that, but it isn't really a problem. |
---|
1580 | |
---|
1581 | ;; I consider these problems to be a bug in `subst-char-in-region'. |
---|
1582 | |
---|
1583 | (defun fold-subst-regions (list find replace) |
---|
1584 | (let ((buffer-read-only buffer-read-only) ;; Protect read-only flag. |
---|
1585 | (modified (buffer-modified-p)) |
---|
1586 | (ask1 (symbol-function 'ask-user-about-supersession-threat)) |
---|
1587 | (ask2 (symbol-function 'ask-user-about-lock))) |
---|
1588 | (unwind-protect |
---|
1589 | (progn |
---|
1590 | (setq buffer-read-only nil) |
---|
1591 | (or modified |
---|
1592 | (progn |
---|
1593 | (fset 'ask-user-about-supersession-threat |
---|
1594 | '(lambda (&rest x) nil)) |
---|
1595 | (fset 'ask-user-about-lock |
---|
1596 | '(lambda (&rest x) nil)) |
---|
1597 | (set-buffer-modified-p t))) ; Prevent file locking in the loop |
---|
1598 | (while list |
---|
1599 | (subst-char-in-region (car list) (nth 1 list) find replace t) |
---|
1600 | (setq list (cdr (cdr list))))) |
---|
1601 | ;; buffer-read-only is restored by the let. |
---|
1602 | ;; Don't want to change MODIFF time if it was modified before. |
---|
1603 | (or modified |
---|
1604 | (unwind-protect |
---|
1605 | (set-buffer-modified-p nil) |
---|
1606 | (fset 'ask-user-about-supersession-threat ask1) |
---|
1607 | (fset 'ask-user-about-lock ask2)))))) |
---|
1608 | |
---|
1609 | ;;}}} |
---|
1610 | ;;{{{ fold-narrow-to-region |
---|
1611 | |
---|
1612 | ;; Narrow to region, without surprising displays. |
---|
1613 | |
---|
1614 | ;; Similar to `narrow-to-region', but also adjusts window-start to be |
---|
1615 | ;; the start of the narrowed region. If an optional argument CENTRE is |
---|
1616 | ;; non-nil, the window-start is positioned to leave the point at the |
---|
1617 | ;; centre of the window, like `recenter'. START may be nil, in which |
---|
1618 | ;; case the function acts more like `widen'. |
---|
1619 | |
---|
1620 | ;; Actually, all the window-starts for every window displaying the |
---|
1621 | ;; buffer, as well as the last_window_start for the buffer are set. The |
---|
1622 | ;; points in every window are set to the point in the current buffer. |
---|
1623 | ;; All this logic is necessary to prevent the display getting really |
---|
1624 | ;; weird occasionally, even if there is only one window. Try making |
---|
1625 | ;; this function like normal `narrow-to-region' with a touch of |
---|
1626 | ;; `recenter', then moving around lots of folds in a buffer displayed in |
---|
1627 | ;; several windows. You'll see what I mean. |
---|
1628 | |
---|
1629 | ;; last_window_start is set by making sure that the selected window is |
---|
1630 | ;; displaying the current buffer, then setting the window-start, then |
---|
1631 | ;; making the selected window display another buffer (which sets |
---|
1632 | ;; last_window_start), then setting the selected window to redisplay the |
---|
1633 | ;; buffer it displayed originally. |
---|
1634 | |
---|
1635 | ;; Note that whenever window-start is set, the point cannot be moved |
---|
1636 | ;; outside the displayed area until after a proper redisplay. If this |
---|
1637 | ;; is possible, centre the display on the point. |
---|
1638 | |
---|
1639 | ;; In Emacs 19; Epoch or Lucid Emacs, searches all screens for all |
---|
1640 | ;; windows. In Emacs 19, they are called "frames". |
---|
1641 | |
---|
1642 | (defun fold-narrow-to-region (&optional start end centre) |
---|
1643 | (let* ((the-window (selected-window)) |
---|
1644 | (the-screen (and fold-epoch-screens-p (epoch::current-screen))) |
---|
1645 | (screens (and fold-epoch-screens-p (epoch::screens-of-buffer))) |
---|
1646 | (selected-buffer (window-buffer the-window)) |
---|
1647 | (window-ring the-window) |
---|
1648 | (window the-window) |
---|
1649 | (point (point)) |
---|
1650 | (buffer (current-buffer)) |
---|
1651 | temp) |
---|
1652 | (unwind-protect |
---|
1653 | (progn |
---|
1654 | (unwind-protect |
---|
1655 | (progn |
---|
1656 | (if start |
---|
1657 | (narrow-to-region start end) |
---|
1658 | (widen)) |
---|
1659 | (setq point (point)) |
---|
1660 | (set-window-buffer window buffer) |
---|
1661 | (while (progn |
---|
1662 | (and (eq buffer (window-buffer window)) |
---|
1663 | (if centre |
---|
1664 | (progn |
---|
1665 | (select-window window) |
---|
1666 | (goto-char point) |
---|
1667 | (vertical-motion |
---|
1668 | (- (lsh (window-height window) -1))) |
---|
1669 | (set-window-start window (point)) |
---|
1670 | (set-window-point window point)) |
---|
1671 | (set-window-start window (or start 1)) |
---|
1672 | (set-window-point window point))) |
---|
1673 | (or (not (eq (setq window |
---|
1674 | (if fold-emacs-frames-p |
---|
1675 | (next-window window nil t) |
---|
1676 | (if fold-lucid-screens-p |
---|
1677 | (next-window window nil t t) |
---|
1678 | (next-window window)))) |
---|
1679 | window-ring)) |
---|
1680 | (and (setq screens (cdr screens)) |
---|
1681 | (setq window (epoch::first-window (car screens)) |
---|
1682 | window-ring window)))))) |
---|
1683 | (and the-screen (epoch::select-screen the-screen)) |
---|
1684 | (select-window the-window)) |
---|
1685 | ;; Set last_window_start. |
---|
1686 | (unwind-protect |
---|
1687 | (if (not (eq buffer selected-buffer)) |
---|
1688 | (set-window-buffer the-window selected-buffer) |
---|
1689 | (if (get-buffer "*scratch*") |
---|
1690 | (set-window-buffer the-window (get-buffer "*scratch*")) |
---|
1691 | (set-window-buffer |
---|
1692 | the-window (setq temp (generate-new-buffer " *temp*")))) |
---|
1693 | (set-window-buffer the-window buffer)) |
---|
1694 | (and temp |
---|
1695 | (kill-buffer temp)))) |
---|
1696 | ;; Undo this side-effect of set-window-buffer. |
---|
1697 | (set-buffer buffer) |
---|
1698 | (goto-char (point))))) |
---|
1699 | |
---|
1700 | ;;}}} |
---|
1701 | |
---|
1702 | ;;}}} |
---|
1703 | ;;{{{ Miscellaneous |
---|
1704 | |
---|
1705 | ;;{{{ kill-all-local-variables-hooks |
---|
1706 | |
---|
1707 | ;; This does not normally have any effect in Emacs. In my setup, |
---|
1708 | ;; this hook is called when the major mode changes, and it gives |
---|
1709 | ;; Folding mode a chance to clear up first. |
---|
1710 | |
---|
1711 | (and (boundp 'kill-all-local-variables-hooks) |
---|
1712 | (or (memq 'fold-end-mode-quickly |
---|
1713 | kill-all-local-variables-hooks) |
---|
1714 | (setq kill-all-local-variables-hooks |
---|
1715 | (cons 'fold-end-mode-quickly |
---|
1716 | kill-all-local-variables-hooks)))) |
---|
1717 | |
---|
1718 | ;;}}} |
---|
1719 | ;;{{{ list-buffers-mode-alist |
---|
1720 | |
---|
1721 | ;; Also has no effect in standard Emacs. With this variable set, |
---|
1722 | ;; my setup shows "Folding" in the mode name part of the buffer list, |
---|
1723 | ;; which looks nice :-). |
---|
1724 | |
---|
1725 | (and (boundp 'list-buffers-mode-alist) |
---|
1726 | (or (assq 'folding-mode list-buffers-mode-alist) |
---|
1727 | (setq list-buffers-mode-alist |
---|
1728 | (cons '(folding-mode folding-mode-v-str) |
---|
1729 | list-buffers-mode-alist)))) |
---|
1730 | |
---|
1731 | ;;}}} |
---|
1732 | ;;{{{ fold-end-mode-quickly |
---|
1733 | |
---|
1734 | (defun fold-end-mode-quickly () |
---|
1735 | "Replaces all ^M's with linefeeds and widen a folded buffer. |
---|
1736 | Only has any effect if Folding mode is active. |
---|
1737 | |
---|
1738 | This should not in general be used for anything. It is used when changing |
---|
1739 | major modes, by being placed in kill-mode-tidy-alist, to tidy the buffer |
---|
1740 | slightly. It is similar to `(folding-mode 0)', except that it does not |
---|
1741 | restore saved keymaps etc. Repeat: Do not use this function. Its |
---|
1742 | behaviour is liable to change." |
---|
1743 | (and (boundp 'folding-mode) |
---|
1744 | (assq 'folding-mode |
---|
1745 | (buffer-local-variables)) |
---|
1746 | folding-mode |
---|
1747 | (progn |
---|
1748 | (widen) |
---|
1749 | (fold-clear-stack) |
---|
1750 | (fold-subst-regions (list 1 (point-max)) ?\r ?\n)))) |
---|
1751 | |
---|
1752 | ;;}}} |
---|
1753 | ;;{{{ eval-current-buffer-open-folds |
---|
1754 | |
---|
1755 | (defun eval-current-buffer-open-folds (&optional printflag) |
---|
1756 | "Evaluate all of a folded buffer as Lisp code. |
---|
1757 | Unlike `eval-current-buffer', this function will evaluate all of a |
---|
1758 | buffer, even if it is folded. It will also work correctly on non-folded |
---|
1759 | buffers, so is a good candidate for being bound to a key if you program |
---|
1760 | in Emacs-Lisp. |
---|
1761 | |
---|
1762 | It works by making a copy of the current buffer in another buffer, |
---|
1763 | unfolding it and evaluating it. It then deletes the copy. |
---|
1764 | |
---|
1765 | Programs can pass argument PRINTFLAG which controls printing of output: |
---|
1766 | nil means discard it; anything else is stream for print." |
---|
1767 | (interactive) |
---|
1768 | (if (or (and (boundp 'folding-mode-flag) |
---|
1769 | folding-mode-flag) |
---|
1770 | (and (boundp 'folding-mode) |
---|
1771 | folding-mode)) |
---|
1772 | (let ((temp-buffer |
---|
1773 | (generate-new-buffer (buffer-name)))) |
---|
1774 | (message "Evaluating unfolded buffer...") |
---|
1775 | (save-restriction |
---|
1776 | (widen) |
---|
1777 | (copy-to-buffer temp-buffer 1 (point-max))) |
---|
1778 | (set-buffer temp-buffer) |
---|
1779 | (subst-char-in-region 1 (point-max) ?\r ?\n) |
---|
1780 | (let ((real-message-def (symbol-function 'message)) |
---|
1781 | (suppress-eval-message)) |
---|
1782 | (fset 'message |
---|
1783 | (function |
---|
1784 | (lambda (&rest args) |
---|
1785 | (setq suppress-eval-message t) |
---|
1786 | (fset 'message real-message-def) |
---|
1787 | (apply 'message args)))) |
---|
1788 | (unwind-protect |
---|
1789 | (eval-current-buffer printflag) |
---|
1790 | (fset 'message real-message-def) |
---|
1791 | (kill-buffer temp-buffer)) |
---|
1792 | (or suppress-eval-message |
---|
1793 | (message "Evaluating unfolded buffer... Done")))) |
---|
1794 | (eval-current-buffer printflag))) |
---|
1795 | |
---|
1796 | ;;}}} |
---|
1797 | |
---|
1798 | ;;}}} |
---|
1799 | |
---|
1800 | ;;{{{ Emacs local variables |
---|
1801 | |
---|
1802 | ;; Local variables: |
---|
1803 | ;; folded-file: t |
---|
1804 | ;; end: |
---|
1805 | |
---|
1806 | ;;}}} |
---|